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