1!! Copyright (C) 2010-2011 X. Andrade <xavier@tddft.org>
2!!
3!! FortranCL is free software: you can redistribute it and/or modify
4!! it under the terms of the GNU Lesser General Public License as published by
5!! the Free Software Foundation, either version 3 of the License, or
6!! (at your option) any later version.
7!!
8!! FortranCL is distributed in the hope that it will be useful,
9!! but WITHOUT ANY WARRANTY; without even the implied warranty of
10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11!! GNU Lesser General Public License for more details.
12!!
13!! You should have received a copy of the GNU Lesser General Public License
14!! along with this program.  If not, see <http://www.gnu.org/licenses/>.
15!!
16!! $Id$
17
18
19
20module cl_context_m
21  use cl_types_m
22
23  implicit none
24
25  private
26
27  public ::                          &
28    clCreateContext,                 &
29    clReleaseContext,                &
30    clRetainContext
31
32  interface clReleaseContext
33    subroutine clReleaseContext_low(context, errcode_ret)
34      use cl_types_m
35
36      implicit none
37
38      type(cl_context), intent(inout) :: context
39      integer,          intent(out)   :: errcode_ret
40    end subroutine clReleaseContext_low
41  end interface
42
43  ! ---------------------------------------
44
45  interface clRetainContext
46    subroutine clRetainContext_low(context, errcode_ret)
47      use cl_types_m
48
49      implicit none
50
51      type(cl_context), intent(inout) :: context
52      integer,          intent(out)   :: errcode_ret
53    end subroutine clRetainContext_low
54  end interface
55
56  ! ---------------------------------------
57
58  interface clCreateContext
59    module procedure clCreateContext_nocallback
60    module procedure clCreateContext_single
61  end interface clCreateContext
62
63contains
64
65  type(cl_context) function clCreateContext_nocallback(platform, devices, errcode_ret) result(context)
66    type(cl_platform_id), intent(in)   :: platform
67    type(cl_device_id),   intent(in)   :: devices(:)
68    integer,              intent(out)  :: errcode_ret
69
70    interface
71      subroutine clcreatecontext_low(platform, num_devices, devices, errcode_ret, context)
72        use cl_types_m
73
74        implicit none
75
76        type(cl_platform_id), intent(in)   :: platform
77        integer,              intent(in)   :: num_devices
78        type(cl_device_id),   intent(in)   :: devices
79        integer,              intent(out)  :: errcode_ret
80        type(cl_context),     intent(out)  :: context
81      end subroutine clcreatecontext_low
82    end interface
83
84    integer :: idev, num_devices
85    type(cl_device_id), allocatable :: devs(:)
86
87    num_devices = ubound(devices, dim = 1)
88
89    allocate(devs(1:num_devices))
90
91    do idev = 1, num_devices
92      call fortrancl_set_component(devs(1), idev - 1, devices(idev))
93    end do
94
95    call clcreatecontext_low(platform, num_devices, devs(1), errcode_ret, context)
96
97
98    deallocate(devs)
99
100  end function clCreateContext_nocallback
101
102  ! -----------------------------------
103
104  type(cl_context) function clCreateContext_single(platform, devices, errcode_ret) result(context)
105    type(cl_platform_id), intent(in)   :: platform
106    type(cl_device_id),   intent(in)   :: devices
107    integer,              intent(out)  :: errcode_ret
108
109    type(cl_device_id) :: devs(1:1)
110
111    devs(1:1) = devices
112    context = clCreateContext_nocallback(platform, devs, errcode_ret)
113
114  end function clCreateContext_single
115end module cl_context_m
116
117!! Local Variables:
118!! mode: f90
119!! coding: utf-8
120!! End:
121