!----------------------------------------------------------------------- ! ! test1.f90 ! ! test driver for solving a stochastic differential equation ! using sderk. The test problem in Stratonovich form is ! the scalar, multiplicative noise problem ! (see K. Burrage and P. M. Burrage, App. Num. Math. 22, 81 (1996)) ! ! dy = -alpha (1-y**2) dt + beta (1-y**2) dW ! ! and in Ito form is ! ! dy = -(alpha+beta**2 y)(1-y**2) dt + beta (1-y**2) dW ! ! which has the analytic solution ! ! y(t) = ((1+y0) exp(-2 alpha t + 2 beta W) + y0 - 1) / ! ((1+y0) exp(-2 alpha t + 2 beta W) + 1 - y0) ! ! Output is 3 columns of data to standard out, first column is ! time, second is the numerical solution, and third is the ! exact solution. ! ! Invoke as ! ! test1 ! ! where nsubsteps is the number of internal steps to take for ! each output step (i.e. to test the solution with different ! step sizes along the same Brownian path). ! ! This program also writes out random number statistics to ! standard error. If everything is working right, ! ! 1. The sum of the dW's should be independent of the substep size ! ! 2. The variance of the dW's should be close to dt ! ! 3. The covariance of the dW's and the I10's should be close ! to (dt**2)/2 ! ! 4. The variance of the I10's should be close to (dt**3)/3 ! ! Here, I10 is the iterated Ito integral ! / t ! | W(s) ds ! / 0 ! ! which is calculated in the same way as the corresponding ! Stratonovich integral J10. ! !----------------------------------------------------------------------- program test1 use sderk_support use sderk90 use utilities implicit none ! Variables to implement particular stepsizes integer, parameter :: noutsteps = 300 integer, parameter :: nmaxsubsteps = 1024 integer :: nsubsteps character*64 argin, format1 ! Parameters for the problem real(wp), dimension(:), pointer :: y real(wp), parameter :: stepsz = 0.01_wp real(wp), parameter :: y0 = 0.0_wp ! Miscellaneous storage real(wp) :: t, yexact, W, tmp real(wp) :: sum, sum2, I10sum, I10sum2, covsum integer :: N, j, k real(wp), dimension(nmaxsubsteps) :: dWarr, I10arr ! interface routines integer :: iargc external :: getarg y => sderk_y ! Initialize statistics variables sum = 0.0_wp sum2 = sum I10sum = sum I10sum2 = sum covsum = sum N = 0 if ( iargc() .ne. 1 ) then write(0,*) 'Exactly one argument, please' stop end if call getarg(1, argin) nsubsteps = s2i(argin) ! Initialize generator call init_sderk(nsubsteps) !call init_sderk(nsubsteps, seed=2000000) !call init_sderk(nsubsteps, seed=2345) ! Set parameters and initial values alpha = 1.0_wp beta = 1.0_wp y = y0 t = 0.0_wp W = 0.0_wp ! Output initial condition format1 = "(f21.15,' ', f21.15, ' ', f21.15)" write(*,format1) t, y0, y0 ! Main integration loop do k = 1, noutsteps ! Take integration step call sderk(t, t+stepsz) ! To calculate exact solution, we need to know the evolution ! of the Wiener process W(t) that the integrator used. This ! can be extracted from rwork. While we're at it, we'll ! do some statistics on the dW's and the I10 integrals ! generated by sderk, to make sure everything is working. dWarr(1:nsubsteps) = sderk_get_I1() I10arr(1:nsubsteps) = sderk_get_I10() do j = 1, nsubsteps W = W + dWarr(j) sum = sum + dWarr(j) sum2 = sum2 + dWarr(j)*dWarr(j) I10sum = I10sum + I10arr(j) I10sum2 = I10sum2 + I10arr(j)*I10arr(j) covsum = covsum + dWarr(j)*I10arr(j) end do N = N + nsubsteps ! Calculate exact solution and output results tmp = (1 + y0) * exp((-2.0_wp)*alpha*t + 2.0_wp*beta*W) yexact = (tmp + y0 - 1.0_wp)/(tmp + 1.0_wp - y0) write(*,format1) t, y, yexact end do ! End of main integration loop write(0,*) 'Random number statistics:' write(0,*) ' mean: ', sum/N write(0,*) ' sum: ', sum write(0,*) ' dt: ', stepsz/nsubsteps write(0,*) ' var: ', (sum2 - sum*sum/N)/(N-1) write(0,*) ' dt**2/2: ', ((stepsz/nsubsteps)**2)/2.0_wp write(0,*) ' cov: ', (covsum-sum*I10sum/N)/(N-1) write(0,*) ' dt**3/3: ', ((stepsz/nsubsteps)**3)/3.0_wp write(0,*) ' I10 var: ', (I10sum2-I10sum*I10sum/N)/(N-1) write(0,*) ' total random numbers: ', N end program test1