-- simeq_newton4.adb solve nonlinear system of equations -- method: newton iteration using Jacobian -- -- Given problem A X = Y where X may have terms x1, x2, x3, x4, ... -- and nonlinear such as: x1*x2, x1*x1*x3, x4*x4*x4, ... -- A sparse matrix may be used, coefficients given -- Y is vector of real, given -- independent unknowns are x1, ... , xn -- -- Solve by initial guess at values of x1, x2, x3, x4 computing products -- X_next = X_initial - J_initial^-1 * (A * X_initial - Y) -- in general X_next = X_prev - (J_prev^-1 * (A * X_prev - Y))*b -- where 0 < b < 1, often 0.5, for stability -- -- solved when abs sum each row A * X_next -Y < epsilon -- -- There may be no solution -- It may stall, stop if abs(X_next-X_prev)1 then put("var1=("); for i in 1..n+nlin loop put(var1(i),2); if i = n+nlin then put(")"); else put(","); end if; end loop; new_line; put("var2=("); for i in 1..n+nlin loop put(var2(i),2); if i = n+nlin then put(")"); else put(","); end if; end loop; new_line; put("var3=("); for i in 1..n+nlin loop put(var3(i),2); if i = n+nlin then put(")"); else put(","); end if; end loop; new_line; put("var4=("); for i in 1..n+nlin loop put(var4(i),2); if i = n+nlin then put(")"); else put(","); end if; end loop; new_line; end if; -- debug end print_var; procedure check_input is begin if A'length(1) < n then errormsg("A first dimension small, minimum n"); end if; if A'length(2) < n+nlin then errormsg("A second dimension small, minimum n+nlin"); end if; if X'length < n+nlin then errormsg("X dimension small, minimum n+nlin"); end if; if Y'length < n then errormsg("Y dimension small, minimum n"); end if; if v1'length < n+nlin then errormsg("v1 dimension small, minimum n+nlin"); end if; if v2'length < n+nlin then errormsg("v2 dimension small, minimum n+nlin"); end if; if v3'length < n+nlin then errormsg("v3 dimension small, minimum n+nlin"); end if; if v4'length < n+nlin then errormsg("v4 dimension small, minimum n+nlin"); end if; if badv then raise v_error; end if; for j in 1..n loop -- check and clean up v input X_prev(j) := X(j); var1(j) := v1(j); if var1(j) /= j then var1(j) := j; put("call error, v1("); put(j,2); put(") should be"); put(j,2); new_Line; print_v; end if; var2(j) := v2(j); if var2(j) /= 0 then var2(j) := 0; put("call error, v2("); put(j,2); put_line(") should be 0"); print_v; end if; var3(j) := v3(j); if var3(j) /= 0 then var3(j) := 0; put("call error, v3("); put(j,2); put_line(") should be 0"); print_v; end if; var4(j) := v4(j); if var4(j) /= 0 then var4(j) := 0; put("call error, v4("); put(j,2); put_line(") should be 0"); print_v; end if; end loop; for j in n+1..n+nlin loop var1(j) := v1(j); var2(j) := v2(j); var3(j) := v3(j); var4(j) := v4(j); if var2(j) > var1(j) then -- sort largest first k := var1(j); -- zero, unused, at bottom var1(j) := var2(j); var2(j) := k; end if; if var3(j) > var1(j) then k := var1(j); var1(j) := var3(j); var3(j) := k; end if; if var4(j) > var1(j) then k := var1(j); var1(j) := var4(j); var4(j) := k; end if; if var3(j) > var2(j) then k := var2(j); var2(j) := var3(j); var3(j) := k; end if; if var4(j) > var2(j) then k := var2(j); var2(j) := var4(j); var4(j) := k; end if; if var4(j) > var3(j) then k := var3(j); var3(j) := var4(j); var4(j) := k; end if; if var1(j)<1 or var1(j)>n then put("call error, v1("); put(j,2); put_line(") must be in (1..n)"); print_v; end if; if var2(j)<1 or var2(j)>n then -- non linear section put("call error, v2("); put(j,2); put_line(") must be in (1..n)"); print_v; end if; if var3(j)<0 or var3(j)>n then put("call error, v3("); put(j,2); put_line(") must be in (0..n)"); print_v; end if; if var4(j)<0 or var4(j)>n then put("call error, v4("); put(j,2); put_line(") must be in (0..n)"); print_v; end if; if badv then raise v_error; end if; end loop; print_var; end check_input; begin if debug or monitor>0 then put_line("simeq_newton4.adb running"); end if; check_input; -- also set X_prev and var1, var2, var3, var4 for j in n+1..n+nlin loop -- set non linear X_prev X_prev(j) := X_prev(var1(j)) * X_prev(var2(j)); -- var1 must not be empty, var2 must not be empty for j>n if(var3(j) /= 0) then X_prev(j) := X_prev(j)* X_prev(var3(j)); end if; if(var4(j) /= 0) then X_prev(j) := X_prev(j)* X_prev(var4(j)); end if; end loop; if debug or monitor>4 then for i in 1..n+nlin loop put("X_prev("); put(i,2); put(")="); put(X_prev(i),3,6); new_line; end loop; new_line; end if; -- debug for i in 1..n loop X_next(i) := X(i); end loop; -- i presid := 1.0e12; -- iterate to find solution for itr in 1..maxitr loop -- could be more iterations -- compute residual resid := 0.0; for i in 1..n loop X_resid(i) := 0.0; for j in 1..n+nlin loop X_resid(i) := X_resid(i) + A(i,j)*X_prev(j); end loop; -- j X_resid(i) := X_resid(i) - Y(i); -- X_resid used later if not solved resid := resid + abs(X_resid(i)); end loop; -- i -- debug/monitor print if Debug or Monitor>1 then for i in 1..n loop put("residual X_resid("); put(i,2); put(")= "); put(X_resid(i),3,6); new_line; end loop; -- i new_line; end if; if Debug or Monitor>0 then put("itr "); put(itr,2); put(", prev= "); put(presid); put(", residual= "); put(resid); new_line; end if; -- check for convergence if resid 4 x^3 Ja(i,j) := Ja(i,j) + 4.0*A(i,k)*X_prev(k2)*X_prev(k3)*X_prev(k4); elsif k1=j and k2=j and k3=j and k4=0 then -- x^3 -> 3 x^2 Ja(i,j) := Ja(i,j) + 3.0*A(i,k)*X_prev(k2)*X_prev(k3); elsif k1=j and k2=j and k3=j and k4/=0 then -- x^3 a -> 3 x^2 a Ja(i,j) := Ja(i,j) + 3.0*A(i,k)*X_prev(k2)*X_prev(k3)*X_prev(k4); elsif k1=j and k2=j and k4=j and k3=0 then -- x^3 -> 3 x^2 Ja(i,j) := Ja(i,j) + 3.0*A(i,k)*X_prev(k2)*X_prev(k4); elsif k1=j and k2=j and k4=j and k3/=0 then -- x^3 a -> 3 x^2 a Ja(i,j) := Ja(i,j) + 3.0*A(i,k)*X_prev(k2)*X_prev(k4)*X_prev(k3); elsif k1=j and k3=j and k4=j and k2=0 then -- x^3 -> 3 x^2 Ja(i,j) := Ja(i,j) + 3.0*A(i,k)*X_prev(k3)*X_prev(k4); elsif k1=j and k3=j and k4=j and k2/=0 then -- x^3 a -> 3 x^2 a Ja(i,j) := Ja(i,j) + 3.0*A(i,k)*X_prev(k3)*X_prev(k4)*X_prev(k2); elsif k2=j and k3=j and k4=j and k1=0 then -- x^3 -> 3 x^2 Ja(i,j) := Ja(i,j) + 3.0*A(i,k)*X_prev(k3)*X_prev(k4); elsif k2=j and k3=j and k4=j and k1/=0 then -- x^3 a -> 3 x^2 a Ja(i,j) := Ja(i,j) + 3.0*A(i,k)*X_prev(k3)*X_prev(k4)*X_prev(k1); elsif k1=j and k2=j and k3=0 and k4=0 then -- x^2 -> 2 x Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k2); elsif k1=j and k2=j and k3/=0 and k4=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k2)*X_prev(k3); elsif k1=j and k2=j and k3=0 and k4/=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k2)*X_prev(k4); elsif k1=j and k2=j and k3/=0 and k4/=0 then -- x^2 ab -> 2 x ab Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k2)*X_prev(k3)*X_prev(k4); elsif k1=j and k3=j and k2=0 and k4=0 then -- x^2 -> 2 x Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k3); elsif k1=j and k3=j and k2/=0 and k4=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k3)*X_prev(k2); elsif k1=j and k3=j and k2=0 and k4/=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k3)*X_prev(k4); elsif k1=j and k3=j and k2/=0 and k4/=0 then -- x^2 ab -> 2 x ab Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k3)*X_prev(k2)*X_prev(k4); elsif k1=j and k4=j and k2=0 and k3=0 then -- x^2 -> 2 x Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4); elsif k1=j and k4=j and k2/=0 and k3=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4)*X_prev(k2); elsif k1=j and k4=j and k2=0 and k3/=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4)*X_prev(k3); elsif k1=j and k4=j and k2/=0 and k3/=0 then -- x^2 ab -> 2 x ab Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4)*X_prev(k2)*X_prev(k3); elsif k2=j and k3=j and k1=0 and k4=0 then -- x^2 -> 2 x Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k3); elsif k2=j and k3=j and k1/=0 and k4=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k3)*X_prev(k1); elsif k2=j and k3=j and k1=0 and k4/=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k3)*X_prev(k4); elsif k2=j and k3=j and k1/=0 and k4/=0 then -- x^2 ab -> 2 x ab Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k3)*X_prev(k1)*X_prev(k4); elsif k2=j and k4=j and k1=0 and k3=0 then -- x^2 -> 2 x Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4); elsif k2=j and k4=j and k1/=0 and k3=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4)*X_prev(k1); elsif k2=j and k4=j and k1=0 and k3/=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4)*X_prev(k3); elsif k2=j and k4=j and k1/=0 and k3/=0 then -- x^2 ab -> 2 x ab Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4)*X_prev(k1)*X_prev(k3); elsif k3=j and k4=j and k1=0 and k3=0 then -- x^2 -> 2 x Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4); elsif k3=j and k4=j and k1/=0 and k3=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4)*X_prev(k1); elsif k3=j and k4=j and k1=0 and k3/=0 then -- x^2 a -> 2 x a Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4)*X_prev(k3); elsif k3=j and k4=j and k1/=0 and k3/=0 then -- x^2 ab -> 2 x ab Ja(i,j) := Ja(i,j) + 2.0*A(i,k)*X_prev(k4)*X_prev(k1)*X_prev(k3); -- all higher powers eliminated elsif k1=j and k2/=0 and k3/=0 and k4/=0 then -- x abc -> abc Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2)*X_prev(k3)*X_prev(K4); elsif k2=j and k1/=0 and k3/=0 and k4/=0 then -- x abc -> abc Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k1)*X_prev(k3)*X_prev(K4); elsif k3=j and k2/=0 and k1/=0 and k4/=0 then -- x abc -> abc Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2)*X_prev(k1)*X_prev(K4); elsif k4=j and k2/=0 and k3/=0 and k1/=0 then -- x abc -> abc Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2)*X_prev(k3)*X_prev(K1); elsif k1=j and k2/=0 and k3/=0 and K4=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2)*X_prev(k3); elsif k1=j and k2/=0 and k3=0 and k4/=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2)*X_prev(k4); elsif k1=j and K2=0 and K3/=0 and K4/=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k3)*X_prev(k4); elsif k2=j and k1/=0 and k3/=0 and K4=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k1)*X_prev(k3); elsif k2=j and k1/=0 and k3=0 and k4/=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k1)*X_prev(k4); elsif k2=j and K1=0 and K3/=0 and K4/=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k3)*X_prev(k4); elsif k3=j and k2/=0 and k1/=0 and K4=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2)*X_prev(k1); elsif k3=j and k2/=0 and k1=0 and k4/=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2)*X_prev(k4); elsif k3=j and K2=0 and K1/=0 and K4/=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k1)*X_prev(k4); elsif k4=j and k2/=0 and k3/=0 and K1=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2)*X_prev(k3); elsif k4=j and k2/=0 and k3=0 and k1/=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2)*X_prev(k1); elsif k4=j and K2=0 and K3/=0 and K1/=0 then -- x ab -> ab Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k3)*X_prev(k1); elsif k1=j and k2/=0 and k3=0 and k4=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2); elsif k1=j and k2=0 and K3/=0 and k4=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k3); elsif k1=j and k2=0 and k3=0 and K4/=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k4); elsif k2=j and k1/=0 and k3=0 and k4=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k1); elsif k2=j and k1=0 and K3/=0 and k4=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k3); elsif k2=j and k1=0 and k3=0 and K4/=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k4); elsif k3=j and k2/=0 and k1=0 and k4=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2); elsif k3=j and k2=0 and K1/=0 and k4=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k1); elsif k3=j and k2=0 and k1=0 and K4/=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k4); elsif k4=j and k2/=0 and k3=0 and k1=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k2); elsif k4=j and k2=0 and K3/=0 and k1=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k3); elsif k4=j and k2=0 and k3=0 and K1/=0 then -- x a -> a Ja(i,j) := Ja(i,j) + A(i,k)*X_prev(k1); end if; end loop; -- k end loop; -- j end loop; -- i -- debug print if debug or monitor>4 then for i in 1..n loop for j in 1..n loop put("Ja("); put(i,2); put(","); put(J,2); put(")="); put(Ja(i,j),3,6); new_line; end loop; -- j end loop; -- i new_line; end if; -- invert Ja JaInv := inverse(Ja); for i in 1..n loop for j in 1..n loop Ja(i,j) := JaInv(i,j); -- debug print if debug or monitor>5 then put("JaInv("); put(i,2); put(","); put(J,2); put(")="); put(JaInv(i,j),3,6); new_line; end if; end loop; -- j end loop; -- i -- X_next = X_prev - (J_prev^-1 * (A X_prev - Y))*b -- X_next = X_prev - (J_prev^-1 * (X_resid))*b -- X_next = X_prev - (X_tmp2)*b for i in 1..n loop X_tmp2(i) := 0.0; for j in 1..n loop X_tmp2(i) := X_tmp2(i) + JaInv(i,j)*X_resid(j); end loop; -- j end loop; -- i -- debug print if debug or monitor>5 then for i in 1..n loop put("change X_tmp2("); put(i,2); put(")= "); put(X_tmp2(i),3,6); new_line; end loop; -- i new_line; end if; -- debug -- dynamic heuristic if presid>resid then b := (b+1.0)/2.0; else b := b/2.0; end if; for i in 1..n loop X_next(i) := X_prev(i) - b*X_tmp2(i); end loop; -- i -- compute non linear terms for j in n+1..n+nlin loop -- set non linear X_prev X_next(j) := X_next(var1(j)) * X_next(var2(j)); -- var1 must not be empty, var2 must not be empty for j>n if(var3(j) /= 0) then X_next(j) := X_next(j)* X_next(var3(j)); end if; if(var4(j) /= 0) then X_next(j) := X_next(j)* X_next(var4(j)); end if; end loop; if debug or monitor>2 then for i in 1..n+nlin loop put("X_next("); put(i,2); put(")= "); put(X_next(i),3,6); new_line; end loop; -- i new_line; end if; -- iterate presid := resid; for i in 1..n+nlin loop X_prev(i) := X_next(i); end loop; -- i new_line; end loop; -- itr end iteration for i in 1..n+nlin loop X(i) := X_next(i); end loop; -- i if resid put_line("simeq_newton4 had errors, X unchanged"); end simeq_newton4;