	SUBROUTINE PARMCONF()
	USE WINTERACTER								!Winteracter Library
	USE RESOURCE									!Interface Library	
	USE SHAREDVARS									!Shared Variables
	INTEGER IPARM,IDIR,ISCH,IPT,I,IERR,IOPTPARM
	REAL*8 MODELCALC
	EXTERNAL OPTIMIZE,MODELCALC,GRAPHLINE
!***
!***Various Initializations 
!***
	TYPE "('*****IN CLCALC***** INITIALIZATION')"
	IPHASE=1  !Indicates that optimizations will be done with reduced parameter set that doesn't include ECP 
	NPARM=NPARMMOD(MODELOPT)
	NOPTPARM=NPARM-1
	DO IPARM=1,NPARM 
		CALL WGridGetCellDouble(IDF_MAIN_PARAMETERS_GRID,2,IPARM,CLPARMMIN(IPARM)) 
		CALL WGridGetCellDouble(IDF_MAIN_PARAMETERS_GRID,3,IPARM,CLPARMMAX(IPARM))
	ENDDO
 	DO IERR=0,4
 		CLFLAGLCL(IERR,CLOPT)=0 
 		CLFLAGUCL(IERR,CLOPT)=0
 	ENDDO
!***
!*** Specify how the target likelihood for the confidence limits (LIKETARGET) is reduced from the maximum likelihood solution
!*** Note that because the optimization routines are for minimizations, FUNCSOLUT and LIKETARGET are the arithmetic inverses of the log likelihood
!*** CLs are based on searches for ECP that have this target likelihood once reoptimized for other parameters 
!***
	LIKETARGET=FUNCSOLUT+1.92
	TYPE "('*****TARGET LIKETARGET*****',2G15.8)",FUNCSOLUT,LIKETARGET
!***
!*** Set options for the parameter for which CLs are being calculated
!*** Define the reduced parameter set to be reoptimized 
!*** OPTPARMID is the old index for the optimized parameters and IOPT will be the new index for the reduced set 
!***
	IF(CLOPT.EQ.1) THEN
          	FIXPARMCLID=2
          	OPTPARMID(1)=1
          	OPTPARMID(2)=3
          	OPTPARMID(3)=4
		FIXPARMINIT=PARMSOLUT(2)
	ELSEIF(CLOPT.EQ.2) THEN
          	FIXPARMCLID=2
          	OPTPARMID(1)=1
          	OPTPARMID(2)=3
          	OPTPARMID(3)=4
		FIXPARMINIT=ECPSOLUT
	ELSEIF(CLOPT.EQ.3) THEN
		FIXPARMCLID=3
          	OPTPARMID(1)=1
          	OPTPARMID(2)=2
          	OPTPARMID(3)=4
		FIXPARMINIT=PARMSOLUT(3)
	ENDIF
!***
!*** Loop downward and upward for searches of FIXPARMCLID for FIXPARMCLVAL at which the likelihood is reduced to LIKETARGET 
!***
	DO IDIR=-1,1,2
	IF(CLOPT.EQ.3.AND.IDIR.EQ.-1) CYCLE
	TYPE "('*****CLCALC***** MAIN LOOP',2I5)",FIXPARMCLID,IDIR
!***
!*** Assign increment for FIXPARMCLID value to use in search 
!***
		IF(IDIR.EQ.-1) THEN
			IF(CLOPT.EQ.1) THEN
				FIXPARMDELTA=0.02*(CLPARMMIN(FIXPARMCLID)-FIXPARMINIT)
			ELSEIF(CLOPT.EQ.2) THEN
				IF(XTRANSFORM.EQ.3) THEN
					FIXPARMDELTA=-0.015*FIXPARMINIT
				ELSE
					FIXPARMDELTA=-0.01
				ENDIF
			ELSEIF(CLOPT.EQ.3) THEN
				FIXPARMDELTA=0.02*(CLPARMMIN(FIXPARMCLID)-FIXPARMINIT)
			ENDIF
		ELSE
			IF(CLOPT.EQ.1) THEN
				FIXPARMDELTA=0.02*(CLPARMMAX(FIXPARMCLID)-FIXPARMINIT)
			ELSEIF(CLOPT.EQ.2) THEN
				IF(XTRANSFORM.EQ.3) THEN
					FIXPARMDELTA=0.015*FIXPARMINIT
				ELSE
					FIXPARMDELTA=0.01
				ENDIF
			ELSEIF(CLOPT.EQ.3) THEN
				FIXPARMDELTA=0.02*(CLPARMMAX(FIXPARMCLID)-FIXPARMINIT)
			ENDIF
		ENDIF
		TYPE "('*****CLCONF***** FIXPARMDELTA',2I5,F10.5)",FIXPARMCLID,IDIR,FIXPARMDELTA
