nf_matrix.f90 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111
  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_matrix
  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 :: ma
  21. integer, dimension(:,:), allocatable, target :: mb
  22. integer :: i,j
  23. type(c_ptr) :: cl_mat ! a pointer for the codelet structure
  24. type(c_ptr) :: dh_ma ! a pointer for the 'ma' vector data handle
  25. type(c_ptr) :: dh_mb ! a pointer for the 'mb' vector data handle
  26. integer(c_int) :: err ! return status for fstarpu_init
  27. integer(c_int) :: ncpu ! number of cpus workers
  28. allocate(ma(5,6))
  29. do i=1,5
  30. do j=1,6
  31. ma(i,j) = (i*10)+j
  32. end do
  33. end do
  34. allocate(mb(7,8))
  35. do i=1,7
  36. do j=1,8
  37. mb(i,j) = (i*10)+j
  38. end do
  39. end do
  40. ! initialize StarPU with default settings
  41. err = fstarpu_init(C_NULL_PTR)
  42. if (err == -19) then
  43. stop 77
  44. end if
  45. ! stop there if no CPU worker available
  46. ncpu = fstarpu_cpu_worker_get_count()
  47. if (ncpu == 0) then
  48. call fstarpu_shutdown()
  49. stop 77
  50. end if
  51. ! allocate an empty codelet structure
  52. cl_mat = fstarpu_codelet_allocate()
  53. ! set the codelet name
  54. call fstarpu_codelet_set_name(cl_mat, C_CHAR_"my_mat_codelet"//C_NULL_CHAR)
  55. ! add a CPU implementation function to the codelet
  56. call fstarpu_codelet_add_cpu_func(cl_mat, C_FUNLOC(cl_cpu_func_mat))
  57. ! add a Read-only mode data buffer to the codelet
  58. call fstarpu_codelet_add_buffer(cl_mat, FSTARPU_R)
  59. ! add a Read-Write mode data buffer to the codelet
  60. call fstarpu_codelet_add_buffer(cl_mat, FSTARPU_RW)
  61. ! register 'ma', a vector of real(8) elements
  62. !dh_ma = fstarpu_matrix_data_register(c_loc(ma), 5, 5, 6, c_sizeof(ma(1,1)), 0)
  63. call fstarpu_matrix_data_register(dh_ma, 0, c_loc(ma), 5, 5, 6, c_sizeof(ma(1,1)))
  64. ! register 'mb', a vector of integer elements
  65. call fstarpu_matrix_data_register(dh_mb, 0, c_loc(mb), 7, 7, 8, c_sizeof(mb(1,1)))
  66. ! insert a task with codelet cl_mat, and vectors 'ma' and 'mb'
  67. !
  68. ! Note: The array argument must follow the layout:
  69. ! (/
  70. ! <codelet_ptr>,
  71. ! [<argument_type> [<argument_value(s)],]
  72. ! . . .
  73. ! C_NULL_PTR
  74. ! )/
  75. call fstarpu_insert_task((/ cl_mat, FSTARPU_R, dh_ma, FSTARPU_RW, dh_mb, C_NULL_PTR /))
  76. ! wait for task completion
  77. call fstarpu_task_wait_for_all()
  78. ! unregister 'ma'
  79. call fstarpu_data_unregister(dh_ma)
  80. ! unregister 'mb'
  81. call fstarpu_data_unregister(dh_mb)
  82. ! free codelet structure
  83. call fstarpu_codelet_free(cl_mat)
  84. ! shut StarPU down
  85. call fstarpu_shutdown()
  86. deallocate(mb)
  87. deallocate(ma)
  88. end program nf_matrix