C CMATEM    SOURCE    CB215821  16/04/21    21:15:47     8920
c MODELO MRSLade-Macari
CCC
C **********************************************************************
CCC
      SUBROUTINE CARACMATEMAC(XMAT)
      IMPLICIT INTEGER(I-N)
      real*8    xmat(*)
      real*8    you,xnu,exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
     .          exl,xnn,aaa,bbb,pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,
     .          exm2,eww2,cpr,cpm,cfr
      common /elasdata/ you,xnu
      common /MRScone/ exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
     .                 exl,xnn,aaa,bbb
      common /MRScapp/ pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,exm2,eww2,
     .                 cpr,cpm,cfr
      you = xmat(1)
      xnu = xmat(2)
      pcc = xmat(5)
      paa = xmat(6)
      qaa = xmat(7)
      exm = xmat(8)
      eww = xmat(9)
      xk1 = xmat(10)
      xk2 = xmat(11)
      etb = xmat(12)
      exv = xmat(13)
      xep = xmat(14)
      xnn = xmat(15)
      cco = xmat(16)
      exl = xmat(17)
      pc0 = xmat(18)
      exr = xmat(19)
      cca = xmat(20)
      phi = xmat(21)
      alp = xmat(22)
c exv < 0 cone fijo
      if (exv.le.0.D0) then
       bbb=1.D0/(abs(exv)*(1.D0+xk1))+xk2*xep/(1.D0+xep)/(1.D0+xep-xk2)
       aaa=(1.D0+xk1)**(-1.D0/abs(exv))*
     .     (1.D0-xk2/(1.D0+xep))*etb*EXP(bbb)
      else
       bbb=1.D0/(exv*(1.D0+xk1))+xk2*xep/(1.D0+xep)/(1.D0+xep-xk2)
       aaa=(1.D0+xk1)**(-1.D0/exv)*(1.D0-xk2/(1.D0+xep))*etb*EXP(bbb)
      endif
      cpr=(1.D0-alp)*(phi*(1.D0-alp)+alp)/(2.D0*phi*(1.D0-alp)+alp)
      cpm=(alp*alp+phi*(1.D0-alp*alp))/(2.D0*phi*(1.D0-alp)+alp)
      cfr=(phi*(1.D0-alp)+alp)*SQRT(alp/(2.D0*phi*(1.D0-alp)+alp))
      pcc2=pcc
      paa2=paa
      qaa2=qaa
      exm2=exm
      eww2=eww
      return
      end