!***
!*** The first bracketing point in this search is the value at PTARGET for maximum likelihood solution (PARMSOLUT, FUNCSOLUT)
!*** 
		FIXPARMCLSEARCH(1)=FIXPARMINIT
		LIKESEARCH(1)=FUNCSOLUT
		DO IOPTPARM=1,NOPTPARM
			OPTPARMSEARCH(IOPTPARM,0)=PARMSOLUT(OPTPARMID(IOPTPARM))
		ENDDO
		TYPE "('*****CLCALC***** START POINT FOR BRACKETING ',3I5,<NOPTPARM+2>F10.5,2X,7I2)",FIXPARMCLID,IDIR,0,FIXPARMCLSEARCH(1),LIKESEARCH(1),(OPTPARMSEARCH(IOPTPARM,0),IOPTPARM=1,NOPTPARM),(OPTIMIZERROR(I),I=0,4)
!***
!*** Loop to determine the second bracketing point (ISCH limited to 50 because this will reach min/max for FIXPARMCLID)
!*** Reoptimize other parameters with FIXPARMCLID incremented from first bracketing point  
!*** For the refitted parameters (OPTPARM), optimization guesses will be values at previous point 
!*** If LIKETARGET is passed, exit loop; otherwise, redefine first bracketing point to new point and iterate 
!*** 
		DO ISCH=1,50
      		FIXPARMCLVAL=FIXPARMCLSEARCH(1)+FIXPARMDELTA
			CALL OPTIMIZE()
			TYPE "('*****CLCALC***** SEARCH POINT FOR BRACKETING',3I5,<NOPTPARM+2>F10.5,2X,7I2)",FIXPARMCLID,IDIR,ISCH,FIXPARMCLVAL,FUNC(BEST),(OPTPARMSEARCH(IOPTPARM,0),IOPTPARM=1,NOPTPARM),(OPTIMIZERROR(I),I=0,4)
     			IF(FUNC(0).GT.LIKETARGET) EXIT
     			FIXPARMCLSEARCH(1)=FIXPARMCLVAL
     			LIKESEARCH(1)=FUNC(0)
     		ENDDO
!***
!***If LIKETARGET is passed (ISCH<=50), establish second bracketing point (index=3)
!***If not, (ISCH=51), set errors for CL estimation and end search
!***
		IF(ISCH.LE.50) THEN
			FIXPARMCLSEARCH(3)=FIXPARMCLVAL
      		LIKESEARCH(3)=FUNC(BEST)
			TYPE "('*****CLCALC***** SECOND POINT FOR BRACKETING',3I5,5F10.3)",FIXPARMCLID,IDIR,0,FIXPARMCLSEARCH(3),LIKESEARCH(3),(OPTPARMSEARCH(IOPTPARM,0),IOPTPARM=1,NOPTPARM)
 		ELSE
	 		IF(IDIR.EQ.-1) THEN
 				PARMLCL(CLOPT)=PARMMIN(FIXPARMCLID)
 				FUNCLCL(CLOPT)=LIKESEARCH(3)
 				CLFLAGLCL(0,CLOPT)=-1	!Set overall error flag to indicate nonconvergence	
 				DO IOPTPARM=1,NOPTPARM
 					OPTPARMATLCL(IOPTPARM,CLOPT)=OPTPARMSEARCH(IOPTPARM,3)
					CLFLAGLCL(IOPTPARM,CLOPT)=OPTIMIZERROR(IOPTPARM)
 				ENDDO
				NERROR=NERROR+1
				ERRORMESSAGE(NERROR)='ECp LCL at Minimum Value'
				TYPE "('*****CLCALC***** MIN LIMIT',3I5,5F10.3)",FIXPARMCLID,idir,isch,PARMUCL(CLOPT),FUNCUCL(CLOPT),(OPTPARMATLCL(IOPTPARM,CLOPT),IOPTPARM=1,NOPTPARM)
			ELSE
 				PARMUCL(CLOPT)=PARMMAX(FIXPARMCLID)
 				FUNCUCL(CLOPT)=LIKESEARCH(3)
 				CLFLAGUCL(0,CLOPT)=-1
 				DO IOPTPARM=1,NOPTPARM
 					OPTPARMATUCL(IOPTPARM,CLOPT)=OPTPARMSEARCH(IOPTPARM,3)
					CLFLAGUCL(IOPTPARM,CLOPT)=OPTIMIZERROR(IOPTPARM)
 				ENDDO
				NERROR=NERROR+1
				ERRORMESSAGE(NERROR)='ECp UCL at Maximum Value'
 				TYPE "('***CLCALC*** MAX LIMIT',3I5,5F10.3)",FIXPARMCLID,idir,isch,PARMUCL(CLOPT),FUNCUCL(CLOPT),(OPTPARMATUCL(IOPTPARM,CLOPT),IOPTPARM=1,NOPTPARM)
 			ENDIF
 			CYCLE
		ENDIF 
