diff --git a/fortran_examples/test_n2.F90 b/fortran_examples/test_n2.F90 index 10b0c1bb270e411f9c27ba0e16c6302a26703132..85315cb95c2bc3af8eb9c15f07f7cffa1711fa09 100644 --- a/fortran_examples/test_n2.F90 +++ b/fortran_examples/test_n2.F90 @@ -39,8 +39,50 @@ Type(Cell), Dimension(:), Allocatable :: cells Contains Subroutine Interact_single(cell_i) +Integer, Intent(in) :: cell_i + Integer :: i,j +Real(Kind=dp) :: xx,yy, zz, r, f, ir, ir6, ir12, fxx, fyy, fzz, fix, fiy, fiz + +do i=1,cells(cell_i)%num_parts + fix = 0.0_dp + fiy = 0.0_dp + fiz = 0.0_dp + + do j=i+1, cells(cell_i)%num_parts + + + xx = cells(cell_i)%dx(i) - cells(cell_i)%dx(j) + yy = cells(cell_i)%dy(i) - cells(cell_i)%dy(j) + zz = cells(cell_i)%dz(i) - cells(cell_i)%dz(j) + + r = xx*xx + yy*yy + zz*zz + r = sqrt(r) + ir = 0.1_dp/r + ir6 = ir*ir + ir6 = ir6*ir6*ir6 + ir12 = ir6*ir6 + + f = 4.0_dp* (ir12-ir6) + fxx = f * xx + fyy = f * yy + fzz = f * zz + + fix = fix + fxx + fiy = fiy + fyy + fiz = fiz + fzz + + cells(cell_i)%fx(j) = cells(cell_i)%fx(j) - fxx + cells(cell_i)%fy(j) = cells(cell_i)%fy(j) - fyy + cells(cell_i)%fz(j) = cells(cell_i)%fz(j) - fzz + + end do + cells(cell_i)%fx(i) = cells(cell_i)%fx(i) + fix + cells(cell_i)%fy(i) = cells(cell_i)%fy(i) + fiy + cells(cell_i)%fz(i) = cells(cell_i)%fz(i) + fiz +end do + End Subroutine Subroutine Interact(cell_i, cell_j) @@ -107,9 +149,9 @@ Call Random_Number(cells(cell_num)%dx) Call Random_Number(cells(cell_num)%dy) Call Random_Number(cells(cell_num)%dz) -dx = dx * 10.0_dp -dy = dy * 10.0_dp -dz = dz * 10.0_dp +cells(cell_num)%dx = cells(cell_num)%dx * 10.0_dp +cells(cell_num)%dy = cells(cell_num)%dy * 10.0_dp +cells(cell_num)%dz = cells(cell_num)%dz * 10.0_dp End Subroutine init_cells @@ -125,7 +167,7 @@ Integer(Kind=C_INT), Pointer :: c(:) call c_f_pointer(data, c, [2]) If(typ == type_self) then - +call Interact_self(c(1)) else call Interact(c(1), c(2)) end if @@ -139,12 +181,17 @@ Program main Use, Intrinsic :: ISO_C_BINDING Use quicksched Use parts +Use omp_lib Implicit None Integer(Kind=C_INT) :: i,j, temp Type(C_PTR) :: sched Integer(Kind=C_INT), Target :: data(0:10) -Type(C_PTR) :: dta_ptr +Type(C_PTR) :: dat_ptr Integer(Kind=C_INT), Dimension(1:1000) :: cell_res +Type(C_FUNPTR) :: runner_func +Double Precision :: t_start, t_total + +runner_func = C_FUNLOC(runner) Allocate(cells(1:1000)) do i = 1, 1000 @@ -152,23 +199,32 @@ do i = 1, 1000 end do sched = f_qsched_create() -call qsched_init(qsched, 24, 0) +call qsched_init(sched, 24, 0) do i=1, 1000 - cell_res(i) = qsched_addres(qsched, qsched_owner_none, qsched_res_none) + cell_res(i) = qsched_addres(sched, qsched_owner_none, qsched_res_none) end do do i=1, 1000 - data + data(0) = i + temp = qsched_addtask(sched, type_self, 0, C_LOC(data(0)), int(c_sizeof(type_self), C_INT), 1) + call qsched_addlock(sched, temp, cell_res(i)) do j=i+1, 1000 - + data(1) = j + temp = qsched_addtask(sched, type_pair, 0, C_LOC(data(0)), int(c_sizeof(type_self)*2, C_INT), 1) + call qsched_addlock(sched, temp, cell_res(i)) + call qsched_addlock(sched, temp, cell_res(j)) end do end do +t_start = omp_get_wtime() +call qsched_run(sched, 24, runner_func) +t_total = omp_get_wtime() - t_start +print *, "Took", t_total - - +call qsched_free(sched) +call f_qsched_destroy(sched) end Program