      subroutine mapc2p(xc,yc,zc,xp,yp,zp)
      implicit none

      double precision xc,yc,zc,xp,yp,zp
      double precision zcs, r, l, w

      zcs = max(abs(xc),abs(yc),abs(zc))

      r = sqrt(xc**2 + yc**2 + zc**2)
      if (r .eq. 0) then
         r = 1.0
      endif
      l = zcs**2
      l = 1.d0
      w = l*zcs/r + (1-l)/sqrt(3.0)

      xp = xc*w
      yp = yc*w
      zp = zc*w

      end
