! This file ivp_pmain.f90 is the driver program from the EPPEER-package for explicit ! parallel peer methods by B.A.Schmitt and R.Weiner available at ! www.mathematik.uni-marburg.de\~schmitt\peer ! It solves the ODE from the module ODEPROB for different tolerances and writes ! times and accuracies in a log file; the specific peer method is chosen in line 39 program solve_ivp use omp_lib ! OpenMP-Library for parallel execution use odeprob ! definition of ODE use ivpepp ! module with eppeer subroutine implicit none external psolout ! subroutine for dense output, defined below integer :: n, ito, stages, irep, nsteps,nrej,nfcn, mnr, nthr integer :: i,j real(8) :: tm,te, tol, hs, err, ct0,ctm, ot0,otm real(8), dimension(:), allocatable :: ym, ue, cpar character(16) :: mthn character(32) :: logname ! name of log file character(9) :: npr = "123456789" n = nprob ! ODE problem dimension by global variable allocate(ym(n),ue(n),cpar(nparm)) cpar(1)=1.D0 !--- get solution for error computation: call inivals(tm,te,ue,cpar) if (exsol) then ! get exact solution ue call solution(te,ue,cpar) else ! compute ue with high accuracy print "(a)", "-solution approximated" mnr = 5 ! choose dopri5 call rksetcoeff(mnr,mthn) call rksetparam(1D-14,1D-14) ! very sharp tolerances hs = 0.D0 call rkmeth(n,fcn,tm,te,ue,hs,irep,cpar) ! reference solution with Runge-Kutta method call rkfreecoeff if (irep/=0) print "(a)", "*** bad reference solution" end if !--- end test data, initialize method: nthr = omp_get_max_threads() mnr = 5 ! choose peer method, last digit=#stages call ppsetcoeff(mnr,stages,mthn) ! initialize method if (stages<1) print *, "peer method ", mnr," not available" logname = npr(nthr:nthr)//odename//trim(mthn) print "(3a,i2)", "Program IVP, method ",trim(mthn),", Procs=",nthr print "(3a,i8,a,i8)", "problem ",odename,", dimension n=",n,", parameters=",nparm print "(2a)", ".. writing logfile ", logname open(4,file="pout.txt") ! dense output open(3,file=trim(logname)) write (3, "(3a,I2,3a,I8)") "# method ",trim(mthn),", Procs=",nthr, & ", problem: ",odename,", dim=", n tol = 1.D-1 do ito =1,11 ! run with different tolerances or stepsizes tol = tol*1.D-1 call cpu_time(ct0) ot0 = omp_get_wtime() ! OpenMP start time call ppsetacc(tol,tol) ! (re-)set parameters, hs omitted call ppsetjob(contout=(ito==3))! dense output for ito==... call inivals(tm,te,ym,cpar) ! get initial values ! call eppeer(fcn,tm,te,ym,cpar) ! <<---- integration, no dense output call eppeer(fcn,tm,te,ym,cpar,psolout) ! <<--------- integration with dense output call cpu_time(ctm); ctm = ctm-ct0 otm = omp_get_wtime()-ot0 ! OpenMP thread time irep = ppreport() call ppgetstats(nsteps,nrej,nfcn) if (irep==0) then ! computation successful ym = (ym-ue)**2 err = sqrt(sum(ym)/n) print "(a, G9.2, 3G12.5)", " tol, err, otime, cpu ", tol, err, otm, ctm write(3,"(E9.2,2E14.5,I9,E14.5)") tol, err, otm, nfcn, ctm !!otm else ! print error message print "(a,i4)", "** error in ppmeth, nr:", irep end if print "(a,2i5,i9)", " steps,rej,nfcn:", nsteps,nrej,nfcn end do close(3); close(4) deallocate(ym,ue,cpar) call ppfreecoeff ! release eppeer memory end program solve_ivp ! subroutine for dense output to file "pout.txt", called by eppeer subroutine psolout(n,tsol,tnew) use ivpepp implicit none integer, intent(in) :: n real(8) :: tsol real(8), intent(in) :: tnew real(8), dimension(n) :: ycon do while (tsol<=tnew) call ppcont(tsol,tnew,ycon) write(4,"(F12.3,2E14.5)") tsol,ycon(1),ycon(2) tsol = tsol+0.05D0 end do end subroutine psolout