!***
!***Have identified bracketing points for confidence limit, so set middle search point and reoptimize fitted parameters at that point 
!***
 		FIXPARMCLSEARCH(2)=(FIXPARMCLSEARCH(1)+FIXPARMCLSEARCH(3))/2
		FIXPARMCLVAL=FIXPARMCLSEARCH(2)
		CALL OPTIMIZE()
 		LIKESEARCH(2)=FUNC(0)
 		TYPE "('***CLCALC*** INIT MIDDLE POINT:',I3,3F10.5,3F10.3,<NOPTPARM>F10.5,2X,7I2)",0,(FIXPARMCLSEARCH(IPT),IPT=1,3),(LIKESEARCH(IPT),IPT=1,3),(OPTPARMSEARCH(IOPTPARM,0),IOPTPARM=1,NOPTPARM),(OPTIMIZERROR(I),I=0,4)
!***
!***Of the three points, keep those two that straddle LIKETARGET and generate new intermediate point, proceeding until adequately converge (don't bother changing OPTPARM min/max)
!***
 		DO ISCH=1,20
 			IF(LIKESEARCH(2).GT.LIKETARGET) THEN
 				FIXPARMCLSEARCH(3)=FIXPARMCLSEARCH(2)
 				LIKESEARCH(3)=LIKESEARCH(2)
 				FIXPARMCLSEARCH(2)=0.5*(FIXPARMCLSEARCH(1)+FIXPARMCLSEARCH(2))
 				FIXPARMCLVAL=FIXPARMCLSEARCH(2)
				CALL OPTIMIZE()
 				LIKESEARCH(2)=FUNC(0)
				TYPE "('***CLCALC*** CONF LIMIT BISECT:',I3,3F10.5,3F10.3,<NOPTPARM>F10.5,2X,7I2)",ISCH,(FIXPARMCLSEARCH(IPT),IPT=1,3),(LIKESEARCH(IPT),IPT=1,3),(OPTPARMSEARCH(IOPTPARM,0),IOPTPARM=1,NOPTPARM),(OPTIMIZERROR(I),I=0,4)
 			ELSE
 				FIXPARMCLSEARCH(1)=FIXPARMCLSEARCH(2)
 				LIKESEARCH(1)=LIKESEARCH(2)
 				FIXPARMCLSEARCH(2)=0.5*(FIXPARMCLSEARCH(3)+FIXPARMCLSEARCH(2))
 				FIXPARMCLVAL=FIXPARMCLSEARCH(2)
				CALL OPTIMIZE()
 				LIKESEARCH(2)=FUNC(0)
				TYPE "('***CLCALC*** CONF LIMIT BISECT:',I3,3F10.5,3F10.3,<NOPTPARM>F10.5,2X,7I2)",ISCH,(FIXPARMCLSEARCH(IPT),IPT=1,3),(LIKESEARCH(IPT),IPT=1,3),(OPTPARMSEARCH(IOPTPARM,0),IOPTPARM=1,NOPTPARM),(OPTIMIZERROR(I),I=0,4)
 			ENDIF
 			IF(ABS(FIXPARMCLSEARCH(3)-FIXPARMCLSEARCH(1)).LT.1D-6) EXIT
 		ENDDO
!***
!***At end of binary search, store calculated confidence limit values, the likelihood statistic at the CL, 
!***the values of OPTPARMs at Cl, and error flags (for nonconvergence or reach min/max for OPTPARMs) 
!***
 		IF(IDIR.EQ.-1) THEN
 			PARMLCL(CLOPT)=FIXPARMCLSEARCH(2)
 			FUNCLCL(CLOPT)=LIKESEARCH(2)
			CLFLAGLCL(0,CLOPT)=OPTIMIZERROR(0)
			IF(OPTIMIZERROR(0).NE.0) THEN
				NERROR=NERROR+1
				IF(CLOPT.EQ.1) THEN
					ERRORMESSAGE(NERROR)='For EC50 LCL, Nonconverg for Reopt'
				ELSEIF(CLOPT.EQ.2) THEN
					ERRORMESSAGE(NERROR)='For ECP LCL, Nonconverg for Reopt'
				ENDIF
			ENDIF
			DO IOPTPARM=1,NOPTPARM
 				OPTPARMATLCL(IOPTPARM,CLOPT)=OPTPARMSEARCH(IOPTPARM,0)
				CLFLAGLCL(IOPTPARM,CLOPT)=OPTIMIZERROR(IOPTPARM)
				IF(OPTIMIZERROR(IOPTPARM).NE.0.AND..NOT.(IOPTPARM.EQ.1.AND.OPTIMIZERROR(IOPTPARM).EQ.1)) THEN
					NERROR=NERROR+1
					IF(CLOPT.EQ.1) THEN
						ERRORMESSAGE(NERROR)='For EC50 LCL, Reopt Param at Min/Max'
					ELSEIF(CLOPT.EQ.2) THEN
						ERRORMESSAGE(NERROR)='For ECP LCL, Reopt Param at Min/Max'
					ENDIF
				ENDIF
			ENDDO
			TYPE "('***CLCALC*** FINAL LCL: ',2I5,<2+NOPTPARM>F10.3,5I5)",FIXPARMCLID,IDIR,PARMUCL(CLOPT),FUNCUCL(CLOPT),(OPTPARMATLCL(IOPTPARM,CLOPT),IOPTPARM=1,NOPTPARM),(CLFLAGLCL(IOPTPARM,CLOPT),IOPTPARM=0,NOPTPARM)
 		ELSE
 			PARMUCL(CLOPT)=FIXPARMCLSEARCH(2)
 			FUNCUCL(CLOPT)=LIKESEARCH(2)
			CLFLAGUCL(0,CLOPT)=OPTIMIZERROR(0)
			IF(OPTIMIZERROR(0).NE.0) THEN
				NERROR=NERROR+1
				IF(CLOPT.EQ.1) THEN
					ERRORMESSAGE(NERROR)='For EC50 UCL, Nonconverg for Reopt'
				ELSEIF(CLOPT.EQ.2) THEN
					ERRORMESSAGE(NERROR)='For ECP UCL, Nonconverg for Reopt'
				ELSEIF(CLOPT.EQ.3) THEN
					ERRORMESSAGE(NERROR)='For Scale UCL, Nonconverg for Reopt'
				ENDIF
			ENDIF
			DO IOPTPARM=1,NOPTPARM
 				OPTPARMATUCL(IOPTPARM,CLOPT)=OPTPARMSEARCH(IOPTPARM,0)
				CLFLAGUCL(IOPTPARM,CLOPT)=OPTIMIZERROR(IOPTPARM)
				IF(OPTIMIZERROR(IOPTPARM).NE.0.AND..NOT.(IOPTPARM.EQ.1.AND.OPTIMIZERROR(IOPTPARM).EQ.1)) THEN
					NERROR=NERROR+1
					IF(CLOPT.EQ.1) THEN
						ERRORMESSAGE(NERROR)='For EC50 UCL, Reopt Param at Min/Max'
					ELSEIF(CLOPT.EQ.2) THEN
						ERRORMESSAGE(NERROR)='For ECP UCL, Reopt Param at Min/Max'
					ELSEIF(CLOPT.EQ.3) THEN
						ERRORMESSAGE(NERROR)='For Scale UCL, Reopt Param at Min/Max'
					ENDIF
				ENDIF
			ENDDO
			TYPE "('***CLCALC*** FINAL UCL: ',2I5,<2+NOPTPARM>F10.3,5I5)",FIXPARMCLID,IDIR,PARMUCL(CLOPT),FUNCUCL(CLOPT),(OPTPARMATUCL(IOPTPARM,CLOPT),IOPTPARM=1,NOPTPARM),(CLFLAGUCL(IOPTPARM,CLOPT),IOPTPARM=0,NOPTPARM)
 		ENDIF
		TYPE *,'OUTPUTS DONE',FIXPARMCLID,IDIR
		!ACCEPT *,IGO
 	ENDDO  !End IDIR Loop
	IPHASE=0
	RETURN
	END SUBROUTINE PARMCONF

