program test implicit none integer nunknowns,iwhichsolver,i,j double precision x0min(11),x0ori(11),xp(11), & x0max(11),fequ(11),f1dim_funcsys external funcsys,fsqsum_funcsys,f1dim_funcsys nunknowns=11 do i=1,nunknowns x0min(i)=-0.00001d0 x0ori(i)=1.0d0 x0max(i)=100.0d0 enddo nunknowns=2 x0ori(1)=0.0d0 x0ori(2)=3.0d0 call nonsyssolver(funcsys,fsqsum_funcsys, & f1dim_funcsys,x0min,x0ori,xp,x0max, & fequ,nunknowns,iwhichsolver) do i=1,nunknowns write(*,*)fequ(i),xp(i),iwhichsolver enddo end subroutine funcsys(nunknowns,x,f,fsqsum) implicit none integer nunknowns,i double precision x(nunknowns),f(nunknowns), & fsqsum double precision R,p,K5,K6,K7,K8,K9,K10 parameter(R=10.0d0,p=40.0d0, & K5=1.0d0,K6=1.0d0, & K7=1.0d0,K8=0.1d0, & K9=1.0d0,K10=0.1d0) f(1)=x(1)-(1.0d0+0.5d0*dsin(x(1))) f(2)=x(2)-(3.0d0+2.0d0*dsin(x(2))) ! Combustion of propane problem ! f(1)=x(1)-(3.0d0-x(4)) ! f(2)=x(2)-(R-2.0d0*x(1)-x(4)-x(7)- ! & x(8)-x(9)-2.0d0*x(10)) ! f(3)=x(3)-(2.0d0*R-0.5d0*x(9)) ! f(4)=x(4)-x(1)*x(5)/(K5*x(2)) ! f(5)=x(5)-(4-x(2)-0.5d0*x(6)-0.5d0*x(7)) ! f(6)=x(6)-K6*dsqrt(x(2)*x(4)*x(11)/(p*x(1))) ! f(7)=x(7)-K7*dsqrt(x(1)*x(2)*x(11)/(p*x(4))) ! f(8)=x(8)-K8*x(1)*x(11)/(p*x(4)) ! f(9)=x(9)-K9*(x(1)/x(4))*dsqrt(x(3)*x(11)/p) ! f(10)=x(10)-K10*x(1)*x(1)*x(11)/(p*x(4)*x(4)) ! f(11)=x(11)-(x(1)+x(2)+x(3)+x(4)+x(5)+x(6) ! & +x(7)+x(8)+x(9)+x(10)) fsqsum=0.0d0 do i=1,nunknowns fsqsum=fsqsum+f(i)*f(i) enddo fsqsum=0.5d0*fsqsum return end subroutine fsqsum_funcsys(nunknowns,xp,fsqsum) implicit none integer nunknowns double precision xp(nunknowns),fsqsum, & fequ(nunknowns) call funcsys(nunknowns,xp,fequ,fsqsum) return end double precision function f1dim_funcsys(x) INTEGER NMAX double precision x PARAMETER (NMAX=1000) CU USES funcsys INTEGER j,ncom double precision pcom(NMAX),xicom(NMAX), & xt(NMAX),fequ(NMAX) COMMON /f1com/ pcom,xicom,ncom save /f1com/ do 11 j=1,ncom xt(j)=pcom(j)+x*xicom(j) 11 continue call funcsys(ncom,xt,fequ,f1dim_funcsys) return END