*! version 1.0.0 PR 30-Aug-94.          (sg26.3: STB-25)
program define fpderiv /* calc coeffs and powers for 1st derivative of FP fn */
	version 3.1
	local varlist "req new max(1)"
	local options "POwers(string) COeffs(string) Next Curvature Dcurvature"
	parse "`*'"
	parse "`varlist'", parse(" ")
	tempvar p lnx b
	qui gen `p' = .
	qui gen `b' = .
	local fp "$S_E_fp"
	local x "$S_E_x"
	lab var `varlist' "Derivative of FP(${S_E_rhs};${S_E_pwrs})"
	if "`next'"!="" {
		if "`powers'`coeffs'"!="" {
			di in red "invalid `powers' `coeffs'"
			exit 198
		}
		local powers "$S_2"
		if "`powers'"=="" {
			qui replace `varlist'=0 if `x'!=.
			global S_1 0
			global S_2
			exit
		}
		local coeffs "S_4"
	}
	if "`fp'"=="fp" {
		if "`powers'`coeffs'"!="" {
			local fp
		}
	}
	if "`fp'"=="fp" {
		_jprfppp `p' "$S_E_pwrs" 1 0
		local np $S_1
		local i 1
		while `i'<=`np' {
			qui replace `b'=_b[`x'_`i'] in `i'
			local i = `i'+1
		}
	}
	else {
		if "`powers'"=="" {
			di in red "no powers given"
			exit 198
		}
		if "`coeffs'"=="" {
			di in red "no model coefficients given"
			exit 198
		}
		_jprfppp `p' "`powers'" 0 0 /* powers must be sorted */
		if $S_2 {
			di in red "powers must be in increasing order"
			exit 198
		}
		local np $S_1
		local r=colsof(`coeffs')
		if `r'!=`np' {
			di in red "numbers of powers and coefficients differ"
			exit 198
		}
		local j 1
		while `j'<=`np' {
			qui replace `b'=`coeffs'[1,`j'] in `j'
			local j=`j'+1
		}
	}
	local small 1e-6
	local j 1
	while `j'<=`np' {
		local p`j'=`p'[`j']
		local j=`j'+1
	}
	local p`j' .
	local c0 0

	local m `np'
	local j1 0
	local j 1
	local pi .
	while `j'<=`np' {
		local pj `p`j''
		if abs(`pj'-`pi')>`small' { local j0 `j' }
		if abs(`pj')<`small'{	local k 1 }
		else			local k `pj'
		local jp1=`j'+1
		local c=`k'*`b'[`j']
		if abs(`p`jp1''-`pj')<`small' {
			local c=`c'+(1+`j'-`j0')*`b'[`jp1']
		}
		if abs(`pj'-1)>`small'{
			local jj1=`j'-`j1'
			local c`jj1' `c'
			qui replace `p'=`pj'-1 in `jj1'
		}
		else {
			if `j'==`j0' {
				local c0 `c'
				local m=`m'-1
				local j1 1
			}
			else {
				local jm1=`j'-1
				local c`jm1' `c'
				qui replace `p'=0 in `jm1'
			}
		}
		local pi `pj'
		local j=`j'+1
	}
/*
	calc derivative
*/
	local np `m'
	global S_2
	quietly {
		replace `varlist'=`c0' if `x'!=.
		if `np'>0 {
			gen `lnx'=log(`x')
			local i 1
			local h
			while `i'<=`np' {
				local hi "h`i'"
				tempvar `hi'
				gen ``hi''=.
				local h "`h' ``hi''"
				local i=`i'+1
			}
			_jprfpgn `x' `lnx' `p' `np' `h'
			local i 1
			mat S_4=J(1,`np',0)
			while `i'<=`np' {
				replace `varlist'=`varlist'+`c`i''*`h`i''
				mat S_4[1,`i']=`c`i''
				local P=`p'[`i']
				if `i'==1 { global S_2 "`P'" }
				else global S_2 "$S_2,`P'"
				local i = `i'+1
			}
		}
	}
	if "`curvatu'`dcurvat'"!="" {
		tempvar d1 d2 eta term
/*
	Scale X and Y by sd's
*/
		predict `eta' if `x'!=., xb
		qui sum `eta'
		local ys=_result(6)-_result(5)
		qui sum `x'
		local f=`ys'/(_result(6)-_result(5))
		qui gen `d1'=`varlist'
		fpderiv `d2', next
		qui gen `term'=(1+(`d1'/`f')^2)^-1
		if "`curvatu'"!="" {
			qui replace `varlist'=`term'^1.5*`d2'/`f'
			lab var `varlist' /*
			 */ "Curvature of FP(${S_E_rhs};${S_E_pwrs})"
		}
		if "`dcurvat'"!="" {
			tempvar d3
			fpderiv `d3', next
			qui replace `varlist'= (`term'^1.5/`f')* /*
			 */ ( `d3'-3*`term'*`d1'*(`d2'/`f')^2 )
			lab var `varlist' /*
			 */ "d(curvature) of FP(${S_E_rhs};${S_E_pwrs})"
		}
	}
	global S_1 `np'
end