*! version 1.2.0  07oct1996
program define suprob
	version 5.0
        local options "Level(integer $S_level)"
        if (substr("`1'",1,1)=="," | "`*'"=="") {
                if "$S_E_cmd"~="suprob" {
                        error 301
                }
                parse "`*'"
                if "`level'" != "" {
                        if `level' < 10 | `level' > 99 {
                                local level = 95
                        }
                }
        }
        else {
		parse "`*'", parse(",")
		local eqns	"`1'"
		mac shift 
		local if	"opt"
		local in	"opt"
		local options	"Robust SCore(string) TRace noLOg"
		local options	"`options' Level(integer $S_level)"
		local options	"`options' noCHI CLuster(string) NEsted *"
		parse "`*'"

		if "`score'" != "" {
			if "`robust'" == "" {
				local robust "robust"
			}
			local n : word count `score'
			if `n' != 2 {
				noi di in red "need 2 arguments in score()"
				exit 198
			}
			local sc1nam : word 1 of `score'
			local sc2nam : word 2 of `score'
			confirm new var `sc1nam'
			confirm new var `sc2nam'
		}

		parse "`eqns'", parse(" ")
		local eq1	"`1'"
		local eq2	"`2'"

		eq ? `eq1'
		local dep1 "$S_3"
		parse "$S_1", parse(" ")
		mac shift
		local ind1 "`*'"

		eq ? `eq2'
		local dep2 "$S_3"
		parse "$S_1", parse(" ")
		mac shift
		local ind2 "`*'"

		tempvar touse
		mark `touse' `if' `in' 
		
		if "`cluster'" != "" {
			unabbrev `cluster'
			if $S_2 > 1 {
				noi di in red /*
				*/ "only one varname allowed in cluster()"
				exit 198
			}
			local cluster "$S_1"
			local clarg ", cluster(`cluster')"
			local robust "robust"
			markout `touse' `cluster', strok
		}

		quietly {
			global SC_4 "suprob"
			local fcn "bipr_l2"
			local mth "deriv2"
			local tle "Seemingly unrelated probit regression"
				
			if "`nested'" != "" {
				if "`robust'" != "" {
					noi di in red /*
*/ "robust, cluster(), and score() options not available with nested model"
					exit 198
				}
				summ `dep1' `if' `in', meanonly
				local n1 = _result(1)
				summ `dep2' `if' `in', meanonly
				local n2 = _result(1)

				if `n1' > `n2' {
					local tmp "`dep1'"
					local dep1 "`dep2'"
					local dep2 "`tmp'"
					local tmp "`ind1'"
					local ind1 "`ind2'"
					local ind2 "`tmp'"
				}
				tempvar marker
				gen `marker' = 1 if `dep1'==.
				replace `dep1' = 0 if `dep1'==.
				global SC_4 "nested"
				local fcn "bipr_lf"
				local mth "lf"
				local tle "Nested probit regression"
			}
			else {
				global SC_4 "suprob"
				local fcn "bipr_l2"
				local mth "deriv2"
				local tle /*
				*/ "Seemingly unrelated probit regression"
			}
			markout `touse' `dep1' `ind1' `dep2' `ind2'

			capture {

				global SC_1
				global SC_2
				global SC_3
				global S_y1 "`dep1'"
				global S_y2 "`dep2'"
				global S_X1 "`ind1'"
				global S_X2 "`ind2'"

				if "`chi'" == "" {

					/* Fit constant only model */

					probit `dep1' if `touse'
					tempname b0 b1 b2 b3 eq01 eq02
					mat `b1' = get(_b)
					mat coleq `b1' = `eq01'
					probit `dep2' if `touse' 
					mat `b2' = get(_b)
					mat coleq `b2' = `eq02'
					mat `b3' = (0)
					mat colnames `b3' = rho:_cons
					mat `b0' = `b1',`b2'
					mat `b0' = `b0',`b3'
					eq rho:
					eq `eq01' : `dep1'
					eq `eq02' : `dep2'

					ml begin
					tempvar touse 
					ml sample `touse' `dep1' `dep2' /*
					*/ `if' `in'
					ml function `fcn'
					ml method `mth'
					ml model b = `eq01' `eq02' rho, /*
						*/ depv(110) from(`b0')
					if "`log'" == "nolog" {
						local prel "qui"
					}
					else    local prel "noi"
					`prel' di 
					`prel' di in gr /*
					*/ "Fitting constant only model"
					`prel' ml max f V, `trace' ltol(1e-4)
					local ll0 = scalar(f)
					eq drop `eq01'
					eq drop `eq02'
					local llarg "lf0(`ll0') pr2"
				}
				else {
					local llarg ""
				}
				/* Fit full model */
			
				probit `dep1' `ind1' if `touse'
				tempname b0 b1 b2 b3
				mat `b1' = get(_b)
				mat coleq `b1' = `dep1'
				probit `dep2' `ind2'  if `touse'
				mat `b2' = get(_b)
				mat coleq `b2' = `dep2'
				mat `b3' = (0)
				mat colnames `b3' = rho:_cons
				mat `b0' = `b1',`b2'
				mat `b0' = `b0',`b3'
				eq rho:

				if "`robust'" != "" {
					tempvar s1 s2 s3
					gen double `s1' = .
					gen double `s2' = .
					gen double `s3' = .
					global SC_1 "`s1'"
					global SC_2 "`s2'"
					global SC_3 "`s3'"
				}
				ml begin
				tempvar touse 
				ml sample `touse' `dep1' `dep2' `ind1' /*
				*/ `ind2' `if' `in'
				ml function `fcn'  
				ml method `mth'     
				ml model b = `eq1' `eq2' rho, depv(110) /*
				*/ from(`b0')
				if "`log'" == "nolog" {
					local prel "qui"
				}
				else    local prel "noi"
				`prel' di 
				`prel' di in green "Fitting full model"
				`prel' ml max f V, `trace' `options'
				ml post suprob, `llarg' title(`tle')
				if "`robust'" != "" {
					_robust `s1' `s2' `s3' `clarg'
					if "`score'" != "" {
						rename `s1' `sc1nam'
						rename `s2' `sc2nam'
					}
				}
			}
			local rc = _rc
                        if "$SC_4" == "nested" {
                                replace `dep1' = . if `marker'==1
                        }
			/*
                        eq drop `eq01'
                        eq drop `eq02'
			*/
			if `rc' {
				exit `rc'
			}
		}
		if "`cluster'" != "" {
			global S_E_cvn "`cluster'"
		}
		global S_E_cmd "suprob"
	}
	di
	ml mlout suprob, level(`level') 
end