*! v 1.1.2 11Nov96. STB-34 sbe13
program define xri_mell
        version 4.0
local ll "`1'"
local M "`2'"
local S "`3'"

tempname ln2pi small
scalar `ln2pi'=1.837877
scalar `small'=1e-9

if $S_gfix {
	local G $S_gamma
	if $S_dfix { local D $S_delta }
	else local D `4'
}
else {
	local G `4'
	if $S_dfix { local D $S_delta }
	else local D `5'
}
quietly {
	if !$S_cv & !$S_lns {
		local s `S' /* sigma parametrization */
	}
	else {
		tempvar s
		if $S_lns { /* log S parametrization */
			if $S_cv { gen double `s' = `M'*exp(`S') }
			else gen double `s' = exp(`S')
		}
		else gen double `s' = `M'*`S'
	}

* `s'(igma) is scale factor---in scale of Y

	cap drop __U
	tempvar u Gz ln1u
	gen double `Gz' = `G'*($S_mldepn-`M')/`s'
	gen double `u' = cond(abs(`Gz')<`small', /*
	 */ (1+0.5*`Gz')*($S_mldepn-`M')/`s', (exp(`Gz')-1)/`G' )
	gen double `ln1u' = ln(1+abs(`u'))
	gen double __U = sign(`u')*cond(abs(`D'*`ln1u')>`small', /*
	 */ (exp(`D'*`ln1u')-1)/`D', `ln1u'*(1+0.5*`D'*`ln1u'))
	replace `ll' = -0.5*`ln2pi'-log(`s')-0.5*__U^2 /*
	 */ +ln(1+`G'*`u')+(`D'-1)*`ln1u'
	if $S_trunc {
		tempvar A B
		gen `A' = cond(`G'<`small', -99, -1/`G')
		gen `B' = cond(`G'<-`small', -1/`G', 99)
		nmod `A' `D'
		nmod `B' `D'
		replace `ll' = `ll'-log(`B'-`A')
	}
}
end
program define nmod /* normprob of modulus function */
	replace `1'= normprob(sign(`1')*((abs(`1')+1)^`2'-1)/`2')
end