MODULE PmetricsFunctionModel%s;

	IMPORT
		SYSTEM,
		PmetricsPKModels,
		Math,
		MathODE,
		MathFunc,
		PmetricsOdepackInterface,
		Vec := LibVectors,
		Solve := LibSolve;

	TYPE
		ODEModel* = POINTER TO RECORD (PmetricsPKModels.PKModel) END;
		SSFun  =  POINTER  TO  RECORD (Solve.RouteFns)
			m: PmetricsPKModels.PKModel; 
			p: PmetricsPKModels.ModelParameters;
			amt, rate, tau: REAL;
			cmt: INTEGER
		END;

	CONST
		numEq = %s;
		itol = 1;
		rtol = 1.0E-6;
		atol = 1.0E-8;
		maxRtol = 1.0E-3;
		maxAtol = 1.0E-4;
		maxSteps = 1000;
		itask = 1;
		istate = 1;
		iopt = 1;
		lrw = 22 + numEq * MAX(16, numEq + 9);
		liw = 20 + numEq;
		jt = 2;
		
	VAR
		currentTheta: POINTER TO ARRAY OF REAL;
		rwork: ARRAY lrw OF REAL;
		iwork: ARRAY liw OF INTEGER;
		solver: MathODE.Solver;

	PROCEDURE UserDerivatives(IN %s: ARRAY OF REAL; VAR %s: ARRAY [untagged] OF REAL;
	numEq: INTEGER; t: REAL; OUT d%sdt: ARRAY [untagged] OF REAL) ;
	VAR
		%s
	BEGIN
		%s

		%s			
	END UserDerivatives;

	PROCEDURE (m: ODEModel) InitModel*;
	BEGIN
		m.nParameter := %s;
		m.F1Index := %s;
		m.tlag1Index := %s;
		m.nCmt :=%s;
		NEW(currentTheta, m.nParameter+m.nCmt); 
	END InitModel;

	PROCEDURE [ccall] Derivatives(VAR numEq: INTEGER; VAR t: REAL; 
		VAR x, dxdt: ARRAY [untagged] OF REAL);
	VAR
		i, iRate: INTEGER;
	BEGIN
		UserDerivatives (currentTheta, x, numEq, t, dxdt); 
		iRate := LEN(currentTheta) - numEq;
		FOR i := 0 TO numEq-1 DO
			dxdt[i] := dxdt[i] + currentTheta[iRate+i]
		END;
	
	END Derivatives;

	PROCEDURE jacDummy(VAR neq: INTEGER;  VAR t: REAL; VAR y: ARRAY [untagged] OF REAL; 
		VAR ml, mu: INTEGER; VAR pd: ARRAY [untagged] OF ARRAY [untagged] OF REAL;
		VAR nrowpd: INTEGER); 
	BEGIN
	END jacDummy;
	
	PROCEDURE (m: ODEModel) Pred1*(dt: REAL; IN parameter: PmetricsPKModels.ModelParameters;
		IN init, rate: ARRAY OF REAL; OUT pred: ARRAY OF REAL);
	(* General nonlinear compartment model *)
	(* Calculate amount in each compartment after dt time units where init = initial conditions and 
	rate = rates into each compartment *) 
	VAR
		i, nCmt, np, numEqv, itolv, itaskv, istatev, ioptv, lrwv, liwv, jtv, tryAgain: INTEGER;
		rtolv, atolv, zero: REAL; 
	CONST
		maxTryAgain = 5;
				
	BEGIN
		zero := 0;
		numEqv := numEq;
		itolv := itol;
		rtolv := rtol;
		atolv := atol;
		itaskv := itask;
		istatev := istate;
		ioptv := iopt;
		lrwv := lrw;
		liwv := liw;
		jtv := jt;

		np := m.nParameter;
		nCmt := m.nCmt;
		FOR i := 0 TO np-1 DO
			currentTheta[i] := parameter.parameters[i]
		END;
		FOR i := 0 TO nCmt-1 DO
			currentTheta[np+i] := rate[i];
			pred[i] := init[i]
		END;
		FOR i := 5 TO 10 DO
			rwork[i] := 0.0;
			iwork[i] := 0
		END;
		iwork[6] := maxSteps;

		PmetricsOdepackInterface.lsoda(Derivatives, numEqv, pred, zero, dt, itolv, 
			rtolv, atolv, itaskv, istatev, ioptv, rwork, lrwv, iwork, liwv, jacDummy, jtv);
		tryAgain := 1;
		WHILE ((istatev = -1) & (tryAgain <= maxTryAgain)) DO 
			PmetricsOdepackInterface.lsoda(Derivatives, numEqv, pred, zero, dt, itolv, 
				rtolv, atolv, itaskv, istatev, ioptv, rwork, lrwv, iwork, liwv, jacDummy, jtv);
			INC(tryAgain)
		END;
		WHILE ((istatev = -2) & (atolv*10 <= maxAtol) & (rtolv*10 <= maxRtol)) DO
			atolv := atolv * 10;
			rtolv := rtolv * 10; 
			istatev := 3;
			PmetricsOdepackInterface.lsoda(Derivatives, numEqv, pred, zero, dt, itolv, 
				rtolv, atolv, itaskv, istatev, ioptv, rwork, lrwv, iwork, liwv, jacDummy, jtv)
		END;
		
		ASSERT((istatev = 2) OR (istatev = 1), 20);
	
	END Pred1;

	PROCEDURE (fn : SSFun) Eval (x : Vec.Vector) : Vec.Vector;
	VAR
		i, np: INTEGER;
		theta: POINTER TO ARRAY OF REAL;
		rate, xout, init: ARRAY PmetricsPKModels.nCmtMax OF REAL;
		result: Vec.Vector;
	BEGIN
		FOR i := 0 TO fn.m.nCmt-1 DO
			rate[i] := 0;
			init[i] := Math.Exp(x[i])
		END;
		
		result := Vec.New(fn.m.nCmt);
		IF fn.rate = 0 THEN	(* bolus dose *)
			init[fn.cmt-1] := init[fn.cmt-1] + fn.amt;
			fn.m.Pred1(fn.tau,fn.p,init,rate,xout);
			FOR i := 0 TO fn.m.nCmt-1 DO
				result[i] := xout[i] - Math.Exp(x[i])
			END;
		ELSIF fn.tau > 0 THEN	(* multiple truncated infusions *)
			rate[fn.cmt-1] := fn.rate;
			fn.m.Pred1(fn.amt/fn.rate,fn.p,init,rate,xout);
			rate[fn.cmt-1] := 0;
			FOR i := 0 TO fn.m.nCmt-1 DO
				init[i] := xout[i]
			END;
			fn.m.Pred1(fn.tau-fn.amt/fn.rate,fn.p,init,rate,xout);
			FOR i := 0 TO fn.m.nCmt-1 DO
				result[i] := xout[i] - Math.Exp(x[i])
			END;
		ELSE	(* constant infusion *)
			rate[fn.cmt-1] := fn.rate;
			np := fn.p.nParameter;
			NEW(theta,np);
			FOR i := 0 TO np-1 DO
				theta[i] := fn.p.parameters[i]
			END;
			UserDerivatives(theta, init, fn.m.nCmt, 0, xout);
			FOR i := 0 TO fn.m.nCmt-1 DO
				result[i] := xout[i] + rate[i]
			END;
		END;

		RETURN result;

	END  Eval;

	PROCEDURE (m:ODEModel) PredSS*(IN parameter: PmetricsPKModels.ModelParameters;
		amt, rate, ii: REAL; cmt: INTEGER; OUT pred: ARRAY OF REAL);
	(* General nonlinear compartment model *)
	(* Calculate amount in each compartment at the end of a steady-state dosing interval or during 
	a steady-state constant input (if ii = 0) *)
	
	(* Need to implement numerical solution to boundary value problem *)
	(* Find x0 such that pred = x0 - amt *)
	(* See LibSolve for root finding functions *)
	VAR
    	r, xBeg  :  Vec.Vector;
    	ssFun   :  SSFun;
    	route    :  Solve.Route;
		i, j, nCmt, np: INTEGER;
		zrate, init, xout: ARRAY PmetricsPKModels.nCmtMax OF REAL;
	BEGIN
		nCmt := m.nCmt;
		r := Vec.New (nCmt);
		FOR i := 0 TO nCmt-1 DO
			r[i] := 0
		END;
		xBeg   :=  Vec.New (nCmt);
		FOR i := 0 TO m.nCmt-1 DO
			zrate[i] := 0;
			init[i] := 0
		END;

		NEW (ssFun);
		ssFun.p := parameter;
		ssFun.amt := amt;
		ssFun.tau := ii;
		ssFun.cmt := cmt;
		ssFun.m := m;

		IF rate = 0 THEN	(* bolus dose *)
			
			init[cmt-1] := init[cmt-1] + amt;
			m.Pred1(ii,parameter,init,zrate,xout);
			FOR i := 0 TO nCmt-1 DO
				xBeg[i] := Math.Ln(xout[i])
			END;
			ssFun.rate := 0;
			route  :=  Solve.NewRoute (ssFun, xBeg, r, 0., 0., 0., 0., NIL);
			REPEAT  UNTIL  route.Leg ();
			WHILE ~(route.valTiny OR route.delTiny) DO
			(* This is a brute force approach to improving the initial estimates if the root *)
			(* solver does not converge *)
				FOR i := 1 TO 5 DO
					FOR j := 0 TO nCmt-1 DO
						init[j] := xout[j]
					END;
					init[cmt-1] := init[cmt-1] + amt;
					m.Pred1(ii,parameter,init,zrate,xout);
				END;
				FOR i := 0 TO nCmt-1 DO
					xBeg[i] := Math.Ln(xout[i])
				END;
				ssFun.rate := 0;
				route  :=  Solve.NewRoute (ssFun, xBeg, r, 0., 0., 0., 0., NIL);
				REPEAT  UNTIL  route.Leg ();
			END;
			ASSERT(route.valTiny OR route.delTiny,20);
			FOR i := 0 TO nCmt-1 DO
				pred[i] := Math.Exp(route.x[i])
			END;			

		ELSIF ii > 0 THEN	(* multiple truncated infusions *)

			zrate[cmt-1] := zrate[cmt-1] + rate;
			m.Pred1(amt/rate,parameter,init,zrate,xout);
			FOR i := 0 TO nCmt-1 DO
				init[i] := xout[i]
			END;
			zrate[cmt-1] := 0;
			m.Pred1(ii-amt/rate,parameter,init,zrate,xout);
			FOR i := 0 TO nCmt-1 DO
				xBeg[i] := Math.Ln(xout[i])
			END;
			ssFun.rate := rate;
			route  :=  Solve.NewRoute (ssFun, xBeg, r, 0., 0., 0., 0., NIL);
			REPEAT  UNTIL  route.Leg ();
			WHILE ~(route.valTiny OR route.delTiny) DO
			(* This is a brute force approach to improving the initial estimates if the root *)
			(* solver does not converge *)
				FOR i := 1 TO 5 DO
					FOR j := 0 TO nCmt-1 DO
						init[j] := xout[j]
					END;
					zrate[cmt-1] := zrate[cmt-1] + rate;
					m.Pred1(amt/rate,parameter,init,zrate,xout);
					zrate[cmt-1] := 0;
					m.Pred1(ii-amt/rate,parameter,init,zrate,xout);
				END;
				FOR i := 0 TO nCmt-1 DO
					xBeg[i] := Math.Ln(xout[i])
				END;
				ssFun.rate := rate;
				route  :=  Solve.NewRoute (ssFun, xBeg, r, 0., 0., 0., 0., NIL);
				REPEAT  UNTIL  route.Leg ();
			END;
			ASSERT(route.valTiny OR route.delTiny,20);
			FOR i := 0 TO nCmt-1 DO
				pred[i] := Math.Exp(route.x[i])
			END;
			
		ELSE	(* constant infusion *)

			zrate[cmt-1] := zrate[cmt-1] + rate;
			m.Pred1(100.0,parameter,init,zrate,xout);
			FOR i := 0 TO nCmt-1 DO
				xBeg[i] := Math.Ln(xout[i])
			END;
			ssFun.rate := rate;
			route  :=  Solve.NewRoute (ssFun, xBeg, r, 0., 0., 0., 0., NIL);
			REPEAT  UNTIL  route.Leg ();
			ASSERT(route.valTiny OR route.delTiny,20);
			FOR i := 0 TO nCmt-1 DO
				pred[i] := Math.Exp(route.x[i])
			END;
			
		END;
	
	END PredSS;
	
END PmetricsFunctionModel%s.

