Download mtcmrs.eso

Back to the list

   1 : C MTCMRS    SOURCE    CHAT      05/01/13    01:53:51     5004           
   2 : CCC
   3 : C **********************************************************************
   4 : CCC
   5 :       SUBROUTINE MTC_MRSMAC (KMAT,NDIMK,SIG,NDIMS,VINTCON,VINTCAP,LCON,
   6 :      .                  lcap,xmat,nescri,ues,nnumer,deltax,kerre)
   7 :       IMPLICIT INTEGER(I-N)
   8 :       integer ndims,kerre,nescri,nnumer,ues,ndimk,
   9 :      .          i,ifl,ndimx,kmod,ndimv
  10 :       real*8    sig(ndims),vintcon,vintcap,Kmat(*),xmat(*),deltax,x(7),
  11 :      .          lcon,lcap,lam
  12 :       real*8    exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,exl,xnn,aaa,
  13 :      .          bbb,pc0,exr,cca,phi,alp,voi1,voi2,voi3,voi4,voi5,cpr,
  14 :      .          cpm,cfr
  15 :       common /MRScone/ exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
  16 :      .                 exl,xnn,aaa,bbb
  17 :       common /MRScapp/ pc0,exr,cca,phi,alp,voi1,voi2,voi3,voi4,voi5,
  18 :      .                 cpr,cpm,cfr
  19 :       do i=1,7
  20 :           x(i)=0.D0
  21 :         enddo
  22 :       kerre=0
  22 :       call CaracmateMAC(xmat)
  23 :       if ((lcon.le.0.D0).and.(lcap.le.0.D0)) then
  24 :         if (nescri.eq.1) write(ues,*)' Modelo MAC: paso elastico'
  25 :         ifl=1
  25 :         call MatHok(Kmat,ndimk,ndims,ifl)
  26 :         goto 100
  27 :       endif
  28 :       if ((lcon.gt.0.D0).and.(lcap.gt.0.D0)) then
  29 :          write(*,*)' Modelo MAC: no puede corner'
  30 :          return
  31 :       endif
  32 :       do i=1,ndims
  33 :          x(i)=sig(i)
  34 :       enddo
  35 :       if ((lcon.gt.0.D0).and.(lcap.lt.0.D0)) then
  36 :         kmod=21
  37 :         lam=lcon
  38 :       else
  39 :         kmod=22
  40 :         lam=lcap
  41 :       endif
  42 :       if ((exr.lt.0.D0).and.(exv.lt.0.D0)) then
  43 :         if (nescri.eq.1) write(ues,*)' Modelo MAC: plast perfecta'
  44 :         write(*,*)' Formulacion no disponible'
  45 :         kerre=1
  46 : c         ndimv=0
  46 : c         call MTC0(Kmat,ndimk,sig,ndims,ndimv,lam,
  47 : c     .             kmod,nescri,ues,nnumer,deltax,kerre)
  48 :       else if ((exr.lt.0.D0).and.(exv.gt.0.D0)) then
  49 :         if (nescri.eq.1) write(ues,*)' Modelo MAC: cone hardening'
  50 :         write(*,*)' Formulacion no disponible'
  51 :         kerre=1
  52 :       else if ((exr.gt.0.D0).and.(exv.lt.0.D0)) then
  53 :         if (nescri.eq.1) write(ues,*)' Modelo MAC: cap hardening '
  54 :         write(*,*)' Formulacion no disponible'
  55 :         kerre=1
  56 :       else if ((exr.gt.0.D0).and.(exv.gt.0.D0)) then
  57 :         if (nescri.eq.1) write(ues,*)' Modelo MAC: cone-cap harde'
  58 :         x(ndims+1)=vintcon
  59 :         x(ndims+2)=vintcap
  60 :         ndimx=ndims+2
  60 :         call MTC21(Kmat,ndimk,x,ndimx,lam,ndims,
  61 :      .             kmod,nescri,ues,nnumer,deltax,kerre)
  62 :       endif
  63 : 100   continue
  64 :       return
  65 :       end
  66 :  
  67 :  
  68 :  

© Cast3M 2003 - All rights reserved.
Disclaimer