function(explan, depend, keyc, ubound)
{
	K <- ncol(explan)
	bdir <- c(0, 0, 0, 0, 0, 0, 0, 0)
	brev <- rbind(bdir, bdir, bdir, bdir, bdir, bdir, bdir)
	dmat <- cbind(explan, depend)
	dmat <- as.matrix(na.omit(dmat))
	tmat <- as.matrix(cov.wt(dmat)$cov)
	itmat <- solve(tmat)
	for(i in 1:K) {
		bdir[i] <-  - itmat[i, K + 1]/itmat[K + 1, K + 1]
	}
	for(i in 1:K) {
		for(j in 1:K) {
			brev[j, i] <-  - itmat[i, j]/itmat[K + 1, j]
		}
	}
	rsq <- calcrsq(bdir, tmat)
	mfczero <- 1
	thislow <- 1
	for(j in 1:K) {
		for(i in 1:K) {
			mymin <- 1 - (brev[j, i]/bdir[i])
			if(mymin > 1) {
				if(i != keyc && j != keyc) {
				  newmin <- 1/mymin
				  if(newmin < thislow) {
				    thislow <- newmin
				  }
				}
			}
		}
	}
	if(rsq < 1 && thislow < 1) {
		mfczero <- rsq + (1 - rsq) * thislow
	}
	fmat <- tmat
	fmat[keyc, keyc] <- (1 - ubound) * tmat[keyc, keyc]
	ifmat <- solve(fmat)
	for(i in 1:K) {
		bdir[i] <-  - ifmat[i, K + 1]/ifmat[K + 1, K + 1]
	}
	for(i in 1:K) {
		for(j in 1:K) {
			brev[j, i] <-  - ifmat[i, j]/ifmat[K + 1, j]
		}
	}
	rsqf <- calcrsq(bdir, fmat)
	mfcu <- 1
	thislow <- 1
	for(j in 1:K) {
		for(i in 1:K) {
			mymin <- 1 - (brev[j, i]/bdir[i])
			if(mymin > 1) {
				if(i != keyc && j != keyc) {
				  newmin <- 1/mymin
				  if(newmin < thislow) {
				    thislow <- newmin
				  }
				}
			}
		}
	}
	if(rsqf < 1 && thislow < 1) {
		mfcu <- rsqf + (1 - rsqf) * thislow
	}
	minm <- min(mfczero, mfcu)
	bounds1 <- impose(explan, depend, minm)$allrev
	bounds2 <- impose(explan, depend, minm, ubound, keyc)$allrev
	list(mfczero = mfczero, mfcu = mfcu, bounds1 = bounds1, bounds2 = bounds2, constrain = keyc, bound
		 = ubound)
}
