# This file is part of the Test Set for BVP solvers # # http://www.dm.uniba.it/~bvpsolvers/ # # Problem bvpT3 # ODE of dimension 2 # # DISCLAIMER: see # http://www.dm.uniba.it/~bvpsolvers/testsetbvpsolvers # # Authors: # # Jeff R. Cash # (Department of Mathematics, Imperial College, London, England.) # Davy Hollevoet # (Vakgroep Toegepaste Wiskunde en Informatica, Universiteit Gent, Belgium.) # Francesca Mazzia # (Dipartimento di Matematica, Universita' di Bari, Italy) # Abdelhameed Nagy Abdo # (Dipartimento di Matematica, Universita' di Bari, Italy) # (Dept. of Mathematics, Faculty of Sciences, Benha University,Egypt) bvpT3_ho <- function(){ prob<- function(){ fullnm <- 'Problem bvpT3' problm = 'bvpT3' typebvp = 'SPBVP' neqn = 1 nlbc = 1 aleft = -1.0e0 aright = 1.0e0 numjac = FALSE numbcjac = FALSE linear = TRUE Rpar<-c(0.5) Ipar<-0 ms <- rep(2,neqn) return(list(fullnm=fullnm,problm=problm,typebvp=typebvp,neqn=neqn, nlbc=nlbc,ms=ms,aleft=aleft,aright=aright,Rpar=Rpar,Ipar=Ipar, numjac=numjac,numbcjac=numbcjac,linear=linear)) } init <- function(neqn,ms,aleft,aright) { givmsh = TRUE givey = TRUE nmsh = 11 xguess = seq(aleft,aright,by=(aright-aleft)/(nmsh-1)) yguess <- NULL for (i in 1:neqn) for (j in 1:ms[i]) yguess <- rbind(yguess,rep(0,nmsh)) return(list(givmsh=givmsh,givey=givey, nmsh=nmsh,xguess=xguess,yguess=yguess)) } feval = function(x,y,eps,Rpar,Ipar){ f <- c((-(2.0e0+cos(pi*x))*y[2]+y[1]-(1.0e0+eps*pi*pi)*cos(pi*x) -(2.0e0+cos(pi*x))*pi*sin(pi*x))/eps ) return(list(f)) } jeval = function(x,y,eps,Rpar,Ipar){ dfy <- matrix( nrow=1,ncol=2,byrow = TRUE, data = c( 1/eps, -(2.0e0+cos(pi*x))/eps)) return((dfy)) } bceval <- function(i, y, eps,Rpar,Ipar) { if (i == 1) return(y[1]+1) if (i == 2) return(y[1]+1) } dbceval <- function(i, y, eps,Rpar,Ipar) { if (i == 1) return(c(1, 0)) if (i == 2) return(c(1, 0)) } setoutput<- function(neqn,plotsol=NULL){ solref = FALSE if (is.null(plotsol)){ nindsol = neqn indsol = 1;neqn} else{ nindsol = length(plotsol) indsol = plotsol} return(list(solref=solref,nindsol=nindsol,indsol=indsol)) } esolu <- function(X,parms,Rpar,Ipar){ lambda=parms Exact =matrix( c( cos(pi*X), -pi*sin(pi*X)), ncol=2,nrow=length(X),byrow=FALSE) return(Exact=Exact)} return(list(prob=prob,init=init,feval=feval,jeval=jeval,bceval=bceval,dbceval=dbceval,setoutput=setoutput,esolu=esolu)) }