nf_vector.f90 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106
  1. ! StarPU --- Runtime system for heterogeneous multicore architectures.
  2. !
  3. ! Copyright (C) 2016 Inria
  4. !
  5. ! StarPU is free software; you can redistribute it and/or modify
  6. ! it under the terms of the GNU Lesser General Public License as published by
  7. ! the Free Software Foundation; either version 2.1 of the License, or (at
  8. ! your option) any later version.
  9. !
  10. ! StarPU is distributed in the hope that it will be useful, but
  11. ! WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13. !
  14. ! See the GNU Lesser General Public License in COPYING.LGPL for more details.
  15. program nf_vector
  16. use iso_c_binding ! C interfacing module
  17. use fstarpu_mod ! StarPU interfacing module
  18. use nf_codelets
  19. implicit none
  20. real(8), dimension(:), allocatable, target :: va
  21. integer, dimension(:), allocatable, target :: vb
  22. integer :: i
  23. type(c_ptr) :: cl_vec ! a pointer for the codelet structure
  24. type(c_ptr) :: dh_va ! a pointer for the 'va' vector data handle
  25. type(c_ptr) :: dh_vb ! a pointer for the 'vb' vector data handle
  26. integer(c_int) :: err ! return status for fstarpu_init
  27. integer(c_int) :: ncpu ! number of cpus workers
  28. allocate(va(5))
  29. va = (/ (i,i=1,5) /)
  30. allocate(vb(7))
  31. vb = (/ (i,i=1,7) /)
  32. ! initialize StarPU with default settings
  33. err = fstarpu_init(C_NULL_PTR)
  34. if (err == -19) then
  35. stop 77
  36. end if
  37. ! stop there if no CPU worker available
  38. ncpu = fstarpu_cpu_worker_get_count()
  39. if (ncpu == 0) then
  40. call fstarpu_shutdown()
  41. stop 77
  42. end if
  43. ! allocate an empty codelet structure
  44. cl_vec = fstarpu_codelet_allocate()
  45. ! set the codelet name
  46. call fstarpu_codelet_set_name(cl_vec, C_CHAR_"my_vec_codelet"//C_NULL_CHAR)
  47. ! add a CPU implementation function to the codelet
  48. call fstarpu_codelet_add_cpu_func(cl_vec, C_FUNLOC(cl_cpu_func_vec))
  49. ! optionally set 'where' field to CPU only
  50. call fstarpu_codelet_set_where(cl_vec, FSTARPU_CPU)
  51. ! add a Read-only mode data buffer to the codelet
  52. call fstarpu_codelet_add_buffer(cl_vec, FSTARPU_R)
  53. ! add a Read-Write mode data buffer to the codelet
  54. call fstarpu_codelet_add_buffer(cl_vec, FSTARPU_RW.ior.FSTARPU_LOCALITY)
  55. ! register 'va', a vector of real(8) elements
  56. call fstarpu_vector_data_register(dh_va, 0, c_loc(va), 1+ubound(va,1)-lbound(va,1), c_sizeof(va(lbound(va,1))))
  57. ! register 'vb', a vector of integer elements
  58. call fstarpu_vector_data_register(dh_vb, 0, c_loc(vb), 1+ubound(vb,1)-lbound(vb,1), c_sizeof(vb(lbound(vb,1))))
  59. ! insert a task with codelet cl_vec, and vectors 'va' and 'vb'
  60. !
  61. ! Note: The array argument must follow the layout:
  62. ! (/
  63. ! <codelet_ptr>,
  64. ! [<argument_type> [<argument_value(s)],]
  65. ! . . .
  66. ! C_NULL_PTR
  67. ! )/
  68. call fstarpu_insert_task((/ cl_vec, FSTARPU_R, dh_va, FSTARPU_RW.ior.FSTARPU_LOCALITY, dh_vb, C_NULL_PTR /))
  69. ! wait for task completion
  70. call fstarpu_task_wait_for_all()
  71. ! unregister 'va'
  72. call fstarpu_data_unregister(dh_va)
  73. ! unregister 'vb'
  74. call fstarpu_data_unregister(dh_vb)
  75. ! free codelet structure
  76. call fstarpu_codelet_free(cl_vec)
  77. ! shut StarPU down
  78. call fstarpu_shutdown()
  79. deallocate(vb)
  80. deallocate(va)
  81. end program nf_vector