function f = faddeeva(zmat)
# function f = faddeeva(z)
# Calculates Faddeeva function. 
#
# Copyright (C) 2004 Victor Munoz 
#
# Based on code in Matpack (version 1.7.3).
#
# Copyright (C) 1991-2002 by Berndt M. Gammel

#Version 1.0

DBL_MAX = 1.797693134862316e+308;
DBL_EPSILON= 2.220446049250313e-16;
M_2_SQRTPI= 2/sqrt(pi);

    # The maximum value of rmaxreal equals the root of the largest number 
    # rmax which can still be implemented on the computer in double precision
    # floating-point arithmetic
rmaxreal = sqrt(DBL_MAX);

    # rmaxexp  = ln(rmax) - ln(2)
rmaxexp  = log(DBL_MAX) - log(2.0);

    # the largest possible argument of a double precision goniometric function
rmaxgoni = 1.0 / DBL_EPSILON;
h2 = 0;
u2 = 0;
v2 = 0;
qlambda = 0;

f=zeros(size(zmat));

for fila=1:rows(zmat),
  for columna=1:columns(zmat),

    z=zmat(fila,columna);

    xi = real(z);
    yi = imag(z);
    xabs = abs(xi);
    yabs = abs(yi);
    x = xabs / 6.3;
    y = yabs / 4.4;

    # the following statement protects qrho = (x^2 + y^2) against overflow
    if ((xabs > rmaxreal) | (yabs > rmaxreal)),
      f(fila,columna)=NaN;
      message("Faddeeva, absolute value of argument so large w(z) overflows")
    end


    qrho = x .* x + y .* y;
    xabsq = xabs .* xabs;
    xquad = xabsq - yabs .* yabs;
    yquad = xabs .* 2 .* yabs;
    
    a = qrho < 0.085264;

    if (a),
	
	# If (qrho < 0.085264) then the Faddeeva-function is evaluated 
        # using a power-series (Abramowitz/Stegun, equation (7.1.5), p.297). 
        # n is the minimum number of terms needed to obtain the required 
        # accuracy.
	
      qrho = (1 - y * 0.85) * sqrt(qrho);
      n = round(qrho * 72 + 6);
# C++      j = (n << 1) + 1; 
# e1 << e2 = e1*2^(e2);  
      j = n * 2 + 1;
      xsum = 1.0 / j;
      ysum = 0.0;
      for i=n:-1:1,
	j = j-2;
	xaux = (xsum * xquad - ysum * yquad) / i;
	ysum = (xsum * yquad + ysum * xquad) / i;
	xsum = xaux + 1.0 / j;
      end
      u1 = (xsum * yabs + ysum * xabs) * -M_2_SQRTPI + 1.0;
      v1 = (xsum * xabs - ysum * yabs) * M_2_SQRTPI;
      daux = exp(-xquad);
      u2 = daux * cos(yquad);
      v2 = -daux * sin(yquad);
      
      u = u1 * u2 - v1 * v2;
      v = u1 * v2 + v1 * u2;
    else
	
        #  If (qrho > 1.0) then w(z) is evaluated using the Laplace continued 
	#  fraction.  nu is the minimum number of terms needed to obtain the
	#  required accuracy. 
        #  if ((qrho > 0.085264) && (qrho < 1.0)) then w(z) is evaluated
        #  by a truncated Taylor expansion, where the Laplace continued
	#  fraction is used to calculate the derivatives of w(z). 
        #  kapn is the minimum number of terms in the Taylor expansion needed
        #  to obtain the required accuracy. 
        #  nu is the minimum number of terms of the continued fraction needed
        #  to calculate the derivatives with the required accuracy. 
	
      if (qrho > 1.0),
	h = 0.0;
	kapn = 0;
	qrho = sqrt(qrho);
# C++: (int)
	nu = fix(1442 / (qrho * 26 + 77) + 3);
      else
	qrho = (1 - y) * sqrt(1 - qrho);
	h = qrho * 1.88;
	h2 = h * 2;
	kapn = round(qrho * 34 + 7);
	nu   = round(qrho * 26 + 16);
      end
      
      b = h > 0.0;
      
      if (b),
	qlambda = h2.^kapn;
      end
      
      rx = ry = sx = sy = 0.0;
      for n=nu:-1:0,
	np1 = n + 1;
	tx = yabs + h + np1 * rx;
	ty = xabs - np1 * ry;
	c = 0.5 / (tx * tx + ty * ty);
	rx = c * tx;
	ry = c * ty;
	if (b & (n <= kapn)),
	  tx = qlambda + sx;
	  sx = rx * tx - ry * sy;
	  sy = ry * tx + rx * sy;
	  qlambda = qlambda/h2;
	end
      end
      
      if (h == 0.0),
	u = rx * M_2_SQRTPI;
	v = ry * M_2_SQRTPI;
      else
	u = sx * M_2_SQRTPI;
	v = sy * M_2_SQRTPI;
      end
      
      if (yabs == 0.0),
	u = exp(-(xabs * xabs));
      end
    end
    
    #  evaluation of w(z) in the other quadrants 

    if (yi < 0.0),
      
      if (a),
	u2 = u2*2;
	v2 = v2*2;
      else
	xquad = -xquad;

      
            # the following statement protects 2*exp(-z**2) against overflow
	if ((yquad > rmaxgoni) | (xquad > rmaxexp)),
	  message("Faddeeva, absolute value of argument so large w(z) overflows");
          f(fila,columna)=NaN;
	end
      
	w1 = exp(xquad) * 2;
	u2 =  w1 * cos(yquad);
	v2 = -w1 * sin(yquad);
      end
    
      u = u2 - u;
      v = v2 - v;
      if (xi > 0.0),
	v = -v;
      end
    elseif (xi < 0.0),
      v = -v;
    end
    f(fila,columna)=u+I*v;
  end
end
