├── AUTHORS ├── COPYING ├── ChangeLog ├── INSTALL ├── Makefile.am ├── NEWS ├── README ├── configure.ac ├── examples ├── Makefile.am ├── devices.f90 ├── sum.cl └── sum.f90 ├── fortrancl.pc.in ├── m4 ├── acx_pthread.m4 ├── ax_check_cl.m4 ├── ax_lang_compiler_ms.m4 ├── f90_module_extension.m4 ├── f90_module_flag.m4 └── fcflags.m4 ├── src ├── Makefile.am ├── cl.f90 ├── cl_buffer.f90 ├── cl_buffer_low.c ├── cl_command_queue.f90 ├── cl_command_queue_low.c ├── cl_constants.f90 ├── cl_context.f90 ├── cl_context_low.c ├── cl_device.f90 ├── cl_device_low.c ├── cl_event.f90 ├── cl_event_low.c ├── cl_kernel.f90 ├── cl_kernel_low.c ├── cl_platform.f90 ├── cl_platform_low.c ├── cl_program.f90 ├── cl_program_low.c ├── cl_types.f90 ├── localcl.h ├── string_f.h └── utils.c └── testsuite ├── Makefile.am ├── char.cl ├── char.f90 ├── devices.f90 ├── queue.cl ├── queue.f90 ├── sum.cl ├── sum.f90 └── utils.f90 /AUTHORS: -------------------------------------------------------------------------------- 1 | Main author: Xavier Andrade 2 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. 166 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | r19 | xavier.andrade.valencia@gmail.com | 2011-12-17 20:19:57 -0500 (Sat, 17 Dec 2011) | 2 lines 3 | 4 | Wrote the README file. 5 | 6 | ------------------------------------------------------------------------ 7 | r18 | xavier.andrade.valencia@gmail.com | 2011-12-17 19:48:54 -0500 (Sat, 17 Dec 2011) | 4 lines 8 | 9 | * Added LGPL notice to all files. 10 | * Changed "This program" to FortranCL in the LGPL notice. 11 | 12 | 13 | ------------------------------------------------------------------------ 14 | r17 | xavier.andrade.valencia@gmail.com | 2011-12-17 19:31:19 -0500 (Sat, 17 Dec 2011) | 2 lines 15 | 16 | sum.cl was not being included in the distribution. 17 | 18 | ------------------------------------------------------------------------ 19 | r16 | xavier.andrade.valencia@gmail.com | 2011-12-17 19:24:27 -0500 (Sat, 17 Dec 2011) | 2 lines 20 | 21 | Set version to 0.1alpha1. 22 | 23 | ------------------------------------------------------------------------ 24 | r15 | xavier.andrade.valencia@gmail.com | 2011-12-17 19:23:05 -0500 (Sat, 17 Dec 2011) | 3 lines 25 | 26 | Added an example file. 27 | 28 | 29 | ------------------------------------------------------------------------ 30 | r14 | xavier.andrade.valencia@gmail.com | 2011-12-17 18:49:37 -0500 (Sat, 17 Dec 2011) | 3 lines 31 | 32 | Renamed the status argument to errcode_ret. 33 | 34 | 35 | ------------------------------------------------------------------------ 36 | r13 | xavier.andrade.valencia@gmail.com | 2011-12-17 18:24:41 -0500 (Sat, 17 Dec 2011) | 3 lines 37 | 38 | Improved the interface for clEnqueueNDRangeKernel. 39 | 40 | 41 | ------------------------------------------------------------------------ 42 | r12 | xavier.andrade.valencia@gmail.com | 2011-12-17 17:43:50 -0500 (Sat, 17 Dec 2011) | 4 lines 43 | 44 | * The num_devices argument to clCreateContext is not necessary. 45 | * Added a scalar version of clCreateContext. 46 | 47 | 48 | ------------------------------------------------------------------------ 49 | r11 | xavier.andrade.valencia@gmail.com | 2011-12-17 16:45:06 -0500 (Sat, 17 Dec 2011) | 7 lines 50 | 51 | * The interface for clGetDeviceIDs and clGetPlatformIDs no longer 52 | receives the number of entries as argument, they can be obtained from 53 | the array properties. 54 | 55 | * Added a scalar interface for clGetDeviceIDs and clGetPlatformIDs. 56 | 57 | 58 | ------------------------------------------------------------------------ 59 | r10 | xavier.andrade.valencia@gmail.com | 2011-12-17 11:20:31 -0500 (Sat, 17 Dec 2011) | 2 lines 60 | 61 | Fixed wrong intent. 62 | 63 | ------------------------------------------------------------------------ 64 | r9 | xavier.andrade.valencia@gmail.com | 2011-12-16 23:29:40 -0500 (Fri, 16 Dec 2011) | 2 lines 65 | 66 | Removed more unused macros. 67 | 68 | ------------------------------------------------------------------------ 69 | r8 | xavier.andrade.valencia@gmail.com | 2011-12-16 23:20:51 -0500 (Fri, 16 Dec 2011) | 2 lines 70 | 71 | Now `make install` works. 72 | 73 | ------------------------------------------------------------------------ 74 | r7 | xavier.andrade.valencia@gmail.com | 2011-12-16 23:00:47 -0500 (Fri, 16 Dec 2011) | 2 lines 75 | 76 | Fixed copyright. 77 | 78 | ------------------------------------------------------------------------ 79 | r6 | xavier.andrade.valencia@gmail.com | 2011-12-16 22:58:38 -0500 (Fri, 16 Dec 2011) | 2 lines 80 | 81 | Removed unnecessary macros. 82 | 83 | ------------------------------------------------------------------------ 84 | r5 | xavier.andrade.valencia@gmail.com | 2011-12-16 22:48:39 -0500 (Fri, 16 Dec 2011) | 2 lines 85 | 86 | Some files to make autotools happy. 87 | 88 | ------------------------------------------------------------------------ 89 | r4 | xavier.andrade.valencia@gmail.com | 2011-12-16 22:47:25 -0500 (Fri, 16 Dec 2011) | 3 lines 90 | 91 | Basic build system. 92 | 93 | 94 | ------------------------------------------------------------------------ 95 | r3 | xavier.andrade.valencia@gmail.com | 2011-11-21 11:23:06 -0500 (Mon, 21 Nov 2011) | 2 lines 96 | 97 | Fixed a constant definition. 98 | 99 | ------------------------------------------------------------------------ 100 | r2 | xavier.andrade.valencia@gmail.com | 2011-11-06 20:38:26 -0500 (Sun, 06 Nov 2011) | 3 lines 101 | 102 | Initial copy of the FortranCL files. 103 | 104 | 105 | ------------------------------------------------------------------------ 106 | r1 | (no author) | 2011-11-06 19:23:31 -0500 (Sun, 06 Nov 2011) | 1 line 107 | 108 | Initial directory structure. 109 | ------------------------------------------------------------------------ 110 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | Installation Instructions 2 | ************************* 3 | 4 | Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005, 5 | 2006, 2007, 2008, 2009 Free Software Foundation, Inc. 6 | 7 | Copying and distribution of this file, with or without modification, 8 | are permitted in any medium without royalty provided the copyright 9 | notice and this notice are preserved. This file is offered as-is, 10 | without warranty of any kind. 11 | 12 | Basic Installation 13 | ================== 14 | 15 | Briefly, the shell commands `./configure; make; make install' should 16 | configure, build, and install this package. The following 17 | more-detailed instructions are generic; see the `README' file for 18 | instructions specific to this package. Some packages provide this 19 | `INSTALL' file but do not implement all of the features documented 20 | below. The lack of an optional feature in a given package is not 21 | necessarily a bug. More recommendations for GNU packages can be found 22 | in *note Makefile Conventions: (standards)Makefile Conventions. 23 | 24 | The `configure' shell script attempts to guess correct values for 25 | various system-dependent variables used during compilation. It uses 26 | those values to create a `Makefile' in each directory of the package. 27 | It may also create one or more `.h' files containing system-dependent 28 | definitions. Finally, it creates a shell script `config.status' that 29 | you can run in the future to recreate the current configuration, and a 30 | file `config.log' containing compiler output (useful mainly for 31 | debugging `configure'). 32 | 33 | It can also use an optional file (typically called `config.cache' 34 | and enabled with `--cache-file=config.cache' or simply `-C') that saves 35 | the results of its tests to speed up reconfiguring. Caching is 36 | disabled by default to prevent problems with accidental use of stale 37 | cache files. 38 | 39 | If you need to do unusual things to compile the package, please try 40 | to figure out how `configure' could check whether to do them, and mail 41 | diffs or instructions to the address given in the `README' so they can 42 | be considered for the next release. If you are using the cache, and at 43 | some point `config.cache' contains results you don't want to keep, you 44 | may remove or edit it. 45 | 46 | The file `configure.ac' (or `configure.in') is used to create 47 | `configure' by a program called `autoconf'. You need `configure.ac' if 48 | you want to change it or regenerate `configure' using a newer version 49 | of `autoconf'. 50 | 51 | The simplest way to compile this package is: 52 | 53 | 1. `cd' to the directory containing the package's source code and type 54 | `./configure' to configure the package for your system. 55 | 56 | Running `configure' might take a while. While running, it prints 57 | some messages telling which features it is checking for. 58 | 59 | 2. Type `make' to compile the package. 60 | 61 | 3. Optionally, type `make check' to run any self-tests that come with 62 | the package, generally using the just-built uninstalled binaries. 63 | 64 | 4. Type `make install' to install the programs and any data files and 65 | documentation. When installing into a prefix owned by root, it is 66 | recommended that the package be configured and built as a regular 67 | user, and only the `make install' phase executed with root 68 | privileges. 69 | 70 | 5. Optionally, type `make installcheck' to repeat any self-tests, but 71 | this time using the binaries in their final installed location. 72 | This target does not install anything. Running this target as a 73 | regular user, particularly if the prior `make install' required 74 | root privileges, verifies that the installation completed 75 | correctly. 76 | 77 | 6. You can remove the program binaries and object files from the 78 | source code directory by typing `make clean'. To also remove the 79 | files that `configure' created (so you can compile the package for 80 | a different kind of computer), type `make distclean'. There is 81 | also a `make maintainer-clean' target, but that is intended mainly 82 | for the package's developers. If you use it, you may have to get 83 | all sorts of other programs in order to regenerate files that came 84 | with the distribution. 85 | 86 | 7. Often, you can also type `make uninstall' to remove the installed 87 | files again. In practice, not all packages have tested that 88 | uninstallation works correctly, even though it is required by the 89 | GNU Coding Standards. 90 | 91 | 8. Some packages, particularly those that use Automake, provide `make 92 | distcheck', which can by used by developers to test that all other 93 | targets like `make install' and `make uninstall' work correctly. 94 | This target is generally not run by end users. 95 | 96 | Compilers and Options 97 | ===================== 98 | 99 | Some systems require unusual options for compilation or linking that 100 | the `configure' script does not know about. Run `./configure --help' 101 | for details on some of the pertinent environment variables. 102 | 103 | You can give `configure' initial values for configuration parameters 104 | by setting variables in the command line or in the environment. Here 105 | is an example: 106 | 107 | ./configure CC=c99 CFLAGS=-g LIBS=-lposix 108 | 109 | *Note Defining Variables::, for more details. 110 | 111 | Compiling For Multiple Architectures 112 | ==================================== 113 | 114 | You can compile the package for more than one kind of computer at the 115 | same time, by placing the object files for each architecture in their 116 | own directory. To do this, you can use GNU `make'. `cd' to the 117 | directory where you want the object files and executables to go and run 118 | the `configure' script. `configure' automatically checks for the 119 | source code in the directory that `configure' is in and in `..'. This 120 | is known as a "VPATH" build. 121 | 122 | With a non-GNU `make', it is safer to compile the package for one 123 | architecture at a time in the source code directory. After you have 124 | installed the package for one architecture, use `make distclean' before 125 | reconfiguring for another architecture. 126 | 127 | On MacOS X 10.5 and later systems, you can create libraries and 128 | executables that work on multiple system types--known as "fat" or 129 | "universal" binaries--by specifying multiple `-arch' options to the 130 | compiler but only a single `-arch' option to the preprocessor. Like 131 | this: 132 | 133 | ./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ 134 | CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ 135 | CPP="gcc -E" CXXCPP="g++ -E" 136 | 137 | This is not guaranteed to produce working output in all cases, you 138 | may have to build one architecture at a time and combine the results 139 | using the `lipo' tool if you have problems. 140 | 141 | Installation Names 142 | ================== 143 | 144 | By default, `make install' installs the package's commands under 145 | `/usr/local/bin', include files under `/usr/local/include', etc. You 146 | can specify an installation prefix other than `/usr/local' by giving 147 | `configure' the option `--prefix=PREFIX', where PREFIX must be an 148 | absolute file name. 149 | 150 | You can specify separate installation prefixes for 151 | architecture-specific files and architecture-independent files. If you 152 | pass the option `--exec-prefix=PREFIX' to `configure', the package uses 153 | PREFIX as the prefix for installing programs and libraries. 154 | Documentation and other data files still use the regular prefix. 155 | 156 | In addition, if you use an unusual directory layout you can give 157 | options like `--bindir=DIR' to specify different values for particular 158 | kinds of files. Run `configure --help' for a list of the directories 159 | you can set and what kinds of files go in them. In general, the 160 | default for these options is expressed in terms of `${prefix}', so that 161 | specifying just `--prefix' will affect all of the other directory 162 | specifications that were not explicitly provided. 163 | 164 | The most portable way to affect installation locations is to pass the 165 | correct locations to `configure'; however, many packages provide one or 166 | both of the following shortcuts of passing variable assignments to the 167 | `make install' command line to change installation locations without 168 | having to reconfigure or recompile. 169 | 170 | The first method involves providing an override variable for each 171 | affected directory. For example, `make install 172 | prefix=/alternate/directory' will choose an alternate location for all 173 | directory configuration variables that were expressed in terms of 174 | `${prefix}'. Any directories that were specified during `configure', 175 | but not in terms of `${prefix}', must each be overridden at install 176 | time for the entire installation to be relocated. The approach of 177 | makefile variable overrides for each directory variable is required by 178 | the GNU Coding Standards, and ideally causes no recompilation. 179 | However, some platforms have known limitations with the semantics of 180 | shared libraries that end up requiring recompilation when using this 181 | method, particularly noticeable in packages that use GNU Libtool. 182 | 183 | The second method involves providing the `DESTDIR' variable. For 184 | example, `make install DESTDIR=/alternate/directory' will prepend 185 | `/alternate/directory' before all installation names. The approach of 186 | `DESTDIR' overrides is not required by the GNU Coding Standards, and 187 | does not work on platforms that have drive letters. On the other hand, 188 | it does better at avoiding recompilation issues, and works well even 189 | when some directory options were not specified in terms of `${prefix}' 190 | at `configure' time. 191 | 192 | Optional Features 193 | ================= 194 | 195 | If the package supports it, you can cause programs to be installed 196 | with an extra prefix or suffix on their names by giving `configure' the 197 | option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. 198 | 199 | Some packages pay attention to `--enable-FEATURE' options to 200 | `configure', where FEATURE indicates an optional part of the package. 201 | They may also pay attention to `--with-PACKAGE' options, where PACKAGE 202 | is something like `gnu-as' or `x' (for the X Window System). The 203 | `README' should mention any `--enable-' and `--with-' options that the 204 | package recognizes. 205 | 206 | For packages that use the X Window System, `configure' can usually 207 | find the X include and library files automatically, but if it doesn't, 208 | you can use the `configure' options `--x-includes=DIR' and 209 | `--x-libraries=DIR' to specify their locations. 210 | 211 | Some packages offer the ability to configure how verbose the 212 | execution of `make' will be. For these packages, running `./configure 213 | --enable-silent-rules' sets the default to minimal output, which can be 214 | overridden with `make V=1'; while running `./configure 215 | --disable-silent-rules' sets the default to verbose, which can be 216 | overridden with `make V=0'. 217 | 218 | Particular systems 219 | ================== 220 | 221 | On HP-UX, the default C compiler is not ANSI C compatible. If GNU 222 | CC is not installed, it is recommended to use the following options in 223 | order to use an ANSI C compiler: 224 | 225 | ./configure CC="cc -Ae -D_XOPEN_SOURCE=500" 226 | 227 | and if that doesn't work, install pre-built binaries of GCC for HP-UX. 228 | 229 | On OSF/1 a.k.a. Tru64, some versions of the default C compiler cannot 230 | parse its `' header file. The option `-nodtk' can be used as 231 | a workaround. If GNU CC is not installed, it is therefore recommended 232 | to try 233 | 234 | ./configure CC="cc" 235 | 236 | and if that doesn't work, try 237 | 238 | ./configure CC="cc -nodtk" 239 | 240 | On Solaris, don't put `/usr/ucb' early in your `PATH'. This 241 | directory contains several dysfunctional programs; working variants of 242 | these programs are available in `/usr/bin'. So, if you need `/usr/ucb' 243 | in your `PATH', put it _after_ `/usr/bin'. 244 | 245 | On Haiku, software installed for all users goes in `/boot/common', 246 | not `/usr/local'. It is recommended to use the following options: 247 | 248 | ./configure --prefix=/boot/common 249 | 250 | Specifying the System Type 251 | ========================== 252 | 253 | There may be some features `configure' cannot figure out 254 | automatically, but needs to determine by the type of machine the package 255 | will run on. Usually, assuming the package is built to be run on the 256 | _same_ architectures, `configure' can figure that out, but if it prints 257 | a message saying it cannot guess the machine type, give it the 258 | `--build=TYPE' option. TYPE can either be a short name for the system 259 | type, such as `sun4', or a canonical name which has the form: 260 | 261 | CPU-COMPANY-SYSTEM 262 | 263 | where SYSTEM can have one of these forms: 264 | 265 | OS 266 | KERNEL-OS 267 | 268 | See the file `config.sub' for the possible values of each field. If 269 | `config.sub' isn't included in this package, then this package doesn't 270 | need to know the machine type. 271 | 272 | If you are _building_ compiler tools for cross-compiling, you should 273 | use the option `--target=TYPE' to select the type of system they will 274 | produce code for. 275 | 276 | If you want to _use_ a cross compiler, that generates code for a 277 | platform different from the build platform, you should specify the 278 | "host" platform (i.e., that on which the generated programs will 279 | eventually be run) with `--host=TYPE'. 280 | 281 | Sharing Defaults 282 | ================ 283 | 284 | If you want to set default values for `configure' scripts to share, 285 | you can create a site shell script called `config.site' that gives 286 | default values for variables like `CC', `cache_file', and `prefix'. 287 | `configure' looks for `PREFIX/share/config.site' if it exists, then 288 | `PREFIX/etc/config.site' if it exists. Or, you can set the 289 | `CONFIG_SITE' environment variable to the location of the site script. 290 | A warning: not all `configure' scripts look for a site script. 291 | 292 | Defining Variables 293 | ================== 294 | 295 | Variables not defined in a site shell script can be set in the 296 | environment passed to `configure'. However, some packages may run 297 | configure again during the build, and the customized values of these 298 | variables may be lost. In order to avoid this problem, you should set 299 | them in the `configure' command line, using `VAR=value'. For example: 300 | 301 | ./configure CC=/usr/local2/bin/gcc 302 | 303 | causes the specified `gcc' to be used as the C compiler (unless it is 304 | overridden in the site shell script). 305 | 306 | Unfortunately, this technique does not work for `CONFIG_SHELL' due to 307 | an Autoconf bug. Until the bug is fixed you can use this workaround: 308 | 309 | CONFIG_SHELL=/bin/bash /bin/bash ./configure CONFIG_SHELL=/bin/bash 310 | 311 | `configure' Invocation 312 | ====================== 313 | 314 | `configure' recognizes the following options to control how it 315 | operates. 316 | 317 | `--help' 318 | `-h' 319 | Print a summary of all of the options to `configure', and exit. 320 | 321 | `--help=short' 322 | `--help=recursive' 323 | Print a summary of the options unique to this package's 324 | `configure', and exit. The `short' variant lists options used 325 | only in the top level, while the `recursive' variant lists options 326 | also present in any nested packages. 327 | 328 | `--version' 329 | `-V' 330 | Print the version of Autoconf used to generate the `configure' 331 | script, and exit. 332 | 333 | `--cache-file=FILE' 334 | Enable the cache: use and save the results of the tests in FILE, 335 | traditionally `config.cache'. FILE defaults to `/dev/null' to 336 | disable caching. 337 | 338 | `--config-cache' 339 | `-C' 340 | Alias for `--cache-file=config.cache'. 341 | 342 | `--quiet' 343 | `--silent' 344 | `-q' 345 | Do not print messages saying which checks are being made. To 346 | suppress all normal output, redirect it to `/dev/null' (any error 347 | messages will still be shown). 348 | 349 | `--srcdir=DIR' 350 | Look for the package's source code in directory DIR. Usually 351 | `configure' can determine that directory automatically. 352 | 353 | `--prefix=DIR' 354 | Use DIR as the installation prefix. *note Installation Names:: 355 | for more details, including other options available for fine-tuning 356 | the installation locations. 357 | 358 | `--no-create' 359 | `-n' 360 | Run the configure checks, but stop before creating any output 361 | files. 362 | 363 | `configure' also accepts some other, not widely useful, options. Run 364 | `configure --help' for more details. 365 | 366 | -------------------------------------------------------------------------------- /Makefile.am: -------------------------------------------------------------------------------- 1 | ## Process this file with automake to produce Makefile.in 2 | 3 | ## Copyright (C) 2011 X. Andrade 4 | ## 5 | ## FortranCL 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 3 of the License, or 8 | ## (at your option) any later version. 9 | ## 10 | ## FortranCL is distributed in the hope that it will be useful, 11 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ## GNU Lesser General Public License for more details. 14 | ## 15 | ## You should have received a copy of the GNU Lesser General Public License 16 | ## along with this program. If not, see . 17 | ## 18 | ## $Id$ 19 | 20 | ACLOCAL_AMFLAGS = -I m4 21 | 22 | SUBDIRS = src examples testsuite 23 | CLEANFILES = *~ *.bak *.mod *.MOD *.il *.d *.pc ifc* 24 | 25 | pkgconfigdir = $(libdir)/pkgconfig 26 | pkgconfig_DATA = fortrancl.pc 27 | 28 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xavierandrade/fortrancl/865b784c67196ea1dd6781991e88a0544b3cedb8/NEWS -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | FortranCL is an OpenCL interface for Fortran 90. It allows programmers 2 | to call OpenCL directly from Fortran. Kernels are still written in C. 3 | 4 | The interface is designed to be as close to C OpenCL interface as 5 | possible, while written in native Fortran 90 with type checking. 6 | 7 | The interface is not complete but provides all the basic calls 8 | required to write a full Fortran 90 OpenCL program. 9 | 10 | More information and updated versions can be found in the FortranCL website: 11 | 12 | http://code.google.com/p/fortrancl/ 13 | 14 | and in Google Groups: 15 | 16 | fortrancl@googlegroups.com 17 | http://groups.google.com/group/fortrancl 18 | 19 | INSTALLATION 20 | ============ 21 | 22 | To compile and install FortranCL you need a Fortran compiler (the same 23 | you will use to compile your OpenCL Fortran code), Gfortran is a good 24 | choice. 25 | 26 | The basic installation procedure is to run: 27 | 28 | ./configure 29 | make 30 | make install 31 | 32 | The installation directory can be set by the --prefix configure 33 | option. The Fortran compiler can be specified using the FC variable 34 | and the compilation flags with the FCFLAGS variable. For example: 35 | 36 | ./configure --prefix=/opt FC=ifort FCFLAGS="-O3" 37 | 38 | will set the installation directory to /opt and the Fortran compiler 39 | to ifort with the -O3 flag. 40 | 41 | See the INSTALL file for more details. 42 | 43 | USING FORTRANCL 44 | =============== 45 | 46 | To use FortranCL in a Fortran program you need to include the 'cl' 47 | module (i.e. add the 'use cl' statement to your code). You might need 48 | to tell your compiler to look for modules files in /include 49 | (where is the FortranCL installation directory, /usr/local by 50 | default). 51 | 52 | To link you have to add "-L/lib -lfortrancl -lOpenCL" to the 53 | link command, replacing by the FortranCL installation 54 | directory. 55 | 56 | This is a single file compilation example assuming FortranCL was 57 | installed in /usr/local: 58 | 59 | gfortran prog.f90 -o prog -I/usr/local/include -L/usr/local/lib -lfortrancl -lOpenCL 60 | 61 | See the example.f90 file for an example on how to use FortranCL to 62 | write an OpenCL program. 63 | 64 | FORTRANCL INTERFACE 65 | =================== 66 | 67 | The interface of FortranCL is designed to be as close as possible to 68 | the C OpenCL interface as possible, but taking advantage of Fortran 69 | features like polymorphism. It was originally written for the 70 | integration of OpenCL in the Octopus code 71 | (http://tddft.org/programs/octopus/). 72 | 73 | Many calls are missing, but the interface is complete enough to write 74 | a full OpenCL code in Fortran. 75 | 76 | This is an alpha release, our aim is to keep the interface unchanged 77 | for future releases but this is not guaranteed. 78 | 79 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2011 X. Andrade 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 . 15 | ## 16 | ## $Id$ 17 | 18 | AC_INIT([FortranCL],[0.1alpha3],[xavier@tddft.org],[fortrancl]) 19 | AC_CONFIG_SRCDIR([src/cl.f90]) 20 | AM_INIT_AUTOMAKE 21 | 22 | AC_CONFIG_HEADERS([config.h]) 23 | AC_CONFIG_MACRO_DIR([m4]) 24 | 25 | # Installation prefix by default 26 | AC_PREFIX_DEFAULT([/usr/local]) 27 | 28 | # who am i 29 | AC_CANONICAL_HOST 30 | 31 | # Checks for programs. 32 | AC_PROG_INSTALL 33 | AC_PROG_LN_S 34 | AC_PROG_MAKE_SET 35 | AC_PROG_YACC 36 | AC_PROG_SED 37 | 38 | AC_PROG_CC 39 | LT_INIT([disable-shared]) 40 | 41 | # Set proper version 42 | # http://www.gnu.org/software/libtool/manual/html_node/Updating-version-info.html 43 | AC_SUBST([FORTRANCL_SO_VERSION], [0:0:0]) 44 | #AC_SUBST([FORTRANCL_API_VERSION], [1.1]) # set to proper API OpenCL version 45 | 46 | # Checks for header files. 47 | AC_HEADER_STDC 48 | 49 | # Checks for typedefs, structures, and compiler characteristics. 50 | AC_C_CONST 51 | 52 | # Checks for library functions. 53 | AC_PROG_GCC_TRADITIONAL 54 | AC_FUNC_STAT 55 | 56 | ACX_PTHREAD 57 | AX_CHECK_CL 58 | 59 | if test "X$no_cl" = "Xyes"; then 60 | AC_MSG_FAILURE([You need OpenCL]) 61 | fi 62 | 63 | CFLAGS="$CFLAGS $CL_CFLAGS" 64 | LIBS="$LIBS $CL_LIBS" 65 | 66 | AC_PROG_FC([], Fortran 90) 67 | 68 | if test x"$FC" = x; then 69 | AC_MSG_ERROR([Cannot find a Fortran compiler.]) 70 | fi 71 | 72 | acx_save_fcflags="${FCFLAGS}" 73 | AC_LANG_PUSH(Fortran) 74 | AC_FC_SRCEXT(f90) 75 | FCFLAGS="${acx_save_fcflags}" 76 | 77 | ACX_FCFLAGS 78 | 79 | dnl how Fortran mangles function names 80 | AC_FC_WRAPPERS 81 | acx_save_libs="${LIBS}" 82 | LIBS="${FCEXTRALIBS} $FCLIBS" 83 | 84 | AX_F90_MODULE_EXTENSION 85 | AX_F90_MODULE_FLAG 86 | F90_MODULE_FLAG=$ax_cv_f90_modflag 87 | AC_SUBST([F90_MODULE_FLAG]) 88 | 89 | AC_SUBST(ax_cv_f90_modext) 90 | AM_CONDITIONAL(F90_MOD_UPPERCASE, [test x$ax_f90_mod_uppercase = xyes]) 91 | 92 | AC_CONFIG_FILES([Makefile 93 | src/Makefile 94 | examples/Makefile 95 | testsuite/Makefile 96 | fortrancl.pc]) 97 | 98 | AC_OUTPUT 99 | -------------------------------------------------------------------------------- /examples/Makefile.am: -------------------------------------------------------------------------------- 1 | ## Process this file with automake to produce Makefile.in 2 | 3 | ## Copyright (C) 2011 X. Andrade 4 | ## 5 | ## FortranCL 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 3 of the License, or 8 | ## (at your option) any later version. 9 | ## 10 | ## FortranCL is distributed in the hope that it will be useful, 11 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ## GNU Lesser General Public License for more details. 14 | ## 15 | ## You should have received a copy of the GNU Lesser General Public License 16 | ## along with this program. If not, see . 17 | ## 18 | ## $Id$ 19 | 20 | noinst_PROGRAMS = sum devices 21 | 22 | sum_SOURCES = sum.f90 23 | sum_LDADD = $(top_builddir)/src/libfortrancl.la @CL_LIBS@ 24 | dist_noinst_DATA = sum.cl 25 | 26 | devices_SOURCES = devices.f90 27 | devices_LDADD = $(top_builddir)/src/libfortrancl.la @CL_LIBS@ 28 | 29 | AM_FCFLAGS = @F90_MODULE_FLAG@$(top_builddir)/src 30 | 31 | CLEANFILES = *~ *.bak *.mod *.MOD *.il *.d *.pc* ifc* $(noinst_PROGRAMS) 32 | 33 | -------------------------------------------------------------------------------- /examples/devices.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2011 X. Andrade 2 | !! 3 | !! FortranCL is free software; you can redistribute it and/or modify 4 | !! it under the terms of the GNU General Public License as published by 5 | !! the Free Software Foundation; either version 2, or (at your option) 6 | !! 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 General Public License for more details. 12 | !! 13 | !! You should have received a copy of the GNU General Public License 14 | !! along with this program; if not, write to the Free Software 15 | !! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 16 | !! 02111-1307, USA. 17 | !! 18 | !! $Id$ 19 | 20 | program devs 21 | use cl 22 | 23 | implicit none 24 | 25 | type(cl_platform_id), allocatable :: platforms(:) 26 | type(cl_device_id), allocatable :: devices(:) 27 | integer :: num_platforms, num_devices, ierr, iplat, idev 28 | integer(8) :: val 29 | character(len=200) :: info 30 | 31 | ! get the number of platforms 32 | call clGetPlatformIDs(num_platforms, ierr) 33 | 34 | allocate(platforms(1:num_platforms)) 35 | 36 | write(*, '(a,i1)') 'Number of CL platforms : ', num_platforms 37 | write(*, '(a)') '' 38 | 39 | 40 | ! get an array of platforms 41 | call clGetPlatformIDs(platforms, num_platforms, ierr) 42 | 43 | ! iterate over platforms 44 | do iplat = 1, num_platforms 45 | 46 | ! print some info 47 | write(*, '(a,i1)') 'Platform number : ', iplat 48 | 49 | call clGetPlatformInfo(platforms(iplat), CL_PLATFORM_VENDOR, info, ierr) 50 | write(*, '(2a)') 'Vendor : ', trim(info) 51 | 52 | call clGetPlatformInfo(platforms(iplat), CL_PLATFORM_NAME, info, ierr) 53 | write(*, '(2a)') 'Name : ', trim(info) 54 | 55 | call clGetPlatformInfo(platforms(iplat), CL_PLATFORM_VERSION, info, ierr) 56 | write(*, '(2a)') 'Version : ', trim(info) 57 | 58 | ! get the device ID 59 | call clGetDeviceIDs(platforms(iplat), CL_DEVICE_TYPE_ALL, num_devices, ierr) 60 | 61 | write(*, '(a,i1)') 'Number of devices : ', num_devices 62 | write(*, '(a)') '' 63 | 64 | allocate(devices(1:num_devices)) 65 | 66 | ! get the device ID 67 | call clGetDeviceIDs(platforms(iplat), CL_DEVICE_TYPE_ALL, devices, num_devices, ierr) 68 | 69 | do idev = 1, num_devices 70 | write(*, '(a,i1)') ' Device number : ', idev 71 | 72 | call clGetDeviceInfo(devices(idev), CL_DEVICE_TYPE, val, ierr) 73 | select case(val) 74 | case(CL_DEVICE_TYPE_CPU) 75 | info = 'CPU' 76 | case(CL_DEVICE_TYPE_GPU) 77 | info = 'GPU' 78 | case(CL_DEVICE_TYPE_ACCELERATOR) 79 | info = 'Accelerator' 80 | end select 81 | 82 | write(*, '(2a)') ' Device type : ', trim(info) 83 | 84 | call clGetDeviceInfo(devices(idev), CL_DEVICE_VENDOR, info, ierr) 85 | write(*, '(2a)') ' Device vendor : ', trim(info) 86 | 87 | call clGetDeviceInfo(devices(idev), CL_DEVICE_NAME, info, ierr) 88 | write(*, '(2a)') ' Device name : ', trim(info) 89 | 90 | call clGetDeviceInfo(devices(idev), CL_DEVICE_GLOBAL_MEM_SIZE, val, ierr) 91 | write(*, '(a,i4)') ' Device memory : ', val/1024**2 92 | 93 | write(*, '(a)') '' 94 | end do 95 | 96 | deallocate(devices) 97 | write(*, '(a)') '' 98 | 99 | end do 100 | 101 | 102 | deallocate(platforms) 103 | 104 | end program devs 105 | -------------------------------------------------------------------------------- /examples/sum.cl: -------------------------------------------------------------------------------- 1 | /* Copyright (C) 2011 X. Andrade 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 . 15 | ** 16 | ** $Id$ 17 | **/ 18 | 19 | __kernel void sum(const int size, const __global float * vec1, __global float * vec2){ 20 | int ii = get_global_id(0); 21 | 22 | if(ii < size) vec2[ii] += vec1[ii]; 23 | 24 | } 25 | -------------------------------------------------------------------------------- /examples/sum.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2011 X. Andrade 2 | !! 3 | !! FortranCL is free software; you can redistribute it and/or modify 4 | !! it under the terms of the GNU General Public License as published by 5 | !! the Free Software Foundation; either version 2, or (at your option) 6 | !! 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 General Public License for more details. 12 | !! 13 | !! You should have received a copy of the GNU General Public License 14 | !! along with this program; if not, write to the Free Software 15 | !! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 16 | !! 02111-1307, USA. 17 | !! 18 | !! $Id$ 19 | 20 | program sum 21 | use cl 22 | 23 | implicit none 24 | 25 | type(cl_platform_id) :: platform 26 | type(cl_device_id) :: device 27 | type(cl_context) :: context 28 | type(cl_command_queue) :: command_queue 29 | type(cl_program) :: prog 30 | type(cl_kernel) :: kernel 31 | 32 | integer :: num, ierr, irec, size 33 | integer(8) :: size_in_bytes, globalsize, localsize 34 | character(len = 100) :: info 35 | integer, parameter :: iunit = 10 36 | integer, parameter :: source_length = 1000 37 | character(len = source_length) :: source 38 | real, allocatable :: vec1(:), vec2(:) 39 | type(cl_mem) :: cl_vec1, cl_vec2 40 | 41 | !===================== 42 | ! INITIALIZATION 43 | !===================== 44 | 45 | ! get the platform ID 46 | call clGetPlatformIDs(platform, num, ierr) 47 | if(ierr /= CL_SUCCESS) stop "Cannot get CL platform." 48 | 49 | ! get the device ID 50 | call clGetDeviceIDs(platform, CL_DEVICE_TYPE_ALL, device, num, ierr) 51 | if(ierr /= CL_SUCCESS) stop "Cannot get CL device." 52 | 53 | ! get the device name and print it 54 | call clGetDeviceInfo(device, CL_DEVICE_NAME, info, ierr) 55 | print*, "CL device: ", info 56 | 57 | ! create the context and the command queue 58 | context = clCreateContext(platform, device, ierr) 59 | command_queue = clCreateCommandQueue(context, device, CL_QUEUE_PROFILING_ENABLE, ierr) 60 | 61 | !===================== 62 | ! BUILD THE KERNEL 63 | !===================== 64 | 65 | ! read the source file 66 | open(unit = iunit, file = 'sum.cl', access='direct', status = 'old', action = 'read', iostat = ierr, recl = 1) 67 | if (ierr /= 0) stop 'Cannot open file sum.cl' 68 | 69 | source = '' 70 | irec = 1 71 | do 72 | read(unit = iunit, rec = irec, iostat = ierr) source(irec:irec) 73 | if (ierr /= 0) exit 74 | if(irec == source_length) stop 'Error: CL source file is too big' 75 | irec = irec + 1 76 | end do 77 | close(unit = iunit) 78 | 79 | ! create the program 80 | prog = clCreateProgramWithSource(context, source, ierr) 81 | if(ierr /= CL_SUCCESS) stop 'Error: cannot create program from source.' 82 | 83 | ! build 84 | call clBuildProgram(prog, '-cl-mad-enable', ierr) 85 | 86 | ! get the compilation log 87 | call clGetProgramBuildInfo(prog, device, CL_PROGRAM_BUILD_LOG, source, irec) 88 | if(len(trim(source)) > 0) print*, trim(source) 89 | 90 | if(ierr /= CL_SUCCESS) stop 'Error: program build failed.' 91 | 92 | ! finally get the kernel and release the program 93 | kernel = clCreateKernel(prog, 'sum', ierr) 94 | call clReleaseProgram(prog, ierr) 95 | 96 | !===================== 97 | ! RUN THE KERNEL 98 | !===================== 99 | 100 | size = 50000 101 | size_in_bytes = int(size, 8)*4_8 102 | allocate(vec1(1:size)) 103 | allocate(vec2(1:size)) 104 | 105 | vec1 = 1.0 106 | vec2 = 2.0 107 | 108 | ! allocate device memory 109 | cl_vec1 = clCreateBuffer(context, CL_MEM_READ_ONLY, size_in_bytes, ierr) 110 | cl_vec2 = clCreateBuffer(context, CL_MEM_READ_WRITE, size_in_bytes, ierr) 111 | 112 | ! copy data to device memory 113 | call clEnqueueWriteBuffer(command_queue, cl_vec1, cl_bool(.true.), 0_8, size_in_bytes, vec1(1), ierr) 114 | call clEnqueueWriteBuffer(command_queue, cl_vec2, cl_bool(.true.), 0_8, size_in_bytes, vec2(1), ierr) 115 | 116 | ! set the kernel arguments 117 | call clSetKernelArg(kernel, 0, size, ierr) 118 | call clSetKernelArg(kernel, 1, cl_vec1, ierr) 119 | call clSetKernelArg(kernel, 2, cl_vec2, ierr) 120 | 121 | ! get the localsize for the kernel (note that the sizes are integer(8) variable) 122 | call clGetKernelWorkGroupInfo(kernel, device, CL_KERNEL_WORK_GROUP_SIZE, localsize, ierr) 123 | globalsize = int(size, 8) 124 | if(mod(globalsize, localsize) /= 0) globalsize = globalsize + localsize - mod(globalsize, localsize) 125 | 126 | ! execute the kernel 127 | call clEnqueueNDRangeKernel(command_queue, kernel, (/globalsize/), (/localsize/), ierr) 128 | call clFinish(command_queue, ierr) 129 | 130 | ! read the resulting vector from device memory 131 | call clEnqueueReadBuffer(command_queue, cl_vec2, cl_bool(.true.), 0_8, size_in_bytes, vec2(1), ierr) 132 | 133 | !===================== 134 | ! RELEASE EVERYTHING 135 | !===================== 136 | 137 | call clReleaseKernel(kernel, ierr) 138 | call clReleaseCommandQueue(command_queue, ierr) 139 | call clReleaseContext(context, ierr) 140 | 141 | end program sum 142 | -------------------------------------------------------------------------------- /fortrancl.pc.in: -------------------------------------------------------------------------------- 1 | Name: @PACKAGE_NAME@ 2 | Description: OpenCL interface for Fortran 90 3 | Version: @PACKAGE_VERSION@ 4 | URL: @PACKAGE_URL@ 5 | Libs: -L${libdir} -lfortrancl 6 | Cflags: -I${includedir}/fortrancl 7 | prefix=@prefix@ 8 | exec_prefix=@exec_prefix@ 9 | libdir=@libdir@ 10 | includedir=@includedir@ 11 | -------------------------------------------------------------------------------- /m4/acx_pthread.m4: -------------------------------------------------------------------------------- 1 | dnl @synopsis ACX_PTHREAD([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]]) 2 | dnl 3 | dnl @summary figure out how to build C programs using POSIX threads 4 | dnl 5 | dnl This macro figures out how to build C programs using POSIX threads. 6 | dnl It sets the PTHREAD_LIBS output variable to the threads library and 7 | dnl linker flags, and the PTHREAD_CFLAGS output variable to any special 8 | dnl C compiler flags that are needed. (The user can also force certain 9 | dnl compiler flags/libs to be tested by setting these environment 10 | dnl variables.) 11 | dnl 12 | dnl Also sets PTHREAD_CC to any special C compiler that is needed for 13 | dnl multi-threaded programs (defaults to the value of CC otherwise). 14 | dnl (This is necessary on AIX to use the special cc_r compiler alias.) 15 | dnl 16 | dnl NOTE: You are assumed to not only compile your program with these 17 | dnl flags, but also link it with them as well. e.g. you should link 18 | dnl with $PTHREAD_CC $CFLAGS $PTHREAD_CFLAGS $LDFLAGS ... $PTHREAD_LIBS 19 | dnl $LIBS 20 | dnl 21 | dnl If you are only building threads programs, you may wish to use 22 | dnl these variables in your default LIBS, CFLAGS, and CC: 23 | dnl 24 | dnl LIBS="$PTHREAD_LIBS $LIBS" 25 | dnl CFLAGS="$CFLAGS $PTHREAD_CFLAGS" 26 | dnl CC="$PTHREAD_CC" 27 | dnl 28 | dnl In addition, if the PTHREAD_CREATE_JOINABLE thread-attribute 29 | dnl constant has a nonstandard name, defines PTHREAD_CREATE_JOINABLE to 30 | dnl that name (e.g. PTHREAD_CREATE_UNDETACHED on AIX). 31 | dnl 32 | dnl ACTION-IF-FOUND is a list of shell commands to run if a threads 33 | dnl library is found, and ACTION-IF-NOT-FOUND is a list of commands to 34 | dnl run it if it is not found. If ACTION-IF-FOUND is not specified, the 35 | dnl default action will define HAVE_PTHREAD. 36 | dnl 37 | dnl Please let the authors know if this macro fails on any platform, or 38 | dnl if you have any other suggestions or comments. This macro was based 39 | dnl on work by SGJ on autoconf scripts for FFTW (www.fftw.org) (with 40 | dnl help from M. Frigo), as well as ac_pthread and hb_pthread macros 41 | dnl posted by Alejandro Forero Cuervo to the autoconf macro repository. 42 | dnl We are also grateful for the helpful feedback of numerous users. 43 | dnl 44 | dnl @category InstalledPackages 45 | dnl @author Steven G. Johnson 46 | dnl @version 2006-05-29 47 | dnl @license GPLWithACException 48 | 49 | AC_DEFUN([ACX_PTHREAD], [ 50 | AC_REQUIRE([AC_CANONICAL_HOST]) 51 | AC_LANG_SAVE 52 | AC_LANG_C 53 | acx_pthread_ok=no 54 | 55 | # We used to check for pthread.h first, but this fails if pthread.h 56 | # requires special compiler flags (e.g. on True64 or Sequent). 57 | # It gets checked for in the link test anyway. 58 | 59 | # First of all, check if the user has set any of the PTHREAD_LIBS, 60 | # etcetera environment variables, and if threads linking works using 61 | # them: 62 | if test x"$PTHREAD_LIBS$PTHREAD_CFLAGS" != x; then 63 | save_CFLAGS="$CFLAGS" 64 | CFLAGS="$CFLAGS $PTHREAD_CFLAGS" 65 | save_LIBS="$LIBS" 66 | LIBS="$PTHREAD_LIBS $LIBS" 67 | AC_MSG_CHECKING([for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS]) 68 | AC_TRY_LINK_FUNC(pthread_join, acx_pthread_ok=yes) 69 | AC_MSG_RESULT($acx_pthread_ok) 70 | if test x"$acx_pthread_ok" = xno; then 71 | PTHREAD_LIBS="" 72 | PTHREAD_CFLAGS="" 73 | fi 74 | LIBS="$save_LIBS" 75 | CFLAGS="$save_CFLAGS" 76 | fi 77 | 78 | # We must check for the threads library under a number of different 79 | # names; the ordering is very important because some systems 80 | # (e.g. DEC) have both -lpthread and -lpthreads, where one of the 81 | # libraries is broken (non-POSIX). 82 | 83 | # Create a list of thread flags to try. Items starting with a "-" are 84 | # C compiler flags, and other items are library names, except for "none" 85 | # which indicates that we try without any flags at all, and "pthread-config" 86 | # which is a program returning the flags for the Pth emulation library. 87 | 88 | acx_pthread_flags="pthreads none -Kthread -kthread lthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config" 89 | 90 | # The ordering *is* (sometimes) important. Some notes on the 91 | # individual items follow: 92 | 93 | # pthreads: AIX (must check this before -lpthread) 94 | # none: in case threads are in libc; should be tried before -Kthread and 95 | # other compiler flags to prevent continual compiler warnings 96 | # -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h) 97 | # -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able) 98 | # lthread: LinuxThreads port on FreeBSD (also preferred to -pthread) 99 | # -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads) 100 | # -pthreads: Solaris/gcc 101 | # -mthreads: Mingw32/gcc, Lynx/gcc 102 | # -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it 103 | # doesn't hurt to check since this sometimes defines pthreads too; 104 | # also defines -D_REENTRANT) 105 | # ... -mt is also the pthreads flag for HP/aCC 106 | # pthread: Linux, etcetera 107 | # --thread-safe: KAI C++ 108 | # pthread-config: use pthread-config program (for GNU Pth library) 109 | 110 | case "${host_cpu}-${host_os}" in 111 | *solaris*) 112 | 113 | # On Solaris (at least, for some versions), libc contains stubbed 114 | # (non-functional) versions of the pthreads routines, so link-based 115 | # tests will erroneously succeed. (We need to link with -pthreads/-mt/ 116 | # -lpthread.) (The stubs are missing pthread_cleanup_push, or rather 117 | # a function called by this macro, so we could check for that, but 118 | # who knows whether they'll stub that too in a future libc.) So, 119 | # we'll just look for -pthreads and -lpthread first: 120 | 121 | acx_pthread_flags="-pthreads pthread -mt -pthread $acx_pthread_flags" 122 | ;; 123 | esac 124 | 125 | if test x"$acx_pthread_ok" = xno; then 126 | for flag in $acx_pthread_flags; do 127 | 128 | case $flag in 129 | none) 130 | AC_MSG_CHECKING([whether pthreads work without any flags]) 131 | ;; 132 | 133 | -*) 134 | AC_MSG_CHECKING([whether pthreads work with $flag]) 135 | PTHREAD_CFLAGS="$flag" 136 | ;; 137 | 138 | pthread-config) 139 | AC_CHECK_PROG(acx_pthread_config, pthread-config, yes, no) 140 | if test x"$acx_pthread_config" = xno; then continue; fi 141 | PTHREAD_CFLAGS="`pthread-config --cflags`" 142 | PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`" 143 | ;; 144 | 145 | *) 146 | AC_MSG_CHECKING([for the pthreads library -l$flag]) 147 | PTHREAD_LIBS="-l$flag" 148 | ;; 149 | esac 150 | 151 | save_LIBS="$LIBS" 152 | save_CFLAGS="$CFLAGS" 153 | LIBS="$PTHREAD_LIBS $LIBS" 154 | CFLAGS="$CFLAGS $PTHREAD_CFLAGS" 155 | 156 | # Check for various functions. We must include pthread.h, 157 | # since some functions may be macros. (On the Sequent, we 158 | # need a special flag -Kthread to make this header compile.) 159 | # We check for pthread_join because it is in -lpthread on IRIX 160 | # while pthread_create is in libc. We check for pthread_attr_init 161 | # due to DEC craziness with -lpthreads. We check for 162 | # pthread_cleanup_push because it is one of the few pthread 163 | # functions on Solaris that doesn't have a non-functional libc stub. 164 | # We try pthread_create on general principles. 165 | AC_TRY_LINK([#include ], 166 | [pthread_t th; pthread_join(th, 0); 167 | pthread_attr_init(0); pthread_cleanup_push(0, 0); 168 | pthread_create(0,0,0,0); pthread_cleanup_pop(0); ], 169 | [acx_pthread_ok=yes]) 170 | 171 | LIBS="$save_LIBS" 172 | CFLAGS="$save_CFLAGS" 173 | 174 | AC_MSG_RESULT($acx_pthread_ok) 175 | if test "x$acx_pthread_ok" = xyes; then 176 | break; 177 | fi 178 | 179 | PTHREAD_LIBS="" 180 | PTHREAD_CFLAGS="" 181 | done 182 | fi 183 | 184 | # Various other checks: 185 | if test "x$acx_pthread_ok" = xyes; then 186 | save_LIBS="$LIBS" 187 | LIBS="$PTHREAD_LIBS $LIBS" 188 | save_CFLAGS="$CFLAGS" 189 | CFLAGS="$CFLAGS $PTHREAD_CFLAGS" 190 | 191 | # Detect AIX lossage: JOINABLE attribute is called UNDETACHED. 192 | AC_MSG_CHECKING([for joinable pthread attribute]) 193 | attr_name=unknown 194 | for attr in PTHREAD_CREATE_JOINABLE PTHREAD_CREATE_UNDETACHED; do 195 | AC_TRY_LINK([#include ], [int attr=$attr; return attr;], 196 | [attr_name=$attr; break]) 197 | done 198 | AC_MSG_RESULT($attr_name) 199 | if test "$attr_name" != PTHREAD_CREATE_JOINABLE; then 200 | AC_DEFINE_UNQUOTED(PTHREAD_CREATE_JOINABLE, $attr_name, 201 | [Define to necessary symbol if this constant 202 | uses a non-standard name on your system.]) 203 | fi 204 | 205 | AC_MSG_CHECKING([if more special flags are required for pthreads]) 206 | flag=no 207 | case "${host_cpu}-${host_os}" in 208 | *-aix* | *-freebsd* | *-darwin*) flag="-D_THREAD_SAFE";; 209 | *solaris* | *-osf* | *-hpux*) flag="-D_REENTRANT";; 210 | esac 211 | AC_MSG_RESULT(${flag}) 212 | if test "x$flag" != xno; then 213 | PTHREAD_CFLAGS="$flag $PTHREAD_CFLAGS" 214 | fi 215 | 216 | LIBS="$save_LIBS" 217 | CFLAGS="$save_CFLAGS" 218 | 219 | # More AIX lossage: must compile with xlc_r or cc_r 220 | if test x"$GCC" != xyes; then 221 | AC_CHECK_PROGS(PTHREAD_CC, xlc_r cc_r, ${CC}) 222 | else 223 | PTHREAD_CC=$CC 224 | fi 225 | else 226 | PTHREAD_CC="$CC" 227 | fi 228 | 229 | AC_SUBST(PTHREAD_LIBS) 230 | AC_SUBST(PTHREAD_CFLAGS) 231 | AC_SUBST(PTHREAD_CC) 232 | 233 | # Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: 234 | if test x"$acx_pthread_ok" = xyes; then 235 | ifelse([$1],,AC_DEFINE(HAVE_PTHREAD,1,[Define if you have POSIX threads libraries and header files.]),[$1]) 236 | : 237 | else 238 | acx_pthread_ok=no 239 | $2 240 | fi 241 | AC_LANG_RESTORE 242 | ])dnl ACX_PTHREAD 243 | -------------------------------------------------------------------------------- /m4/ax_check_cl.m4: -------------------------------------------------------------------------------- 1 | # -*- mode: autoconf -*- 2 | # 3 | # AX_CHECK_CL 4 | # 5 | # Check for an OpenCL implementation. If CL is found, the required compiler 6 | # and linker flags are included in the output variables "CL_CFLAGS" and 7 | # "CL_LIBS", respectively. If no usable CL implementation is found, "no_cl" 8 | # is set to "yes". 9 | # 10 | # If the header "CL/cl.h" is found, "HAVE_CL_CL_H" is defined. If the header 11 | # "OpenCL/cl.h" is found, HAVE_OPENCL_CL_H is defined. These preprocessor 12 | # definitions may not be mutually exclusive. 13 | # 14 | # Based on AX_CHECK_GL, version: 2.4 author: Braden McDaniel 15 | # 16 | # 17 | # This program is free software; you can redistribute it and/or modify 18 | # it under the terms of the GNU General Public License as published by 19 | # the Free Software Foundation; either version 2, or (at your option) 20 | # any later version. 21 | # 22 | # This program is distributed in the hope that it will be useful, 23 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 24 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 25 | # GNU General Public License for more details. 26 | # 27 | # You should have received a copy of the GNU General Public License 28 | # along with this program; if not, write to the Free Software 29 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 30 | # 02110-1301, USA. 31 | # 32 | # As a special exception, the you may copy, distribute and modify the 33 | # configure scripts that are the output of Autoconf when processing 34 | # the Macro. You need not follow the terms of the GNU General Public 35 | # License when using or distributing such scripts. 36 | # 37 | AC_DEFUN([AX_CHECK_CL], 38 | [AC_REQUIRE([AC_CANONICAL_HOST])dnl 39 | AC_REQUIRE([AC_PATH_X])dnl 40 | AC_REQUIRE([AC_PROG_SED])dnl 41 | AC_REQUIRE([ACX_PTHREAD])dnl 42 | 43 | AC_LANG_PUSH([C]) 44 | AX_LANG_COMPILER_MS 45 | AS_IF([test X$ax_compiler_ms = Xno], 46 | [CL_CFLAGS="${PTHREAD_CFLAGS}"; CL_LIBS="${PTHREAD_LIBS} -lm"]) 47 | 48 | # 49 | # Use x_includes and x_libraries if they have been set (presumably by 50 | # AC_PATH_X). 51 | # 52 | AS_IF([test X$no_x != Xyes], 53 | [AS_IF([test -n "$x_includes"], 54 | [CL_CFLAGS="-I$x_includes $CL_CFLAGS"])] 55 | AS_IF([test -n "$x_libraries"], 56 | [CL_LIBS="-L$x_libraries -lX11 $CL_LIBS"])) 57 | 58 | ax_save_CPPFLAGS=$CPPFLAGS 59 | CPPFLAGS="$CL_CFLAGS $CPPFLAGS" 60 | AC_CHECK_HEADERS([CL/cl.h OpenCL/cl.h]) 61 | CPPFLAGS=$ax_save_CPPFLAGS 62 | 63 | AC_CHECK_HEADERS([windows.h]) 64 | 65 | m4_define([AX_CHECK_CL_PROGRAM], 66 | [AC_LANG_PROGRAM([[ 67 | # if defined(HAVE_WINDOWS_H) && defined(_WIN32) 68 | # include 69 | # endif 70 | # ifdef HAVE_CL_CL_H 71 | # include 72 | # elif defined(HAVE_OPENCL_CL_H) 73 | # include 74 | # else 75 | # error no cl.h 76 | # endif]], 77 | [[clFinish(0)]])]) 78 | 79 | AC_CACHE_CHECK([for OpenCL library], [ax_cv_check_cl_libcl], 80 | [ax_cv_check_cl_libcl=no 81 | case $host_cpu in 82 | x86_64) ax_check_cl_libdir=lib64 ;; 83 | *) ax_check_cl_libdir=lib ;; 84 | esac 85 | ax_save_CPPFLAGS=$CPPFLAGS 86 | CPPFLAGS="$CL_CFLAGS $CPPFLAGS" 87 | ax_save_LIBS=$LIBS 88 | LIBS="" 89 | ax_check_libs="-lOpenCL -lCL" 90 | for ax_lib in $ax_check_libs; do 91 | AS_IF([test X$ax_compiler_ms = Xyes], 92 | [ax_try_lib=`echo $ax_lib | $SED -e 's/^-l//' -e 's/$/.lib/'`], 93 | [ax_try_lib=$ax_lib]) 94 | LIBS="$ax_try_lib $CL_LIBS $ax_save_LIBS" 95 | AC_LINK_IFELSE([AX_CHECK_CL_PROGRAM], 96 | [ax_cv_check_cl_libcl=$ax_try_lib; break], 97 | [ax_check_cl_nvidia_flags="-L/usr/$ax_check_cl_libdir/nvidia" LIBS="$ax_try_lib $ax_check_cl_nvidia_flags $CL_LIBS $ax_save_LIBS" 98 | AC_LINK_IFELSE([AX_CHECK_CL_PROGRAM], 99 | [ax_cv_check_cl_libcl="$ax_try_lib $ax_check_cl_nvidia_flags"; break], 100 | [ax_check_cl_dylib_flag='-dylib_file /System/Library/Frameworks/OpenCL.framework/Versions/A/Libraries/libCL.dylib:/System/Library/Frameworks/OpenCL.framework/Versions/A/Libraries/libCL.dylib' LIBS="$ax_try_lib $ax_check_cl_dylib_flag $CL_LIBS $ax_save_LIBS" 101 | AC_LINK_IFELSE([AX_CHECK_CL_PROGRAM], 102 | [ax_cv_check_cl_libcl="$ax_try_lib $ax_check_cl_dylib_flag"; break])])]) 103 | done 104 | 105 | AS_IF([test "X$ax_cv_check_cl_libcl" = Xno -a X$no_x != Xno], 106 | [LIBS='-framework OpenCL' 107 | AC_LINK_IFELSE([AX_CHECK_CL_PROGRAM], 108 | [ax_cv_check_cl_libcl=$LIBS])]) 109 | 110 | LIBS=$ax_save_LIBS 111 | CPPFLAGS=$ax_save_CPPFLAGS]) 112 | 113 | AS_IF([test "X$ax_cv_check_cl_libcl" = Xno], 114 | [no_cl=yes; CL_CFLAGS=""; CL_LIBS=""], 115 | [CL_LIBS="$ax_cv_check_cl_libcl $CL_LIBS"]) 116 | AC_LANG_POP([C]) 117 | 118 | AC_SUBST([CL_CFLAGS]) 119 | AC_SUBST([CL_LIBS]) 120 | ])dnl 121 | -------------------------------------------------------------------------------- /m4/ax_lang_compiler_ms.m4: -------------------------------------------------------------------------------- 1 | # -*- mode: autoconf -*- 2 | # 3 | # Check whether the compiler for the current language is Microsoft. 4 | # 5 | # This macro is modeled after _AC_LANG_COMPILER_GNU in the GNU Autoconf 6 | # implementation. 7 | # 8 | # version: 1.0 9 | # author: Braden McDaniel 10 | # 11 | # This program is free software; you can redistribute it and/or modify 12 | # it under the terms of the GNU General Public License as published by 13 | # the Free Software Foundation; either version 2, or (at your option) 14 | # any later version. 15 | # 16 | # This program is distributed in the hope that it will be useful, 17 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | # GNU General Public License for more details. 20 | # 21 | # You should have received a copy of the GNU General Public License 22 | # along with this program; if not, write to the Free Software 23 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 24 | # 02110-1301, USA. 25 | # 26 | # As a special exception, the you may copy, distribute and modify the 27 | # configure scripts that are the output of Autoconf when processing 28 | # the Macro. You need not follow the terms of the GNU General Public 29 | # License when using or distributing such scripts. 30 | # 31 | AC_DEFUN([AX_LANG_COMPILER_MS], 32 | [AC_CACHE_CHECK([whether we are using the Microsoft _AC_LANG compiler], 33 | [ax_cv_[]_AC_LANG_ABBREV[]_compiler_ms], 34 | [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[#ifndef _MSC_VER 35 | choke me 36 | #endif 37 | ]])], 38 | [ax_compiler_ms=yes], 39 | [ax_compiler_ms=no]) 40 | ax_cv_[]_AC_LANG_ABBREV[]_compiler_ms=$ax_compiler_ms 41 | ])]) 42 | -------------------------------------------------------------------------------- /m4/f90_module_extension.m4: -------------------------------------------------------------------------------- 1 | dnl @synopsis AX_F90_MODULE_EXTENSION 2 | dnl 3 | dnl Find Fortran 90 modules file extension. The module extension is 4 | dnl stored in the cached variable ax_cv_f90_modext, or "unknown" if the 5 | dnl extension cannot be found. 6 | dnl 7 | dnl @category Fortran 8 | dnl @author Luc Maisonobe 9 | dnl @version 2005-06-17 10 | dnl @license AllPermissive 11 | 12 | AC_DEFUN([AX_F90_MODULE_EXTENSION],[ 13 | AC_CACHE_CHECK([fortran 90 modules extension], 14 | ax_cv_f90_modext, 15 | [AC_LANG_PUSH(Fortran) 16 | ax_f90_mod_uppercase=no 17 | i=0 18 | while test \( -f tmpdir_$i \) -o \( -d tmpdir_$i \) ; do 19 | i=`expr $i + 1` 20 | done 21 | mkdir tmpdir_$i 22 | cd tmpdir_$i 23 | AC_COMPILE_IFELSE([module conftest_module 24 | contains 25 | subroutine conftest_routine 26 | write(*,'(a)') 'gotcha!' 27 | end subroutine conftest_routine 28 | end module conftest_module 29 | ], 30 | [ax_cv_f90_modext=`ls | sed -n 's,conftest_module\.,,p'` 31 | if test x$ax_cv_f90_modext = x ; then 32 | dnl Some F90 compilers put module filename in uppercase letters 33 | ax_cv_f90_modext=`ls | sed -n 's,CONFTEST_MODULE\.,,p'` 34 | if test x$ax_cv_f90_modext = x ; then 35 | ax_cv_f90_modext=unknown 36 | else 37 | ax_f90_mod_uppercase=yes 38 | fi 39 | fi 40 | ], 41 | [ax_cv_f90_modext=unknown]) 42 | cd .. 43 | rm -fr tmpdir_$i 44 | AC_LANG_POP(Fortran) 45 | ])]) 46 | -------------------------------------------------------------------------------- /m4/f90_module_flag.m4: -------------------------------------------------------------------------------- 1 | dnl @synopsis AX_F90_MODULE_FLAG 2 | dnl 3 | dnl @summary Find Fortran 90 modules inclusion flag. 4 | dnl 5 | dnl Find Fortran 90 modules inclusion flag. The module inclusion flag 6 | dnl is stored in the cached variable ax_f90_modflag. An error is 7 | dnl triggered if the flag cannot be found. Supported are the -I GNU 8 | dnl compilers flag, the -M SUN compilers flag, and the -p Absoft Pro 9 | dnl Fortran compiler flag. 10 | dnl 11 | dnl @category Fortran 12 | dnl @author Luc Maisonobe 13 | dnl @author Julian C. Cummings 14 | dnl @version 2006-01-28 15 | dnl @license AllPermissive 16 | 17 | AC_DEFUN([AX_F90_MODULE_FLAG],[ 18 | AC_CACHE_CHECK([fortran 90 modules inclusion flag], 19 | ax_cv_f90_modflag, 20 | [AC_LANG_PUSH(Fortran) 21 | i=0 22 | while test \( -f tmpdir_$i \) -o \( -d tmpdir_$i \) ; do 23 | i=`expr $i + 1` 24 | done 25 | mkdir tmpdir_$i 26 | cd tmpdir_$i 27 | AC_COMPILE_IFELSE([module conftest_module 28 | contains 29 | subroutine conftest_routine 30 | write(*,'(a)') 'gotcha!' 31 | end subroutine conftest_routine 32 | end module conftest_module 33 | ],[],[]) 34 | cd .. 35 | ax_cv_f90_modflag="not found" 36 | for ax_flag in "-I " "-I" "-M" "-p"; do 37 | if test "$ax_cv_f90_modflag" = "not found" ; then 38 | ax_save_FCFLAGS="$FCFLAGS" 39 | FCFLAGS="$ax_save_FCFLAGS ${ax_flag}tmpdir_$i" 40 | AC_COMPILE_IFELSE([program conftest_program 41 | use conftest_module 42 | call conftest_routine 43 | end program conftest_program 44 | ],[ax_cv_f90_modflag="$ax_flag"],[]) 45 | FCFLAGS="$ax_save_FCFLAGS" 46 | fi 47 | done 48 | rm -fr tmpdir_$i 49 | if test "$ax_flag" = "not found" ; then 50 | AC_MSG_ERROR([unable to find compiler flag for modules inclusion]) 51 | fi 52 | AC_LANG_POP(Fortran) 53 | ])]) 54 | -------------------------------------------------------------------------------- /m4/fcflags.m4: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2002 M. Marques, A. Castro, A. Rubio, G. Bertsch 2 | ## 3 | ## This program 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 2, or (at your option) 6 | ## any later version. 7 | ## 8 | ## This program 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, write to the Free Software 15 | ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 16 | ## 02111-1307, USA. 17 | ## 18 | ## $Id: fcflags.m4 5257 2009-04-17 12:56:44Z marques $ 19 | ## 20 | ################################################ 21 | # Get default FFLAGS 22 | # ---------------------------------- 23 | # this function can certainly be improved on 24 | AC_DEFUN([ACX_FCFLAGS], 25 | [ 26 | AC_REQUIRE([AC_CANONICAL_HOST]) 27 | 28 | if test -z "${FCFLAGS}"; then 29 | case "${FC}" in 30 | gfortran*) 31 | FCFLAGS="-pipe -O3 -funroll-loops -ffast-math -ffree-line-length-none" 32 | ;; 33 | openf9*) 34 | FCFLAGS="-O3 -funroll-loops -ffast-math" 35 | ;; 36 | g95*) 37 | FCFLAGS="-pipe -O3 -funroll-loops -ffast-math" 38 | ;; 39 | efc*|ifc*|ifort*) 40 | case "${host}" in 41 | x86_64*) 42 | FCFLAGS="-u -fpp1 -nbs -pc80 -pad -align -unroll -O3 -ip -no-fp-port -mno-ieee-fp -vec-report0 -no-prec-div" 43 | ;; 44 | i?86*linux*) 45 | FCFLAGS="-u -fpp1 -nbs -pc80 -pad -align -unroll -O3 -ip -no-fp-port -mno-ieee-fp -vec-report0 -no-prec-div" 46 | a=`echo $host | sed "s/^i//" | sed "s/86.*//"` 47 | if test "$a" -gt 5 ; then 48 | FCFLAGS="$FCFLAGS -tpp7 -xW" 49 | fi 50 | ;; 51 | ia64*) 52 | FCFLAGS="-O3 -ip -IPF_fp_relaxed -ftz -fpp -u -align all -pad" 53 | ;; 54 | esac 55 | ;; 56 | sun*) 57 | case "${host}" in 58 | i?86*linux*|x86_64*) 59 | FCFLAGS="-fast -xprefetch -xvector=simd" 60 | ;; 61 | sparc*) 62 | FCFLAGS="-fast" 63 | ;; 64 | esac 65 | ;; 66 | pathf9*) 67 | FCFLAGS="-O3 -march=auto -mcpu=auto -OPT:Ofast -fno-math-errno -LNO:simd=2 -OPT:align_unsafe=ON" 68 | ;; 69 | pgf90*) 70 | FCFLAGS="-O4 -fast -Munroll -Mnoframe -Mdalign" 71 | ;; 72 | abf90*) 73 | FCFLAGS="-O3 -YEXT_NAMES=LCS -YEXT_SFX=_" 74 | ;; 75 | xlf*) 76 | FCFLAGS="-O3 -qarch=auto -qtune=auto -qcache=auto -qxlf90=autodealloc" 77 | ;; 78 | f9*) 79 | case "${host}" in 80 | alphaev*) 81 | FCFLAGS="-align dcommons -fast -tune host -arch host -noautomatic" 82 | ;; 83 | mips*) 84 | FCFLAGS="-Ofast -O3" 85 | ;; 86 | sparc*) 87 | FCFLAGS="-fast" 88 | ;; 89 | *) 90 | FCFLAGS="-O3" 91 | ;; 92 | esac 93 | ;; 94 | *) 95 | FCFLAGS="-O3" 96 | ;; 97 | esac 98 | fi 99 | AC_MSG_NOTICE([Using FCFLAGS="$FCFLAGS"]) 100 | ]) 101 | -------------------------------------------------------------------------------- /src/Makefile.am: -------------------------------------------------------------------------------- 1 | ## Process this file with automake to produce Makefile.in 2 | 3 | ## Copyright (C) 2011 X. Andrade 4 | ## 5 | ## FortranCL 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 3 of the License, or 8 | ## (at your option) any later version. 9 | ## 10 | ## FortranCL is distributed in the hope that it will be useful, 11 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ## GNU Lesser General Public License for more details. 14 | ## 15 | ## You should have received a copy of the GNU Lesser General Public License 16 | ## along with this program. If not, see . 17 | ## 18 | ## $Id$ 19 | 20 | if F90_MOD_UPPERCASE 21 | LIBFUNCMOD = CL.@ax_cv_f90_modext@ 22 | else 23 | LIBFUNCMOD = cl.@ax_cv_f90_modext@ 24 | endif 25 | 26 | AM_CFLAGS= @CL_CFLAGS@ 27 | 28 | fortrancl_includedir = $(includedir) 29 | nodist_fortrancl_include_HEADERS = $(LIBFUNCMOD) 30 | 31 | lib_LTLIBRARIES = libfortrancl.la 32 | 33 | libfortrancl_la_SOURCES = \ 34 | cl_types.f90 \ 35 | cl_buffer.f90 \ 36 | cl_command_queue.f90 \ 37 | cl_constants.f90 \ 38 | cl_context.f90 \ 39 | cl_device.f90 \ 40 | cl_kernel.f90 \ 41 | cl_platform.f90 \ 42 | cl_program.f90 \ 43 | cl_event.f90 \ 44 | cl.f90 45 | 46 | libfortrancl_la_SOURCES += \ 47 | utils.c \ 48 | cl_buffer_low.c \ 49 | cl_command_queue_low.c \ 50 | cl_context_low.c \ 51 | cl_device_low.c \ 52 | cl_kernel_low.c \ 53 | cl_platform_low.c \ 54 | cl_program_low.c \ 55 | cl_event_low.c 56 | 57 | noinst_HEADERS = \ 58 | string_f.h \ 59 | localcl.h 60 | 61 | $(LIBFUNCMOD): cl.lo 62 | 63 | cl_types.lo : cl_types.f90 64 | cl_constants.lo : cl_constants.f90 65 | cl_platform.lo : cl_platform.f90 cl_types.lo 66 | cl_program.lo : cl_program.f90 cl_types.lo 67 | cl_kernel.lo : cl_kernel.f90 cl_types.lo 68 | cl_device.lo : cl_device.f90 cl_types.lo 69 | cl_context.lo : cl_context.f90 cl_types.lo 70 | cl_command_queue.lo : cl_command_queue.f90 cl_types.lo 71 | cl_buffer.lo : cl_buffer.f90 cl_types.lo 72 | cl.lo : cl.f90 cl_constants.lo cl_types.lo cl_device.lo cl_kernel.lo cl_program.lo cl_platform.lo cl_context.lo cl_command_queue.lo cl_buffer.lo 73 | 74 | CLEANFILES = *~ *.bak *.mod *.MOD *.il *.d *.pc* ifc* 75 | -------------------------------------------------------------------------------- /src/cl.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | module cl 19 | 20 | ! This is the module that should be used by the users. 21 | 22 | use cl_buffer_m 23 | use cl_command_queue_m 24 | use cl_constants_m 25 | use cl_context_m 26 | use cl_device_m 27 | use cl_event_m 28 | use cl_kernel_m 29 | use cl_platform_m 30 | use cl_program_m 31 | use cl_types_m 32 | 33 | implicit none 34 | 35 | end module cl 36 | 37 | !! Local Variables: 38 | !! mode: f90 39 | !! coding: utf-8 40 | !! End: 41 | -------------------------------------------------------------------------------- /src/cl_buffer.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | module cl_buffer_m 19 | use cl_types_m 20 | 21 | implicit none 22 | 23 | private 24 | 25 | public :: & 26 | clCreateBuffer, & 27 | clReleaseMemObject, & 28 | clRetainMemObject 29 | 30 | interface clReleaseMemObject 31 | 32 | subroutine clReleaseMemObject_low(memobj, errcode_ret) 33 | use cl_types_m 34 | 35 | implicit none 36 | 37 | type(cl_mem), intent(inout) :: memobj 38 | integer, intent(out) :: errcode_ret 39 | end subroutine clReleaseMemObject_low 40 | 41 | end interface 42 | 43 | ! ----------------------------------------------- 44 | 45 | interface clRetainMemObject 46 | 47 | subroutine clRetainMemObject_low(memobj, errcode_ret) 48 | use cl_types_m 49 | 50 | implicit none 51 | 52 | type(cl_mem), intent(inout) :: memobj 53 | integer, intent(out) :: errcode_ret 54 | end subroutine clRetainMemObject_low 55 | 56 | end interface clRetainMemObject 57 | 58 | ! ----------------------------------------------- 59 | 60 | interface clCreateBuffer 61 | module procedure clCreateBuffer_noptr 62 | end interface clCreateBuffer 63 | 64 | contains 65 | 66 | type(cl_mem) function clCreateBuffer_noptr(context, flags, size, errcode_ret) result(buffer) 67 | type(cl_context), intent(in) :: context 68 | integer, intent(in) :: flags 69 | integer(8), intent(in) :: size 70 | integer, intent(out) :: errcode_ret 71 | 72 | interface 73 | 74 | subroutine clCreateBuffer_low(context, flags, size, errcode_ret, buffer) 75 | use cl_types_m 76 | 77 | implicit none 78 | 79 | type(cl_context), intent(in) :: context 80 | integer, intent(in) :: flags 81 | integer(8), intent(in) :: size 82 | integer, intent(out) :: errcode_ret 83 | type(cl_mem), intent(out) :: buffer 84 | end subroutine clCreateBuffer_low 85 | 86 | end interface 87 | 88 | call clCreateBuffer_low(context, flags, size, errcode_ret, buffer) 89 | 90 | end function clCreateBuffer_noptr 91 | 92 | end module cl_buffer_m 93 | 94 | !! Local Variables: 95 | !! mode: f90 96 | !! coding: utf-8 97 | !! End: 98 | -------------------------------------------------------------------------------- /src/cl_buffer_low.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** Copyright (C) 2010-2012 X. Andrade 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | #include "localcl.h" 22 | 23 | /* -----------------------------------------------------------------------*/ 24 | 25 | void FC_FUNC_(clcreatebuffer_low, CLCREATEBUFFER_LOW) 26 | (cl_context * context, const int * flags, const cl_long * size, int * errcode_ret, cl_mem * buffer){ 27 | 28 | cl_int errcode_ret_cl; 29 | 30 | *buffer = clCreateBuffer(*context, (cl_mem_flags) *flags, (size_t) *size, NULL, &errcode_ret_cl); 31 | *errcode_ret = (int) errcode_ret_cl; 32 | } 33 | 34 | /* -----------------------------------------------------------------------*/ 35 | 36 | void FC_FUNC_(clreleasememobject_low, CLRELEASEMEMOBJECT_LOW)(cl_mem * memobj, int * status){ 37 | 38 | *status = (int)clReleaseMemObject(*memobj); 39 | } 40 | 41 | /* -----------------------------------------------------------------------*/ 42 | 43 | void FC_FUNC_(clretainmemobject_low, CLRETAINMEMOBJECT_LOW)(cl_mem * memobj, int * status){ 44 | 45 | *status = (int)clRetainMemObject(*memobj); 46 | } 47 | 48 | /* -----------------------------------------------------------------------*/ 49 | -------------------------------------------------------------------------------- /src/cl_command_queue.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | module cl_command_queue_m 19 | use cl_types_m 20 | 21 | implicit none 22 | 23 | private 24 | 25 | ! the functions 26 | public :: & 27 | clCreateCommandQueue, & 28 | clReleaseCommandQueue, & 29 | clRetainCommandQueue, & 30 | clEnqueueNDRangeKernel, & 31 | clEnqueueWriteBuffer, & 32 | clEnqueueReadBuffer, & 33 | clFinish, & 34 | clFlush 35 | 36 | ! The following functions are not declared since they are 37 | ! polymorphic beyond the capabilities of Fortran. They can be 38 | ! called, but no type checking will be done by the compiler. 39 | 40 | ! interface 41 | ! subroutine clEnqueueWriteBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 42 | ! type(cl_command_queue), intent(inout) :: command_queue 43 | ! type(cl_mem), intent(inout) :: buffer 44 | ! integer, intent(in) :: blocking_write 45 | ! integer(8), intent(in) :: offset 46 | ! integer(8), intent(in) :: cb 47 | ! type(any), intent(inout) :: ptr 48 | ! integer, intent(out) :: errcode_ret 49 | ! end subroutine clEnqueueWriteBufferImpl 50 | 51 | ! subroutine clEnqueueReadBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 52 | ! type(cl_command_queue), intent(inout) :: command_queue 53 | ! type(cl_mem), intent(inout) :: buffer 54 | ! integer, intent(in) :: blocking_write 55 | ! integer(8), intent(in) :: offset 56 | ! integer(8), intent(in) :: cb 57 | ! type(any), intent(inout) :: ptr 58 | ! integer, intent(out) :: errcode_ret 59 | ! end subroutine clEnqueueReadBufferImpl 60 | 61 | ! end interface 62 | 63 | ! ---------------------------------------------------- 64 | 65 | interface clReleaseCommandQueue 66 | 67 | subroutine clReleaseCommandQueue_low(command_queue, errcode_ret) 68 | use cl_types_m 69 | 70 | implicit none 71 | 72 | type(cl_command_queue), intent(inout) :: command_queue 73 | integer, intent(out) :: errcode_ret 74 | 75 | end subroutine clReleaseCommandQueue_low 76 | 77 | end interface clReleaseCommandQueue 78 | 79 | ! ---------------------------------------------------- 80 | 81 | interface clRetainCommandQueue 82 | 83 | subroutine clRetainCommandQueue_low(command_queue, errcode_ret) 84 | use cl_types_m 85 | 86 | implicit none 87 | 88 | type(cl_command_queue), intent(inout) :: command_queue 89 | integer, intent(out) :: errcode_ret 90 | 91 | end subroutine clRetainCommandQueue_low 92 | 93 | end interface clRetainCommandQueue 94 | 95 | ! ---------------------------------------------------- 96 | 97 | interface clFinish 98 | 99 | subroutine clFinish_low(command_queue, errcode_ret) 100 | use cl_types_m 101 | 102 | implicit none 103 | 104 | type(cl_command_queue), intent(inout) :: command_queue 105 | integer, intent(out) :: errcode_ret 106 | end subroutine clFinish_low 107 | 108 | end interface clFinish 109 | 110 | ! ---------------------------------------------------- 111 | 112 | interface clFlush 113 | subroutine clFlush_low(command_queue, errcode_ret) 114 | use cl_types_m 115 | 116 | implicit none 117 | 118 | type(cl_command_queue), intent(inout) :: command_queue 119 | integer, intent(out) :: errcode_ret 120 | end subroutine clFlush_low 121 | 122 | end interface clFlush 123 | 124 | ! ---------------------------------------------------- 125 | 126 | interface clEnqueueNDRangeKernel 127 | module procedure clEnqueueNDRangeKernel_simple 128 | module procedure clEnqueueNDRangeKernel_event 129 | end interface clEnqueueNDRangeKernel 130 | 131 | ! --------------------------------------------------- 132 | 133 | interface clCreateCommandQueue 134 | module procedure clCreateCommandQueue_full 135 | end interface clCreateCommandQueue 136 | 137 | ! --------------------------------------------------- 138 | 139 | interface clEnqueueWriteBuffer 140 | module procedure clEnqueueWriteBuffer_integer4 141 | module procedure clEnqueueWriteBuffer_integer8 142 | module procedure clEnqueueWriteBuffer_real4 143 | module procedure clEnqueueWriteBuffer_real8 144 | module procedure clEnqueueWriteBuffer_complex4 145 | module procedure clEnqueueWriteBuffer_complex8 146 | module procedure clEnqueueWriteBuffer_character 147 | end interface clEnqueueWriteBuffer 148 | 149 | ! --------------------------------------------------- 150 | 151 | interface clEnqueueReadBuffer 152 | module procedure clEnqueueReadBuffer_integer4 153 | module procedure clEnqueueReadBuffer_integer8 154 | module procedure clEnqueueReadBuffer_real4 155 | module procedure clEnqueueReadBuffer_real8 156 | module procedure clEnqueueReadBuffer_complex4 157 | module procedure clEnqueueReadBuffer_complex8 158 | module procedure clEnqueueReadBuffer_character 159 | end interface clEnqueueReadBuffer 160 | 161 | interface 162 | subroutine clEnqueueNDRangeKernel_low(command_queue, kernel, work_dim, globalsizes, localsizes, event, errcode_ret) 163 | use cl_types_m 164 | 165 | implicit none 166 | 167 | type(cl_command_queue), intent(inout) :: command_queue 168 | type(cl_kernel), intent(inout) :: kernel 169 | integer, intent(in) :: work_dim 170 | integer(8), intent(in) :: globalsizes 171 | integer(8), intent(in) :: localsizes 172 | type(cl_event), intent(out) :: event 173 | integer, intent(out) :: errcode_ret 174 | end subroutine clEnqueueNDRangeKernel_low 175 | end interface 176 | 177 | contains 178 | 179 | ! -------------------------------------------------------- 180 | 181 | type(cl_command_queue) function clCreateCommandQueue_full(context, device, properties, errcode_ret) result(command_queue) 182 | type(cl_context), intent(inout) :: context 183 | type(cl_device_id), intent(inout) :: device 184 | integer, intent(in) :: properties 185 | integer, intent(out) :: errcode_ret 186 | 187 | interface 188 | subroutine clcreatecommandqueue_low(context, device, properties, errcode_ret, command_queue) 189 | use cl_types_m 190 | 191 | implicit none 192 | 193 | type(cl_context), intent(inout) :: context 194 | type(cl_device_id), intent(inout) :: device 195 | integer, intent(in) :: properties 196 | integer, intent(out) :: errcode_ret 197 | type(cl_command_queue), intent(inout) :: command_queue 198 | end subroutine clcreatecommandqueue_low 199 | end interface 200 | 201 | 202 | call clcreatecommandqueue_low(context, device, properties, errcode_ret, command_queue) 203 | 204 | end function clCreateCommandQueue_full 205 | 206 | ! --------------------------------------- 207 | 208 | subroutine clEnqueueNDRangeKernel_simple(command_queue, kernel, globalsizes, localsizes, errcode_ret) 209 | type(cl_command_queue), intent(inout) :: command_queue 210 | type(cl_kernel), intent(inout) :: kernel 211 | integer(8), intent(in) :: globalsizes(:) 212 | integer(8), intent(in) :: localsizes(:) 213 | integer, intent(out) :: errcode_ret 214 | 215 | integer :: work_dim 216 | type(cl_event) :: null_event 217 | 218 | work_dim = min(ubound(globalsizes, dim = 1), ubound(localsizes, dim = 1)) 219 | 220 | call fortrancl_set_null(null_event) 221 | 222 | call clEnqueueNDRangeKernel_low(command_queue, kernel, work_dim, globalsizes(1), localsizes(1), null_event, errcode_ret) 223 | 224 | end subroutine clEnqueueNDRangeKernel_simple 225 | 226 | ! --------------------------------------- 227 | 228 | subroutine clEnqueueNDRangeKernel_event(command_queue, kernel, globalsizes, localsizes, event, errcode_ret) 229 | type(cl_command_queue), intent(inout) :: command_queue 230 | type(cl_kernel), intent(inout) :: kernel 231 | integer(8), intent(in) :: globalsizes(:) 232 | integer(8), intent(in) :: localsizes(:) 233 | type(cl_event), intent(out) :: event 234 | integer, intent(out) :: errcode_ret 235 | 236 | integer :: work_dim 237 | 238 | work_dim = min(ubound(globalsizes, dim = 1), ubound(localsizes, dim = 1)) 239 | 240 | call clEnqueueNDRangeKernel_low(command_queue, kernel, work_dim, globalsizes(1), localsizes(1), event, errcode_ret) 241 | 242 | end subroutine clEnqueueNDRangeKernel_event 243 | 244 | ! --------------------------------------- 245 | 246 | subroutine clEnqueueWriteBuffer_integer4(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 247 | type(cl_command_queue), intent(inout) :: command_queue 248 | type(cl_mem), intent(inout) :: buffer 249 | integer, intent(in) :: blocking_write 250 | integer(8), intent(in) :: offset 251 | integer(8), intent(in) :: cb 252 | integer(4), intent(in) :: ptr 253 | integer, intent(out) :: errcode_ret 254 | 255 | call clEnqueueWriteBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 256 | 257 | end subroutine clEnqueueWriteBuffer_integer4 258 | 259 | ! --------------------------------------- 260 | 261 | subroutine clEnqueueWriteBuffer_integer8(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 262 | type(cl_command_queue), intent(inout) :: command_queue 263 | type(cl_mem), intent(inout) :: buffer 264 | integer, intent(in) :: blocking_write 265 | integer(8), intent(in) :: offset 266 | integer(8), intent(in) :: cb 267 | integer(8), intent(in) :: ptr 268 | integer, intent(out) :: errcode_ret 269 | 270 | call clEnqueueWriteBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 271 | 272 | end subroutine clEnqueueWriteBuffer_integer8 273 | 274 | ! --------------------------------------- 275 | 276 | subroutine clEnqueueWriteBuffer_real4(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 277 | type(cl_command_queue), intent(inout) :: command_queue 278 | type(cl_mem), intent(inout) :: buffer 279 | integer, intent(in) :: blocking_write 280 | integer(8), intent(in) :: offset 281 | integer(8), intent(in) :: cb 282 | real(4), intent(in) :: ptr 283 | integer, intent(out) :: errcode_ret 284 | 285 | call clEnqueueWriteBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 286 | 287 | end subroutine clEnqueueWriteBuffer_real4 288 | 289 | ! --------------------------------------- 290 | 291 | subroutine clEnqueueWriteBuffer_real8(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 292 | type(cl_command_queue), intent(inout) :: command_queue 293 | type(cl_mem), intent(inout) :: buffer 294 | integer, intent(in) :: blocking_write 295 | integer(8), intent(in) :: offset 296 | integer(8), intent(in) :: cb 297 | real(8), intent(in) :: ptr 298 | integer, intent(out) :: errcode_ret 299 | 300 | call clEnqueueWriteBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 301 | 302 | end subroutine clEnqueueWriteBuffer_real8 303 | 304 | ! --------------------------------------- 305 | 306 | subroutine clEnqueueWriteBuffer_complex4(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 307 | type(cl_command_queue), intent(inout) :: command_queue 308 | type(cl_mem), intent(inout) :: buffer 309 | integer, intent(in) :: blocking_write 310 | integer(8), intent(in) :: offset 311 | integer(8), intent(in) :: cb 312 | complex(4), intent(in) :: ptr 313 | integer, intent(out) :: errcode_ret 314 | 315 | call clEnqueueWriteBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 316 | 317 | end subroutine clEnqueueWriteBuffer_complex4 318 | 319 | ! --------------------------------------- 320 | 321 | subroutine clEnqueueWriteBuffer_complex8(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 322 | type(cl_command_queue), intent(inout) :: command_queue 323 | type(cl_mem), intent(inout) :: buffer 324 | integer, intent(in) :: blocking_write 325 | integer(8), intent(in) :: offset 326 | integer(8), intent(in) :: cb 327 | complex(8), intent(in) :: ptr 328 | integer, intent(out) :: errcode_ret 329 | 330 | call clEnqueueWriteBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 331 | 332 | end subroutine clEnqueueWriteBuffer_complex8 333 | 334 | ! --------------------------------------- 335 | 336 | subroutine clEnqueueWriteBuffer_character(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 337 | type(cl_command_queue), intent(inout) :: command_queue 338 | type(cl_mem), intent(inout) :: buffer 339 | integer, intent(in) :: blocking_write 340 | integer(8), intent(in) :: offset 341 | integer(8), intent(in) :: cb 342 | character, intent(in) :: ptr 343 | integer, intent(out) :: errcode_ret 344 | 345 | call clEnqueueWriteBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 346 | 347 | end subroutine clEnqueueWriteBuffer_character 348 | 349 | ! --------------------------------------- 350 | 351 | subroutine clEnqueueReadBuffer_integer4(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 352 | type(cl_command_queue), intent(inout) :: command_queue 353 | type(cl_mem), intent(in) :: buffer 354 | integer, intent(in) :: blocking_write 355 | integer(8), intent(in) :: offset 356 | integer(8), intent(in) :: cb 357 | integer(4), intent(out) :: ptr 358 | integer, intent(out) :: errcode_ret 359 | 360 | call clEnqueueReadBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 361 | 362 | end subroutine clEnqueueReadBuffer_integer4 363 | 364 | ! --------------------------------------- 365 | 366 | subroutine clEnqueueReadBuffer_integer8(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 367 | type(cl_command_queue), intent(inout) :: command_queue 368 | type(cl_mem), intent(in) :: buffer 369 | integer, intent(in) :: blocking_write 370 | integer(8), intent(in) :: offset 371 | integer(8), intent(in) :: cb 372 | integer(8), intent(out) :: ptr 373 | integer, intent(out) :: errcode_ret 374 | 375 | call clEnqueueReadBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 376 | 377 | end subroutine clEnqueueReadBuffer_integer8 378 | 379 | ! --------------------------------------- 380 | 381 | subroutine clEnqueueReadBuffer_real4(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 382 | type(cl_command_queue), intent(inout) :: command_queue 383 | type(cl_mem), intent(in) :: buffer 384 | integer, intent(in) :: blocking_write 385 | integer(8), intent(in) :: offset 386 | integer(8), intent(in) :: cb 387 | real(4), intent(out) :: ptr 388 | integer, intent(out) :: errcode_ret 389 | 390 | call clEnqueueReadBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 391 | 392 | end subroutine clEnqueueReadBuffer_real4 393 | 394 | ! --------------------------------------- 395 | 396 | subroutine clEnqueueReadBuffer_real8(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 397 | type(cl_command_queue), intent(inout) :: command_queue 398 | type(cl_mem), intent(in) :: buffer 399 | integer, intent(in) :: blocking_write 400 | integer(8), intent(in) :: offset 401 | integer(8), intent(in) :: cb 402 | real(8), intent(out) :: ptr 403 | integer, intent(out) :: errcode_ret 404 | 405 | call clEnqueueReadBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 406 | 407 | end subroutine clEnqueueReadBuffer_real8 408 | 409 | ! --------------------------------------- 410 | 411 | subroutine clEnqueueReadBuffer_complex4(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 412 | type(cl_command_queue), intent(inout) :: command_queue 413 | type(cl_mem), intent(in) :: buffer 414 | integer, intent(in) :: blocking_write 415 | integer(8), intent(in) :: offset 416 | integer(8), intent(in) :: cb 417 | complex(4), intent(out) :: ptr 418 | integer, intent(out) :: errcode_ret 419 | 420 | call clEnqueueReadBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 421 | 422 | end subroutine clEnqueueReadBuffer_complex4 423 | 424 | ! --------------------------------------- 425 | 426 | subroutine clEnqueueReadBuffer_complex8(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 427 | type(cl_command_queue), intent(inout) :: command_queue 428 | type(cl_mem), intent(in) :: buffer 429 | integer, intent(in) :: blocking_write 430 | integer(8), intent(in) :: offset 431 | integer(8), intent(in) :: cb 432 | complex(8), intent(out) :: ptr 433 | integer, intent(out) :: errcode_ret 434 | 435 | call clEnqueueReadBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 436 | 437 | end subroutine clEnqueueReadBuffer_complex8 438 | 439 | ! --------------------------------------- 440 | 441 | subroutine clEnqueueReadBuffer_character(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 442 | type(cl_command_queue), intent(inout) :: command_queue 443 | type(cl_mem), intent(in) :: buffer 444 | integer, intent(in) :: blocking_write 445 | integer(8), intent(in) :: offset 446 | integer(8), intent(in) :: cb 447 | character, intent(out) :: ptr 448 | integer, intent(out) :: errcode_ret 449 | 450 | call clEnqueueReadBufferImpl(command_queue, buffer, blocking_write, offset, cb, ptr, errcode_ret) 451 | 452 | end subroutine clEnqueueReadBuffer_character 453 | 454 | ! --------------------------------------- 455 | 456 | end module cl_command_queue_m 457 | 458 | !! Local Variables: 459 | !! mode: f90 460 | !! coding: utf-8 461 | !! End: 462 | -------------------------------------------------------------------------------- /src/cl_command_queue_low.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** Copyright (C) 2010-2012 X. Andrade 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | #include 22 | #include "localcl.h" 23 | 24 | /* -----------------------------------------------------------------------*/ 25 | 26 | void FC_FUNC_(clcreatecommandqueue_low, CLCREATECOMMANDQUEUE_LOW) 27 | (cl_context * context, cl_device_id * device, const int * properties, int * status, cl_command_queue * command_queue){ 28 | cl_int status_cl; 29 | *command_queue = clCreateCommandQueue(*context, *device, (cl_command_queue_properties) *properties, &status_cl); 30 | *status = (int) status_cl; 31 | } 32 | 33 | /* -----------------------------------------------------------------------*/ 34 | 35 | void FC_FUNC_(clreleasecommandqueue_low, CLRELEASECOMMANDQUEUE_LOW)(cl_command_queue * command_queue, int * status){ 36 | *status = (int) clReleaseCommandQueue(*command_queue); 37 | } 38 | 39 | /* -----------------------------------------------------------------------*/ 40 | 41 | void FC_FUNC_(clretaincommandqueue_low, CLRETAINCOMMANDQUEUE_LOW)(cl_command_queue * command_queue, int * status){ 42 | *status = (int) clRetainCommandQueue(*command_queue); 43 | } 44 | 45 | /* -----------------------------------------------------------------------*/ 46 | 47 | void FC_FUNC_(clfinish_low, CLFINISH_LOW)(cl_command_queue * command_queue, int * status){ 48 | *status = (int) clFinish(*command_queue); 49 | } 50 | 51 | /* -----------------------------------------------------------------------*/ 52 | 53 | void FC_FUNC_(clflush_low, CLFLUSH_LOW)(cl_command_queue * command_queue, int * status){ 54 | *status = (int) clFlush(*command_queue); 55 | } 56 | 57 | /* -----------------------------------------------------------------------*/ 58 | 59 | void FC_FUNC_(clenqueuendrangekernel_low, CLENQUEUENDRANGEKERNEL_LOW) 60 | (cl_command_queue * command_queue, cl_kernel * kernel, const int * work_dim, 61 | const cl_long * global_work_size, const cl_long * local_work_size, cl_event * event, int * status){ 62 | 63 | int ii; 64 | size_t * gsizes = (size_t *) malloc((*work_dim)*sizeof(size_t)); 65 | size_t * lsizes = (size_t *) malloc((*work_dim)*sizeof(size_t)); 66 | 67 | for(ii = 0; ii < *work_dim; ii++) { 68 | gsizes[ii] = (size_t) global_work_size[ii]; 69 | lsizes[ii] = (size_t) local_work_size[ii]; 70 | } 71 | 72 | if(*event == NULL){ 73 | *status = (int) clEnqueueNDRangeKernel(*command_queue, *kernel, (cl_uint) *work_dim, 74 | NULL, gsizes, lsizes, 0, NULL, NULL); 75 | } else { 76 | *status = (int) clEnqueueNDRangeKernel(*command_queue, *kernel, (cl_uint) *work_dim, 77 | NULL, gsizes, lsizes, 0, NULL, event); 78 | } 79 | 80 | free(gsizes); 81 | free(lsizes); 82 | 83 | } 84 | 85 | /* -----------------------------------------------------------------------*/ 86 | 87 | void FC_FUNC(clenqueuewritebufferimpl, CLENQUEUEWRITEBUFFERIMPL) 88 | (cl_command_queue * command_queue, cl_mem * buffer, const int * blocking_write, 89 | const cl_long * offset, const cl_long * cb, const void * ptr, int * status){ 90 | 91 | *status = (int) clEnqueueWriteBuffer(*command_queue, *buffer, (cl_bool) * blocking_write, 92 | (size_t) *offset, (size_t) *cb, ptr, 0, NULL, NULL); 93 | 94 | } 95 | 96 | /* -----------------------------------------------------------------------*/ 97 | 98 | void FC_FUNC(clenqueuereadbufferimpl, CLENQUEUEREADBUFFERIMPL) 99 | (cl_command_queue * command_queue, cl_mem * buffer, const int * blocking_read, 100 | const cl_long * offset, const cl_long * cb, void * ptr, int * status){ 101 | 102 | *status = (int) clEnqueueReadBuffer(*command_queue, *buffer, (cl_bool) *blocking_read, 103 | (size_t) *offset, (size_t) *cb, ptr, 0, NULL, NULL); 104 | } 105 | 106 | -------------------------------------------------------------------------------- /src/cl_constants.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | module cl_constants_m 19 | 20 | implicit none 21 | 22 | private 23 | 24 | public :: & 25 | cl_bool 26 | 27 | ! these values replicate the values from OpenCL include CL/cl.h 28 | 29 | ! Error Codes 30 | integer, parameter, public :: CL_SUCCESS = 0 31 | integer, parameter, public :: CL_DEVICE_NOT_FOUND = -1 32 | integer, parameter, public :: CL_DEVICE_NOT_AVAILABLE = -2 33 | integer, parameter, public :: CL_COMPILER_NOT_AVAILABLE = -3 34 | integer, parameter, public :: CL_MEM_OBJECT_ALLOCATION_FAILURE = -4 35 | integer, parameter, public :: CL_OUT_OF_RESOURCES = -5 36 | integer, parameter, public :: CL_OUT_OF_HOST_MEMORY = -6 37 | integer, parameter, public :: CL_PROFILING_INFO_NOT_AVAILABLE = -7 38 | integer, parameter, public :: CL_MEM_COPY_OVERLAP = -8 39 | integer, parameter, public :: CL_IMAGE_FORMAT_MISMATCH = -9 40 | integer, parameter, public :: CL_IMAGE_FORMAT_NOT_SUPPORTED = -10 41 | integer, parameter, public :: CL_BUILD_PROGRAM_FAILURE = -11 42 | integer, parameter, public :: CL_MAP_FAILURE = -12 43 | integer, parameter, public :: CL_INVALID_VALUE = -30 44 | integer, parameter, public :: CL_INVALID_DEVICE_TYPE = -31 45 | integer, parameter, public :: CL_INVALID_PLATFORM = -32 46 | integer, parameter, public :: CL_INVALID_DEVICE = -33 47 | integer, parameter, public :: CL_INVALID_CONTEXT = -34 48 | integer, parameter, public :: CL_INVALID_QUEUE_PROPERTIES = -35 49 | integer, parameter, public :: CL_INVALID_COMMAND_QUEUE = -36 50 | integer, parameter, public :: CL_INVALID_HOST_PTR = -37 51 | integer, parameter, public :: CL_INVALID_MEM_OBJECT = -38 52 | integer, parameter, public :: CL_INVALID_IMAGE_FORMAT_DESC = -39 53 | integer, parameter, public :: CL_INVALID_IMAGE_FORMAT_DESCRIPTOR = -39 54 | integer, parameter, public :: CL_INVALID_IMAGE_SIZE = -40 55 | integer, parameter, public :: CL_INVALID_SAMPLER = -41 56 | integer, parameter, public :: CL_INVALID_BINARY = -42 57 | integer, parameter, public :: CL_INVALID_BUILD_OPTIONS = -43 58 | integer, parameter, public :: CL_INVALID_PROGRAM = -44 59 | integer, parameter, public :: CL_INVALID_PROGRAM_EXECUTABLE = -45 60 | integer, parameter, public :: CL_INVALID_KERNEL_NAME = -46 61 | integer, parameter, public :: CL_INVALID_KERNEL_DEFINITION = -47 62 | integer, parameter, public :: CL_INVALID_KERNEL = -48 63 | integer, parameter, public :: CL_INVALID_ARG_INDEX = -49 64 | integer, parameter, public :: CL_INVALID_ARG_VALUE = -50 65 | integer, parameter, public :: CL_INVALID_ARG_SIZE = -51 66 | integer, parameter, public :: CL_INVALID_KERNEL_ARGS = -52 67 | integer, parameter, public :: CL_INVALID_WORK_DIMENSION = -53 68 | integer, parameter, public :: CL_INVALID_WORK_GROUP_SIZE = -54 69 | integer, parameter, public :: CL_INVALID_WORK_ITEM_SIZE = -55 70 | integer, parameter, public :: CL_INVALID_GLOBAL_OFFSET = -56 71 | integer, parameter, public :: CL_INVALID_EVENT_WAIT_LIST = -57 72 | integer, parameter, public :: CL_INVALID_EVENT = -58 73 | integer, parameter, public :: CL_INVALID_OPERATION = -59 74 | integer, parameter, public :: CL_INVALID_GL_OBJECT = -60 75 | integer, parameter, public :: CL_INVALID_BUFFER_SIZE = -61 76 | integer, parameter, public :: CL_INVALID_MIP_LEVEL = -62 77 | integer, parameter, public :: CL_INVALID_GLOBAL_WORK_SIZE = -63 78 | ! /* Additional Error Codes (from cl_ext.h) */ 79 | integer, parameter, public :: CL_PLATFORM_NOT_FOUND_KHR = -1001 80 | 81 | ! /* cl_device_info */ 82 | integer, parameter, public :: CL_DEVICE_TYPE = 4096 ! 0x1000 83 | integer, parameter, public :: CL_DEVICE_VENDOR_ID = 4097 ! 0x1001 84 | integer, parameter, public :: CL_DEVICE_MAX_COMPUTE_UNITS = 4098 ! 0x1002 85 | integer, parameter, public :: CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS = 4099 ! 0x1003 86 | integer, parameter, public :: CL_DEVICE_MAX_WORK_GROUP_SIZE = 4100 ! 0x1004 87 | integer, parameter, public :: CL_DEVICE_MAX_WORK_ITEM_SIZES = 4101 ! 0x1005 88 | integer, parameter, public :: CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR = 4102 ! 0x1006 89 | integer, parameter, public :: CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT = 4103 ! 0x1007 90 | integer, parameter, public :: CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT = 4104 ! 0x1008 91 | integer, parameter, public :: CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG = 4105 ! 0x1009 92 | integer, parameter, public :: CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT = 4106 ! 0x100A 93 | integer, parameter, public :: CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE = 4107 ! 0x100B 94 | integer, parameter, public :: CL_DEVICE_MAX_CLOCK_FREQUENCY = 4108 ! 0x100C 95 | integer, parameter, public :: CL_DEVICE_ADDRESS_BITS = 4109 ! 0x100D 96 | integer, parameter, public :: CL_DEVICE_MAX_READ_IMAGE_ARGS = 4110 ! 0x100E 97 | integer, parameter, public :: CL_DEVICE_MAX_WRITE_IMAGE_ARGS = 4111 ! 0x100F 98 | integer, parameter, public :: CL_DEVICE_MAX_MEM_ALLOC_SIZE = 4112 ! 0x1010 99 | integer, parameter, public :: CL_DEVICE_IMAGE2D_MAX_WIDTH = 4113 ! 0x1011 100 | integer, parameter, public :: CL_DEVICE_IMAGE2D_MAX_HEIGHT = 4114 ! 0x1012 101 | integer, parameter, public :: CL_DEVICE_IMAGE3D_MAX_WIDTH = 4115 ! 0x1013 102 | integer, parameter, public :: CL_DEVICE_IMAGE3D_MAX_HEIGHT = 4116 ! 0x1014 103 | integer, parameter, public :: CL_DEVICE_IMAGE3D_MAX_DEPTH = 4117 ! 0x1015 104 | integer, parameter, public :: CL_DEVICE_IMAGE_SUPPORT = 4118 ! 0x1016 105 | integer, parameter, public :: CL_DEVICE_MAX_PARAMETER_SIZE = 4119 ! 0x1017 106 | integer, parameter, public :: CL_DEVICE_MAX_SAMPLERS = 4120 ! 0x1018 107 | integer, parameter, public :: CL_DEVICE_MEM_BASE_ADDR_ALIGN = 4121 ! 0x1019 108 | integer, parameter, public :: CL_DEVICE_MIN_DATA_TYPE_ALIGN_SIZE = 4122 ! 0x101A 109 | integer, parameter, public :: CL_DEVICE_SINGLE_FP_CONFIG = 4123 ! 0x101B 110 | integer, parameter, public :: CL_DEVICE_GLOBAL_MEM_CACHE_TYPE = 4124 ! 0x101C 111 | integer, parameter, public :: CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE = 4125 ! 0x101D 112 | integer, parameter, public :: CL_DEVICE_GLOBAL_MEM_CACHE_SIZE = 4126 ! 0x101E 113 | integer, parameter, public :: CL_DEVICE_GLOBAL_MEM_SIZE = 4127 ! 0x101F 114 | integer, parameter, public :: CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE = 4128 ! 0x1020 115 | integer, parameter, public :: CL_DEVICE_MAX_CONSTANT_ARGS = 4129 ! 0x1021 116 | integer, parameter, public :: CL_DEVICE_LOCAL_MEM_TYPE = 4130 ! 0x1022 117 | integer, parameter, public :: CL_DEVICE_LOCAL_MEM_SIZE = 4131 ! 0x1023 118 | integer, parameter, public :: CL_DEVICE_ERROR_CORRECTION_SUPPORT = 4132 ! 0x1024 119 | integer, parameter, public :: CL_DEVICE_PROFILING_TIMER_RESOLUTION = 4133 ! 0x1025 120 | integer, parameter, public :: CL_DEVICE_ENDIAN_LITTLE = 4134 ! 0x1026 121 | integer, parameter, public :: CL_DEVICE_AVAILABLE = 4135 ! 0x1027 122 | integer, parameter, public :: CL_DEVICE_COMPILER_AVAILABLE = 4136 ! 0x1028 123 | integer, parameter, public :: CL_DEVICE_EXECUTION_CAPABILITIES = 4137 ! 0x1029 124 | integer, parameter, public :: CL_DEVICE_QUEUE_PROPERTIES = 4138 ! 0x102A 125 | integer, parameter, public :: CL_DEVICE_NAME = 4139 ! 0x102B 126 | integer, parameter, public :: CL_DEVICE_VENDOR = 4140 ! 0x102C 127 | integer, parameter, public :: CL_DRIVER_VERSION = 4141 ! 0x102D 128 | integer, parameter, public :: CL_DEVICE_PROFILE = 4142 ! 0x102E 129 | integer, parameter, public :: CL_DEVICE_VERSION = 4143 ! 0x102F 130 | integer, parameter, public :: CL_DEVICE_EXTENSIONS = 4144 ! 0x1030 131 | integer, parameter, public :: CL_DEVICE_PLATFORM = 4145 ! 0x1031 132 | !/* 0x1032 reserved for CL_DEVICE_DOUBLE_FP_CONFIG */ 133 | !/* 0x1033 reserved for CL_DEVICE_HALF_FP_CONFIG */ 134 | integer, parameter, public :: CL_DEVICE_PREFERRED_VECTOR_WIDTH_HALF = 4148 ! 0x1034 135 | integer, parameter, public :: CL_DEVICE_HOST_UNIFIED_MEMORY = 4149 ! 0x1035 136 | integer, parameter, public :: CL_DEVICE_NATIVE_VECTOR_WIDTH_CHAR = 4150 ! 0x1036 137 | integer, parameter, public :: CL_DEVICE_NATIVE_VECTOR_WIDTH_SHORT = 4151 ! 0x1037 138 | integer, parameter, public :: CL_DEVICE_NATIVE_VECTOR_WIDTH_INT = 4152 ! 0x1038 139 | integer, parameter, public :: CL_DEVICE_NATIVE_VECTOR_WIDTH_LONG = 4153 ! 0x1039 140 | integer, parameter, public :: CL_DEVICE_NATIVE_VECTOR_WIDTH_FLOAT = 4154 ! 0x103A 141 | integer, parameter, public :: CL_DEVICE_NATIVE_VECTOR_WIDTH_DOUBLE = 4155 ! 0x103B 142 | integer, parameter, public :: CL_DEVICE_NATIVE_VECTOR_WIDTH_HALF = 4156 ! 0x103C 143 | integer, parameter, public :: CL_DEVICE_OPENCL_C_VERSION = 4157 ! 0x103D 144 | 145 | !/* cl_device_type - bitfield */ 146 | integer, parameter, public :: CL_DEVICE_TYPE_DEFAULT = 1 ! (1 << 0) 147 | integer, parameter, public :: CL_DEVICE_TYPE_CPU = 2 ! (1 << 1) 148 | integer, parameter, public :: CL_DEVICE_TYPE_GPU = 4 ! (1 << 2) 149 | integer, parameter, public :: CL_DEVICE_TYPE_ACCELERATOR = 8 ! (1 << 3) 150 | integer, parameter, public :: CL_DEVICE_TYPE_ALL = -1 ! 0xFFFFFFFF 151 | 152 | !/* cl_platform_info */ 153 | integer, parameter, public :: CL_PLATFORM_PROFILE = 2304 ! 0x0900 154 | integer, parameter, public :: CL_PLATFORM_VERSION = 2305 ! 0x0901 155 | integer, parameter, public :: CL_PLATFORM_NAME = 2306 ! 0x0902 156 | integer, parameter, public :: CL_PLATFORM_VENDOR = 2307 ! 0x0903 157 | integer, parameter, public :: CL_PLATFORM_EXTENSIONS = 2308 ! 0x0904 158 | 159 | !/* cl_mem_flags - bitfield */ 160 | integer, parameter, public :: CL_MEM_READ_WRITE = 1 ! (1 << 0) 161 | integer, parameter, public :: CL_MEM_WRITE_ONLY = 2 ! (1 << 1) 162 | integer, parameter, public :: CL_MEM_READ_ONLY = 4 ! (1 << 2) 163 | integer, parameter, public :: CL_MEM_USE_HOST_PTR = 8 ! (1 << 3) 164 | integer, parameter, public :: CL_MEM_ALLOC_HOST_PTR = 16 ! (1 << 4) 165 | integer, parameter, public :: CL_MEM_COPY_HOST_PTR = 32 ! (1 << 5) 166 | 167 | !/* cl_command_queue_properties - bitfield */ 168 | integer, parameter, public :: CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE = 1 ! (1 << 0) 169 | integer, parameter, public :: CL_QUEUE_PROFILING_ENABLE = 2 ! (1 << 1) 170 | 171 | !/* cl_bool */ 172 | integer, parameter, public :: CL_FALSE = 0 173 | integer, parameter, public :: CL_TRUE = 1 174 | 175 | !/* cl_kernel_work_group_info */ 176 | integer, parameter, public :: CL_KERNEL_WORK_GROUP_SIZE = 4528 ! 0x11B0 177 | integer, parameter, public :: CL_KERNEL_COMPILE_WORK_GROUP_SIZE = 4529 ! 0x11B1 178 | integer, parameter, public :: CL_KERNEL_LOCAL_MEM_SIZE = 4530 ! 0x11B2 179 | integer, parameter, public :: CL_KERNEL_PREFERRED_WORK_GROUP_SIZE_MULTIPLE = 4531 ! 0x11B3 180 | integer, parameter, public :: CL_KERNEL_PRIVATE_MEM_SIZE = 4532 ! 0x11B4 181 | 182 | !/* cl_program_build_info */ 183 | integer, parameter, public :: CL_PROGRAM_BUILD_STATUS = 4481 ! 0x1181 184 | integer, parameter, public :: CL_PROGRAM_BUILD_OPTIONS = 4482 ! 0x1182 185 | integer, parameter, public :: CL_PROGRAM_BUILD_LOG = 4483 ! 0x1183 186 | 187 | contains 188 | 189 | integer pure function cl_bool(fortran_logical) 190 | logical, intent(in) :: fortran_logical 191 | 192 | if(fortran_logical .eqv. .true.) then 193 | cl_bool = CL_TRUE 194 | else 195 | cl_bool = CL_FALSE 196 | end if 197 | 198 | end function cl_bool 199 | 200 | end module cl_constants_m 201 | 202 | !! Local Variables: 203 | !! mode: f90 204 | !! coding: utf-8 205 | !! End: 206 | -------------------------------------------------------------------------------- /src/cl_context.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | 19 | 20 | module 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 | 63 | contains 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 115 | end module cl_context_m 116 | 117 | !! Local Variables: 118 | !! mode: f90 119 | !! coding: utf-8 120 | !! End: 121 | -------------------------------------------------------------------------------- /src/cl_context_low.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** Copyright (C) 2010-2012 X. Andrade 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | #include "localcl.h" 22 | 23 | /* -----------------------------------------------------------------------*/ 24 | 25 | void FC_FUNC_(clreleasecontext_low, CLRELEASECONTEXT_LOW)(cl_context * context, int * status){ 26 | *status = (int) clReleaseContext(*context); 27 | } 28 | 29 | /* -----------------------------------------------------------------------*/ 30 | 31 | void FC_FUNC_(clretaincontext_low, CLRETAINCONTEXT_LOW)(cl_context * context, int * status){ 32 | *status = (int) clRetainContext(*context); 33 | } 34 | 35 | /* -----------------------------------------------------------------------*/ 36 | 37 | void FC_FUNC_(clcreatecontext_low, CLCREATECONTEXT_LOW) 38 | (const cl_platform_id * platform, const int * num_devices, const cl_device_id * devices, int * errcode_ret, cl_context * context){ 39 | cl_int errcode_ret_cl; 40 | cl_context_properties context_properties[3]; 41 | 42 | context_properties[0] = CL_CONTEXT_PLATFORM; 43 | context_properties[1] = (cl_context_properties) *platform; 44 | context_properties[2] = 0; 45 | 46 | *context = clCreateContext(context_properties, (cl_uint) *num_devices, devices, NULL, NULL, &errcode_ret_cl); 47 | *errcode_ret = (int) errcode_ret_cl; 48 | 49 | } 50 | -------------------------------------------------------------------------------- /src/cl_device.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | 19 | 20 | module cl_device_m 21 | use cl_types_m 22 | 23 | implicit none 24 | 25 | private 26 | 27 | public :: & 28 | clGetDeviceInfo, & 29 | clGetDeviceIDs 30 | 31 | ! --------------------------------------------------- 32 | 33 | interface clGetDeviceIDs 34 | 35 | subroutine clgetdeviceids_num(platform, device_type, num_devices, errcode_ret) 36 | use cl_types_m 37 | 38 | implicit none 39 | type(cl_platform_id), intent(in) :: platform 40 | integer, intent(in) :: device_type 41 | integer, intent(out) :: num_devices 42 | integer, intent(out) :: errcode_ret 43 | end subroutine clgetdeviceids_num 44 | 45 | module procedure clgetdeviceids_list 46 | module procedure clgetdeviceids_single 47 | end interface clGetDeviceIDs 48 | 49 | ! --------------------------------------------------- 50 | 51 | interface clGetDeviceInfo 52 | 53 | subroutine clgetdeviceinfo_str(device, param_name, param_value, errcode_ret) 54 | use cl_types_m 55 | 56 | implicit none 57 | type(cl_device_id), intent(in) :: device 58 | integer, intent(in) :: param_name 59 | character(len=*), intent(out) :: param_value 60 | integer, intent(out) :: errcode_ret 61 | end subroutine clgetdeviceinfo_str 62 | 63 | subroutine clgetdeviceinfo_int(device, param_name, param_value, errcode_ret) 64 | use cl_types_m 65 | 66 | implicit none 67 | type(cl_device_id), intent(in) :: device 68 | integer, intent(in) :: param_name 69 | integer, intent(out) :: param_value 70 | integer, intent(out) :: errcode_ret 71 | end subroutine clgetdeviceinfo_int 72 | 73 | subroutine clgetdeviceinfo_int64(device, param_name, param_value, errcode_ret) 74 | use cl_types_m 75 | 76 | implicit none 77 | type(cl_device_id), intent(in) :: device 78 | integer, intent(in) :: param_name 79 | integer(8), intent(out) :: param_value 80 | integer, intent(out) :: errcode_ret 81 | end subroutine clgetdeviceinfo_int64 82 | 83 | module procedure clgetdeviceinfo_logical 84 | 85 | end interface clGetDeviceInfo 86 | 87 | ! ---------------------------------------------------- 88 | ! These functions are OpenCL 1.2, I will not include them for the moment. 89 | ! 90 | 91 | ! interface clReleaseDevice 92 | ! subroutine clReleaseDevice_low(device, errcode_ret) 93 | ! use cl_types_m 94 | ! 95 | ! implicit none 96 | ! type(cl_device_id), intent(inout) :: device 97 | ! integer, intent(out) :: errcode_ret 98 | ! end subroutine clReleaseDevice_low 99 | ! end interface clReleaseDevice 100 | 101 | ! ---------------------------------------------------- 102 | 103 | ! interface clRetainDevice 104 | ! subroutine clRetainDevice_low(device, errcode_ret) 105 | ! use cl_types_m 106 | ! 107 | ! implicit none 108 | ! type(cl_device_id), intent(inout) :: device 109 | ! integer, intent(out) :: errcode_ret 110 | ! end subroutine clRetainDevice_low 111 | ! end interface clRetainDevice 112 | 113 | ! --------------------------------------------------- 114 | ! some auxiliary functions 115 | ! 116 | interface 117 | subroutine clgetdeviceids_listall(platform, device_type, num_entries, devices, num_devices, errcode_ret) 118 | use cl_types_m 119 | 120 | implicit none 121 | 122 | type(cl_platform_id), intent(in) :: platform 123 | integer, intent(in) :: device_type 124 | integer, intent(out) :: num_entries 125 | type(cl_device_id), intent(out) :: devices 126 | integer, intent(out) :: num_devices 127 | integer, intent(out) :: errcode_ret 128 | end subroutine clgetdeviceids_listall 129 | 130 | end interface 131 | 132 | ! ---------------------------------------------------- 133 | 134 | contains 135 | 136 | subroutine clgetdeviceids_list(platform, device_type, devices, num_devices, errcode_ret) 137 | type(cl_platform_id), intent(in) :: platform 138 | integer, intent(in) :: device_type 139 | type(cl_device_id), intent(out) :: devices(:) 140 | integer, intent(out) :: num_devices 141 | integer, intent(out) :: errcode_ret 142 | 143 | integer :: idevice, num_entries 144 | type(cl_device_id), allocatable :: dev(:) 145 | 146 | ! since our cl_device_id type might be longer than the C 147 | ! cl_device_id type we need to get all the values in an array 148 | ! and the copy them explicitly to the return array 149 | 150 | num_entries = ubound(devices, dim = 1) 151 | 152 | allocate(dev(1:num_entries)) 153 | 154 | call clgetdeviceids_listall(platform, device_type, num_entries, dev(1), num_devices, errcode_ret) 155 | 156 | do idevice = 1, num_devices 157 | call fortrancl_get_component(dev(1), idevice - 1, devices(idevice)) 158 | end do 159 | 160 | deallocate(dev) 161 | 162 | end subroutine clgetdeviceids_list 163 | 164 | ! ---------------------------------------------------------- 165 | 166 | subroutine clgetdeviceids_single(platform, device_type, devices, num_devices, errcode_ret) 167 | type(cl_platform_id), intent(in) :: platform 168 | integer, intent(in) :: device_type 169 | type(cl_device_id), intent(out) :: devices 170 | integer, intent(out) :: num_devices 171 | integer, intent(out) :: errcode_ret 172 | 173 | integer :: num_entries 174 | 175 | num_entries = 1 176 | 177 | call clgetdeviceids_listall(platform, device_type, num_entries, devices, num_devices, errcode_ret) 178 | 179 | end subroutine clgetdeviceids_single 180 | 181 | 182 | ! --------------------------------------------------------- 183 | 184 | subroutine clgetdeviceinfo_logical(device, param_name, param_value, errcode_ret) 185 | type(cl_device_id), intent(in) :: device 186 | integer, intent(in) :: param_name 187 | logical, intent(out) :: param_value 188 | integer, intent(out) :: errcode_ret 189 | 190 | integer(8) :: param_value_64 191 | 192 | 193 | call clgetdeviceinfo_int64(device, param_name, param_value_64, errcode_ret) 194 | 195 | 196 | param_value = param_value_64 /= 0 197 | 198 | end subroutine clgetdeviceinfo_logical 199 | 200 | end module cl_device_m 201 | 202 | !! Local Variables: 203 | !! mode: f90 204 | !! coding: utf-8 205 | !! End: 206 | -------------------------------------------------------------------------------- /src/cl_device_low.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** Copyright (C) 2010-2012 X. Andrade 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | #include 22 | #include 23 | #include "localcl.h" 24 | 25 | #include 26 | 27 | /* -----------------------------------------------------------------------*/ 28 | 29 | void FC_FUNC_(clgetdeviceids_num, CLGETDEVICEIDS_NUM) 30 | (const cl_platform_id * platform, const int * device_type, int * num_devices, int * status){ 31 | cl_uint unum_devices; 32 | 33 | *status = (int) clGetDeviceIDs(*platform, *device_type, 0, NULL, &unum_devices); 34 | *num_devices = (int) unum_devices; 35 | } 36 | 37 | /* -----------------------------------------------------------------------*/ 38 | 39 | void FC_FUNC_(clgetdeviceids_listall, CLGETDEVICEIDS_LISTALL) 40 | (const cl_platform_id * platform, const int * device_type, const int * num_entries, cl_device_id * devices, 41 | int * num_devices, int * status){ 42 | 43 | cl_uint unum_devices; 44 | 45 | *status = (int) clGetDeviceIDs(*platform, *device_type, (cl_uint) *num_entries, devices, &unum_devices); 46 | *num_devices = (int) unum_devices; 47 | } 48 | 49 | /* -----------------------------------------------------------------------*/ 50 | 51 | void FC_FUNC_(clgetdeviceinfo_str, CLGETDEVICEINFO_STR) 52 | (const cl_device_id * device, const int * param_name, STR_F_TYPE param_value, int * status STR_ARG1){ 53 | char info[2048]; 54 | 55 | *status = (int) clGetDeviceInfo(*device, (cl_device_info) *param_name, sizeof(info), info, NULL); 56 | 57 | TO_F_STR1(info, param_value); 58 | } 59 | 60 | /* -----------------------------------------------------------------------*/ 61 | 62 | void FC_FUNC_(clgetdeviceinfo_int64, CLGETDEVICEINFO_INT64) 63 | (const cl_device_id * device, const int * param_name, cl_long * param_value, int * status){ 64 | union { 65 | cl_uint val_uint; 66 | cl_bool val_bool; 67 | cl_ulong val_ulong; 68 | size_t val_size_t; 69 | cl_device_type val_cl_device_type; 70 | } rval; 71 | 72 | *status = (int) clGetDeviceInfo(*device, (cl_device_info) *param_name, sizeof(rval), &rval, NULL); 73 | 74 | if(*status != CL_SUCCESS) return; 75 | 76 | switch(*param_name){ 77 | /* return cl_uint*/ 78 | case CL_DEVICE_ADDRESS_BITS: 79 | case CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE: 80 | case CL_DEVICE_MAX_CLOCK_FREQUENCY: 81 | case CL_DEVICE_MAX_COMPUTE_UNITS: 82 | case CL_DEVICE_MAX_CONSTANT_ARGS: 83 | case CL_DEVICE_MAX_READ_IMAGE_ARGS: 84 | case CL_DEVICE_MAX_SAMPLERS: 85 | case CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS: 86 | case CL_DEVICE_MAX_WRITE_IMAGE_ARGS: 87 | case CL_DEVICE_MEM_BASE_ADDR_ALIGN: 88 | case CL_DEVICE_MIN_DATA_TYPE_ALIGN_SIZE: 89 | #ifdef CL_VERSION_1_1 90 | case CL_DEVICE_NATIVE_VECTOR_WIDTH_CHAR: 91 | case CL_DEVICE_NATIVE_VECTOR_WIDTH_SHORT: 92 | case CL_DEVICE_NATIVE_VECTOR_WIDTH_INT: 93 | case CL_DEVICE_NATIVE_VECTOR_WIDTH_LONG: 94 | case CL_DEVICE_NATIVE_VECTOR_WIDTH_FLOAT: 95 | case CL_DEVICE_NATIVE_VECTOR_WIDTH_DOUBLE: 96 | case CL_DEVICE_NATIVE_VECTOR_WIDTH_HALF: 97 | case CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR: 98 | case CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT: 99 | case CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT: 100 | case CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG: 101 | case CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT: 102 | case CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE: 103 | case CL_DEVICE_PREFERRED_VECTOR_WIDTH_HALF: 104 | #endif 105 | case CL_DEVICE_VENDOR_ID: 106 | *param_value = rval.val_uint; 107 | break; 108 | 109 | /* return cl_ulong */ 110 | case CL_DEVICE_GLOBAL_MEM_CACHE_SIZE: 111 | case CL_DEVICE_GLOBAL_MEM_SIZE: 112 | case CL_DEVICE_LOCAL_MEM_SIZE: 113 | case CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE: 114 | case CL_DEVICE_MAX_MEM_ALLOC_SIZE: 115 | *param_value = rval.val_ulong; 116 | break; 117 | 118 | /* return size_t */ 119 | case CL_DEVICE_IMAGE2D_MAX_HEIGHT: 120 | case CL_DEVICE_IMAGE2D_MAX_WIDTH: 121 | case CL_DEVICE_IMAGE3D_MAX_DEPTH: 122 | case CL_DEVICE_IMAGE3D_MAX_HEIGHT: 123 | case CL_DEVICE_IMAGE3D_MAX_WIDTH: 124 | case CL_DEVICE_MAX_PARAMETER_SIZE: 125 | case CL_DEVICE_MAX_WORK_GROUP_SIZE: 126 | case CL_DEVICE_PROFILING_TIMER_RESOLUTION: 127 | *param_value = rval.val_size_t; 128 | break; 129 | 130 | /* return cl_bool */ 131 | case CL_DEVICE_AVAILABLE: 132 | case CL_DEVICE_COMPILER_AVAILABLE: 133 | case CL_DEVICE_ENDIAN_LITTLE: 134 | case CL_DEVICE_ERROR_CORRECTION_SUPPORT: 135 | #ifdef CL_VERSION_1_1 136 | case CL_DEVICE_HOST_UNIFIED_MEMORY: 137 | #endif 138 | case CL_DEVICE_IMAGE_SUPPORT: 139 | *param_value = rval.val_bool; 140 | break; 141 | 142 | /* return cl_device_type */ 143 | case CL_DEVICE_TYPE: 144 | *param_value = rval.val_cl_device_type; 145 | break; 146 | 147 | /* other */ 148 | default: 149 | fprintf(stderr, "\nFortranCL error: clGetDeviceInfo not implemented param_name (%x).\n", *param_name); 150 | exit(1); 151 | break; 152 | } 153 | 154 | } 155 | 156 | /* -----------------------------------------------------------------------*/ 157 | 158 | void FC_FUNC_(clgetdeviceinfo_int, CLGETDEVICEINFO_INT) 159 | (const cl_device_id * device, const int * param_name, cl_int * param_value, int * status){ 160 | cl_long param_value64; 161 | 162 | FC_FUNC_(clgetdeviceinfo_int64, CLGETDEVICEINFO_INT64)(device, param_name, ¶m_value64, status); 163 | 164 | *param_value = (cl_int) param_value64; 165 | } 166 | 167 | #ifdef CL_VERSION_1_2 168 | 169 | /* -----------------------------------------------------------------------*/ 170 | 171 | void FC_FUNC_(clreleasedevice_low, CLRELEASEDEVICE_LOW) 172 | (const cl_device_id * device, int * errcode_ret){ 173 | 174 | *errcode_ret = clReleaseDevice(*device); 175 | } 176 | 177 | /* -----------------------------------------------------------------------*/ 178 | 179 | void FC_FUNC_(clretaindevice_low, CLRETAINDEVICE_LOW) 180 | (const cl_device_id * device, int * errcode_ret){ 181 | 182 | *errcode_ret = clRetainDevice(*device); 183 | } 184 | 185 | /* -----------------------------------------------------------------------*/ 186 | 187 | #endif 188 | -------------------------------------------------------------------------------- /src/cl_event.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2012 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | module cl_event_m 19 | use cl_types_m 20 | 21 | implicit none 22 | 23 | private 24 | 25 | public :: & 26 | clReleaseEvent, & 27 | clRetainEvent, & 28 | clWaitForEvents 29 | 30 | interface clReleaseEvent 31 | 32 | subroutine clReleaseEvent_low(event, errcode_ret) 33 | use cl_types_m 34 | 35 | implicit none 36 | 37 | type(cl_event), intent(inout) :: event 38 | integer, intent(out) :: errcode_ret 39 | end subroutine clReleaseEvent_low 40 | 41 | end interface clReleaseEvent 42 | 43 | ! ----------------------------------------------- 44 | 45 | interface clRetainEvent 46 | 47 | subroutine clRetainEvent_low(event, errcode_ret) 48 | use cl_types_m 49 | 50 | implicit none 51 | 52 | type(cl_event), intent(inout) :: event 53 | integer, intent(out) :: errcode_ret 54 | end subroutine clRetainEvent_low 55 | 56 | end interface clRetainEvent 57 | 58 | ! ----------------------------------------------- 59 | 60 | interface clWaitForEvents 61 | module procedure clWaitForEvents_single 62 | module procedure clWaitForEvents_array 63 | end interface clWaitForEvents 64 | 65 | interface 66 | subroutine clWaitForEvents_low(numevents, allevents, errcode_ret) 67 | use cl_types_m 68 | 69 | implicit none 70 | 71 | integer, intent(in) :: numevents 72 | type(cl_event), intent(in) :: allevents 73 | integer, intent(out) :: errcode_ret 74 | end subroutine clWaitForEvents_low 75 | end interface 76 | 77 | contains 78 | 79 | subroutine clWaitForEvents_single(event_list, errcode_ret) 80 | type(cl_event), intent(in) :: event_list 81 | integer, intent(out) :: errcode_ret 82 | 83 | call clWaitForEvents_low(1, event_list, errcode_ret) 84 | 85 | end subroutine clWaitForEvents_single 86 | 87 | ! -------------------------------------------------------------- 88 | 89 | subroutine clWaitForEvents_array(event_list, errcode_ret) 90 | type(cl_event), intent(in) :: event_list(:) 91 | integer, intent(out) :: errcode_ret 92 | 93 | type(cl_event), allocatable :: allevents(:) 94 | integer :: numevents, ievent 95 | 96 | numevents = ubound(event_list, dim = 1) 97 | 98 | allocate(allevents(1:numevents)) 99 | 100 | do ievent = 1, numevents 101 | call fortrancl_set_component(allevents(1), ievent - 1, event_list(ievent)) 102 | end do 103 | 104 | call clWaitForEvents_low(numevents, allevents(1), errcode_ret) 105 | 106 | deallocate(allevents) 107 | 108 | end subroutine clWaitForEvents_array 109 | 110 | end module cl_event_m 111 | 112 | !! Local Variables: 113 | !! mode: f90 114 | !! coding: utf-8 115 | !! End: 116 | -------------------------------------------------------------------------------- /src/cl_event_low.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** Copyright (C) 2012 X. Andrade 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | #include "localcl.h" 22 | 23 | /* -----------------------------------------------------------------------*/ 24 | 25 | void FC_FUNC_(clreleaseevent_low, CLRELEASEEVENT_LOW)(cl_event * event, int * status){ 26 | 27 | *status = (int)clReleaseEvent(*event); 28 | } 29 | 30 | /* -----------------------------------------------------------------------*/ 31 | 32 | void FC_FUNC_(clretainevent_low, CLRETAINEVENT_LOW)(cl_event * event, int * status){ 33 | 34 | *status = (int)clRetainEvent(*event); 35 | } 36 | 37 | /* -----------------------------------------------------------------------*/ 38 | 39 | void FC_FUNC_(clwaitforevents_low, CLWAITFOREVENTS_ARRAY_LOW) 40 | (const int * numevents, const cl_event * event, int * status){ 41 | 42 | *status = (int)clWaitForEvents(*numevents, event); 43 | } 44 | 45 | /* -----------------------------------------------------------------------*/ 46 | -------------------------------------------------------------------------------- /src/cl_kernel.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | 19 | 20 | module cl_kernel_m 21 | use cl_types_m 22 | 23 | implicit none 24 | 25 | private 26 | 27 | public :: & 28 | clCreateKernel, & 29 | clReleaseKernel, & 30 | clRetainKernel, & 31 | clGetKernelWorkGroupInfo, & 32 | clSetKernelArgLocal, & 33 | clSetKernelArg 34 | 35 | interface clReleaseKernel 36 | 37 | subroutine clReleaseKernel_low(kernel, errcode_ret) 38 | use cl_types_m 39 | 40 | implicit none 41 | 42 | type(cl_kernel), intent(inout) :: kernel 43 | integer, intent(out) :: errcode_ret 44 | end subroutine clReleaseKernel_low 45 | 46 | end interface 47 | 48 | ! -------------------------------------------------- 49 | 50 | interface clRetainKernel 51 | 52 | subroutine clRetainKernel_low(kernel, errcode_ret) 53 | use cl_types_m 54 | 55 | implicit none 56 | 57 | type(cl_kernel), intent(inout) :: kernel 58 | integer, intent(out) :: errcode_ret 59 | end subroutine clRetainKernel_low 60 | 61 | end interface 62 | 63 | ! -------------------------------------------------- 64 | 65 | interface clSetKernelArg 66 | 67 | subroutine clsetkernelarg_buf(kernel, arg_index, arg_value, errcode_ret) 68 | use cl_types_m 69 | 70 | implicit none 71 | 72 | type(cl_kernel), intent(inout) :: kernel 73 | integer, intent(in) :: arg_index 74 | type(cl_mem), intent(in) :: arg_value 75 | integer, intent(out) :: errcode_ret 76 | end subroutine clsetkernelarg_buf 77 | 78 | ! ---------------------------------------------------- 79 | 80 | subroutine clsetkernelarg_char(kernel, arg_index, arg_value, errcode_ret) 81 | use cl_types_m 82 | 83 | implicit none 84 | 85 | type(cl_kernel), intent(inout) :: kernel 86 | integer, intent(in) :: arg_index 87 | character, intent(in) :: arg_value 88 | integer, intent(out) :: errcode_ret 89 | end subroutine clsetkernelarg_char 90 | 91 | ! ---------------------------------------------------- 92 | 93 | subroutine clsetkernelarg_int(kernel, arg_index, arg_value, errcode_ret) 94 | use cl_types_m 95 | 96 | implicit none 97 | 98 | type(cl_kernel), intent(inout) :: kernel 99 | integer, intent(in) :: arg_index 100 | integer(4), intent(in) :: arg_value 101 | integer, intent(out) :: errcode_ret 102 | end subroutine clsetkernelarg_int 103 | 104 | ! ---------------------------------------------------- 105 | 106 | subroutine clsetkernelarg_long(kernel, arg_index, arg_value, errcode_ret) 107 | use cl_types_m 108 | 109 | implicit none 110 | 111 | type(cl_kernel), intent(inout) :: kernel 112 | integer, intent(in) :: arg_index 113 | integer(8), intent(in) :: arg_value 114 | integer, intent(out) :: errcode_ret 115 | end subroutine clsetkernelarg_long 116 | 117 | ! ---------------------------------------------------- 118 | 119 | subroutine clsetkernelarg_float(kernel, arg_index, arg_value, errcode_ret) 120 | use cl_types_m 121 | 122 | implicit none 123 | 124 | type(cl_kernel), intent(inout) :: kernel 125 | integer, intent(in) :: arg_index 126 | real(4), intent(in) :: arg_value 127 | integer, intent(out) :: errcode_ret 128 | end subroutine clsetkernelarg_float 129 | 130 | ! ---------------------------------------------------- 131 | 132 | subroutine clsetkernelarg_double(kernel, arg_index, arg_value, errcode_ret) 133 | use cl_types_m 134 | 135 | implicit none 136 | 137 | type(cl_kernel), intent(inout) :: kernel 138 | integer, intent(in) :: arg_index 139 | real(8), intent(in) :: arg_value 140 | integer, intent(out) :: errcode_ret 141 | end subroutine clsetkernelarg_double 142 | 143 | ! --------------------------------------------------- 144 | 145 | subroutine clsetkernelarg_float2(kernel, arg_index, arg_value, errcode_ret) 146 | use cl_types_m 147 | 148 | implicit none 149 | 150 | type(cl_kernel), intent(inout) :: kernel 151 | integer, intent(in) :: arg_index 152 | complex(4), intent(in) :: arg_value 153 | integer, intent(out) :: errcode_ret 154 | end subroutine clsetkernelarg_float2 155 | 156 | ! ---------------------------------------------------- 157 | 158 | subroutine clsetkernelarg_double2(kernel, arg_index, arg_value, errcode_ret) 159 | use cl_types_m 160 | 161 | implicit none 162 | 163 | type(cl_kernel), intent(inout) :: kernel 164 | integer, intent(in) :: arg_index 165 | complex(8), intent(in) :: arg_value 166 | integer, intent(out) :: errcode_ret 167 | end subroutine clsetkernelarg_double2 168 | 169 | end interface clSetKernelArg 170 | 171 | ! ---------------------------------------------------- 172 | 173 | interface clSetKernelArgLocal 174 | 175 | subroutine clSetKernelArgLocal_low(kernel, arg_index, arg_size, errcode_ret) 176 | use cl_types_m 177 | 178 | implicit none 179 | 180 | type(cl_kernel), intent(inout) :: kernel 181 | integer, intent(in) :: arg_index 182 | integer(8), intent(in) :: arg_size 183 | integer, intent(out) :: errcode_ret 184 | end subroutine clSetKernelArgLocal_low 185 | 186 | end interface 187 | 188 | ! ---------------------------------------------------- 189 | 190 | interface clGetKernelWorkGroupInfo 191 | 192 | subroutine clgetkernelworkgroupinfo_int64(kernel, device, param_name, param_value, errcode_ret) 193 | use cl_types_m 194 | 195 | implicit none 196 | 197 | type(cl_kernel), intent(in) :: kernel 198 | type(cl_device_id), intent(in) :: device 199 | integer, intent(in) :: param_name 200 | integer(8), intent(out) :: param_value 201 | integer, intent(out) :: errcode_ret 202 | end subroutine clgetkernelworkgroupinfo_int64 203 | 204 | end interface clGetKernelWorkGroupInfo 205 | 206 | ! ---------------------------------------------------- 207 | 208 | interface clCreateKernel 209 | module procedure clCreateKernel_full 210 | end interface clCreateKernel 211 | 212 | contains 213 | 214 | type(cl_kernel) function clCreateKernel_full(program, kernel_name, errcode_ret) result(kernel) 215 | type(cl_program), intent(inout) :: program 216 | character(len=*), intent(in) :: kernel_name 217 | integer, intent(out) :: errcode_ret 218 | 219 | interface 220 | subroutine clcreatekernel_low(program, kernel_name, errcode_ret, kernel) 221 | use cl_types_m 222 | 223 | implicit none 224 | 225 | type(cl_program), intent(inout) :: program 226 | character(len=*), intent(in) :: kernel_name 227 | integer, intent(out) :: errcode_ret 228 | type(cl_kernel), intent(out) :: kernel 229 | end subroutine clcreatekernel_low 230 | end interface 231 | 232 | 233 | call clcreatekernel_low(program, kernel_name, errcode_ret, kernel) 234 | 235 | 236 | end function clCreateKernel_full 237 | 238 | end module cl_kernel_m 239 | 240 | !! Local Variables: 241 | !! mode: f90 242 | !! coding: utf-8 243 | !! End: 244 | -------------------------------------------------------------------------------- /src/cl_kernel_low.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** Copyright (C) 2010-2012 X. Andrade 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | #include 22 | #include 23 | #include "localcl.h" 24 | 25 | #include 26 | 27 | /* -----------------------------------------------------------------------*/ 28 | 29 | void FC_FUNC_(clcreatekernel_low, CLCREATEKERNEL_LOW) 30 | (cl_program * program, STR_F_TYPE kernel_name_f, int * errcode_ret, cl_kernel * kernel STR_ARG1){ 31 | char * kernel_name; 32 | cl_int errcode_ret_cl; 33 | 34 | TO_C_STR1(kernel_name_f, kernel_name); 35 | 36 | *kernel = clCreateKernel(*program, kernel_name, &errcode_ret_cl); 37 | *errcode_ret = (int) errcode_ret_cl; 38 | 39 | free(kernel_name); 40 | } 41 | 42 | 43 | /* -----------------------------------------------------------------------*/ 44 | 45 | void FC_FUNC_(clreleasekernel_low, CLRELEASEKERNEL_LOW)(cl_kernel * kernel, int * status){ 46 | *status = (int) clReleaseKernel(*kernel); 47 | } 48 | 49 | 50 | /* -----------------------------------------------------------------------*/ 51 | 52 | void FC_FUNC_(clretainkernel_low, CLRETAINKERNEL_LOW)(cl_kernel * kernel, int * status){ 53 | *status = (int) clRetainKernel(*kernel); 54 | } 55 | 56 | /* -----------------------------------------------------------------------*/ 57 | 58 | void FC_FUNC_(clsetkernelarg_buf, CLSETKERNELARG_BUF) 59 | (cl_kernel * kernel, const int * arg_index, cl_mem * arg_value, int * status){ 60 | 61 | *status = (int) clSetKernelArg(*kernel, (cl_uint) *arg_index, (size_t) sizeof(cl_mem), arg_value); 62 | } 63 | 64 | /* -----------------------------------------------------------------------*/ 65 | 66 | void FC_FUNC_(clsetkernelarg_char, CLSETKERNELARG_CHAR) 67 | (cl_kernel * kernel, const int * arg_index, const cl_char * arg_value, int * status){ 68 | 69 | *status = (int) clSetKernelArg(*kernel, (cl_uint) *arg_index, (size_t) sizeof(cl_char), arg_value); 70 | } 71 | 72 | 73 | /* -----------------------------------------------------------------------*/ 74 | 75 | void FC_FUNC_(clsetkernelarg_int, CLSETKERNELARG_INT) 76 | (cl_kernel * kernel, const int * arg_index, const cl_int * arg_value, int * status){ 77 | 78 | *status = (int) clSetKernelArg(*kernel, (cl_uint) *arg_index, (size_t) sizeof(cl_int), arg_value); 79 | } 80 | 81 | /* -----------------------------------------------------------------------*/ 82 | 83 | void FC_FUNC_(clsetkernelarg_long, CLSETKERNELARG_LONG) 84 | (cl_kernel * kernel, const int * arg_index, const cl_long * arg_value, int * status){ 85 | 86 | *status = (int) clSetKernelArg(*kernel, (cl_uint) *arg_index, (size_t) sizeof(cl_long), arg_value); 87 | } 88 | 89 | /* -----------------------------------------------------------------------*/ 90 | 91 | void FC_FUNC_(clsetkernelarg_float, CLSETKERNELARG_FLOAT) 92 | (cl_kernel * kernel, const int * arg_index, const float * arg_value, int * status){ 93 | 94 | *status = (int) clSetKernelArg(*kernel, (cl_uint) *arg_index, (size_t) sizeof(float), arg_value); 95 | } 96 | 97 | /* -----------------------------------------------------------------------*/ 98 | 99 | void FC_FUNC_(clsetkernelarg_double, CLSETKERNELARG_DOUBLE) 100 | (cl_kernel * kernel, const int * arg_index, const double * arg_value, int * status){ 101 | 102 | *status = (int) clSetKernelArg(*kernel, (cl_uint) *arg_index, (size_t) sizeof(double), arg_value); 103 | } 104 | 105 | /* -----------------------------------------------------------------------*/ 106 | 107 | void FC_FUNC_(clsetkernelarg_float2, CLSETKERNELARG_FLOAT2) 108 | (cl_kernel * kernel, const int * arg_index, const cl_float2 * arg_value, int * status){ 109 | 110 | *status = (int) clSetKernelArg(*kernel, (cl_uint) *arg_index, (size_t) sizeof(cl_float2), arg_value); 111 | } 112 | 113 | /* -----------------------------------------------------------------------*/ 114 | 115 | void FC_FUNC_(clsetkernelarg_double2, CLSETKERNELARG_DOUBLE2) 116 | (cl_kernel * kernel, const int * arg_index, const cl_double2 * arg_value, int * status){ 117 | 118 | *status = (int) clSetKernelArg(*kernel, (cl_uint) *arg_index, (size_t) sizeof(cl_double2), arg_value); 119 | } 120 | 121 | /* -----------------------------------------------------------------------*/ 122 | 123 | void FC_FUNC_(clsetkernelarglocal_low, CLSETKERNELARGLOCAL_LOW) 124 | (cl_kernel * kernel, const int * arg_index, const cl_long * arg_size, int * status){ 125 | 126 | *status = (int) clSetKernelArg(*kernel, *arg_index, (size_t) *arg_size, NULL); 127 | } 128 | 129 | /* -----------------------------------------------------------------------*/ 130 | 131 | void FC_FUNC_(clgetkernelworkgroupinfo_int64, CLGETKERNELWORKGROUPINFO_INT64) 132 | (cl_kernel * kernel, cl_device_id * device, int * param_name, cl_long * param_value, int * retcode_err){ 133 | 134 | union { 135 | size_t val_size_t; 136 | cl_ulong val_ulong; 137 | } rval; 138 | 139 | *retcode_err = (int) clGetKernelWorkGroupInfo(*kernel, *device, (cl_kernel_work_group_info) *param_name, 140 | sizeof(rval), &rval, NULL); 141 | if(*retcode_err != CL_SUCCESS) return; 142 | 143 | switch(*param_name){ 144 | case CL_KERNEL_WORK_GROUP_SIZE: 145 | #ifdef CL_VERSION_1_1 146 | case CL_KERNEL_PREFERRED_WORK_GROUP_SIZE_MULTIPLE: 147 | #endif 148 | *param_value = rval.val_size_t; 149 | break; 150 | case CL_KERNEL_LOCAL_MEM_SIZE: 151 | #ifdef CL_VERSION_1_1 152 | case CL_KERNEL_PRIVATE_MEM_SIZE: 153 | #endif 154 | *param_value = rval.val_ulong; 155 | break; 156 | default: 157 | fprintf(stderr, "\nFortranCL error: clGetKernelWorkGroupInfo not implemented param_name.\n"); 158 | exit(1); 159 | break; 160 | } 161 | 162 | } 163 | 164 | /* -----------------------------------------------------------------------*/ 165 | 166 | -------------------------------------------------------------------------------- /src/cl_platform.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | 19 | 20 | module cl_platform_m 21 | use cl_types_m 22 | 23 | implicit none 24 | 25 | private 26 | 27 | public :: & 28 | clGetPlatformIDs, & 29 | clGetPlatformInfo 30 | 31 | interface clGetPlatformIDs 32 | 33 | subroutine clgetplatformids_num(num_platforms, errcode_ret) 34 | use cl_types_m 35 | 36 | implicit none 37 | integer, intent(out) :: num_platforms 38 | integer, intent(out) :: errcode_ret 39 | end subroutine clgetplatformids_num 40 | 41 | module procedure clgetplatformids_list 42 | module procedure clgetplatformids_single 43 | end interface clGetPlatformIDs 44 | 45 | ! --------------------------------------------------- 46 | 47 | interface clGetPlatformInfo 48 | 49 | subroutine clGetPlatformInfo_str(platform, param_name, param_value, errcode_ret) 50 | use cl_types_m 51 | 52 | implicit none 53 | type(cl_platform_id), intent(in) :: platform 54 | integer, intent(in) :: param_name 55 | character(len=*), intent(out) :: param_value 56 | integer, intent(out) :: errcode_ret 57 | end subroutine clGetPlatformInfo_str 58 | 59 | end interface clGetPlatformInfo 60 | 61 | ! --------------------------------------------------- 62 | 63 | contains 64 | 65 | subroutine clgetplatformids_list(platforms, num_platforms, errcode_ret) 66 | type(cl_platform_id), intent(out) :: platforms(:) 67 | integer, intent(out) :: num_platforms 68 | integer, intent(out) :: errcode_ret 69 | 70 | 71 | integer :: iplatform, num_entries 72 | type(cl_platform_id), allocatable :: plat_c(:) 73 | 74 | interface 75 | subroutine clgetplatformids_listall(num_entries, platforms, num_platforms, errcode_ret) 76 | use cl_types_m 77 | 78 | implicit none 79 | 80 | integer, intent(in) :: num_entries 81 | type(cl_platform_id), intent(out) :: platforms 82 | integer, intent(out) :: num_platforms 83 | integer, intent(out) :: errcode_ret 84 | end subroutine clgetplatformids_listall 85 | end interface 86 | 87 | ! since our cl_platform_id type might be longer than the C 88 | ! cl_platform_id type we need to get all the values in an array 89 | ! and the copy them explicitly to the return array 90 | 91 | num_entries = ubound(platforms, dim = 1) 92 | 93 | allocate(plat_c(1:num_entries)) 94 | 95 | call clgetplatformids_listall(num_entries, plat_c(1), num_platforms, errcode_ret) 96 | 97 | do iplatform = 1, num_entries 98 | call fortrancl_get_component(plat_c(1), iplatform - 1, platforms(iplatform)) 99 | end do 100 | 101 | deallocate(plat_c) 102 | 103 | end subroutine clgetplatformids_list 104 | 105 | subroutine clgetplatformids_single(platforms, num_platforms, errcode_ret) 106 | type(cl_platform_id), intent(out) :: platforms 107 | integer, intent(out) :: num_platforms 108 | integer, intent(out) :: errcode_ret 109 | 110 | type(cl_platform_id) :: plats(1:1) 111 | 112 | call clgetplatformids_list(plats, num_platforms, errcode_ret) 113 | platforms = plats(1) 114 | end subroutine clgetplatformids_single 115 | 116 | end module cl_platform_m 117 | 118 | !! Local Variables: 119 | !! mode: f90 120 | !! coding: utf-8 121 | !! End: 122 | -------------------------------------------------------------------------------- /src/cl_platform_low.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** Copyright (C) 2010-2012 X. Andrade 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | #include "localcl.h" 22 | 23 | #include 24 | 25 | 26 | void FC_FUNC_(clgetplatformids_num, CLGETPLATFORMIDS_NUM)(int * num_platforms, int * status){ 27 | cl_uint ret_platform; 28 | 29 | *status = (int) clGetPlatformIDs(0, NULL, &ret_platform); 30 | *num_platforms = (int) ret_platform; 31 | } 32 | 33 | 34 | /* -----------------------------------------------------------------------*/ 35 | 36 | void FC_FUNC_(clgetplatformids_listall, CLGETPLATFORMIDS_LISTALL) 37 | (const int * num_entries, cl_platform_id * platforms, int * num_platforms, int * status){ 38 | 39 | cl_uint unum_platforms; 40 | 41 | *status = (int) clGetPlatformIDs((cl_uint) *num_entries, platforms, &unum_platforms); 42 | *num_platforms = (int) unum_platforms; 43 | } 44 | 45 | /* -----------------------------------------------------------------------*/ 46 | 47 | void FC_FUNC_(clgetplatforminfo_str, CLGETPLATFORMINFO_STR) 48 | (const cl_platform_id * platform, const int * param_name, STR_F_TYPE param_value, int * status STR_ARG1){ 49 | char info[2048]; 50 | 51 | *status = (int) clGetPlatformInfo(*platform, (cl_platform_info) *param_name, sizeof(info), info, NULL); 52 | 53 | TO_F_STR1(info, param_value); 54 | } 55 | 56 | 57 | 58 | 59 | -------------------------------------------------------------------------------- /src/cl_program.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | 19 | 20 | module cl_program_m 21 | use cl_types_m 22 | 23 | implicit none 24 | 25 | private 26 | 27 | public :: & 28 | clCreateProgramWithSource, & 29 | clBuildProgram, & 30 | clReleaseProgram, & 31 | clRetainProgram, & 32 | clGetProgramBuildInfo 33 | 34 | interface clReleaseProgram 35 | 36 | subroutine clReleaseProgram_low(program, errcode_ret) 37 | use cl_types_m 38 | 39 | implicit none 40 | 41 | type(cl_program), intent(inout) :: program 42 | integer, intent(out) :: errcode_ret 43 | end subroutine clReleaseProgram_low 44 | 45 | end interface clReleaseProgram 46 | 47 | ! ---------------------------------------------------- 48 | 49 | interface clRetainProgram 50 | 51 | subroutine clRetainProgram_low(program, errcode_ret) 52 | use cl_types_m 53 | 54 | implicit none 55 | 56 | type(cl_program), intent(inout) :: program 57 | integer, intent(out) :: errcode_ret 58 | end subroutine clRetainProgram_low 59 | 60 | end interface clRetainProgram 61 | 62 | ! ---------------------------------------------------- 63 | 64 | interface clBuildProgram 65 | 66 | subroutine clBuildProgram_nodevices(program, options, errcode_ret) 67 | use cl_types_m 68 | 69 | implicit none 70 | 71 | type(cl_program), intent(inout) :: program 72 | character(len=*), intent(in) :: options 73 | integer, intent(in) :: errcode_ret 74 | end subroutine clBuildProgram_nodevices 75 | 76 | end interface clBuildProgram 77 | 78 | ! ---------------------------------------------------- 79 | 80 | interface clGetProgramBuildInfo 81 | 82 | subroutine clGetProgramBuildInfo_str(program, device, param_name, param_value, errcode_ret) 83 | use cl_types_m 84 | 85 | implicit none 86 | 87 | type(cl_program), intent(in) :: program 88 | type(cl_device_id), intent(in) :: device 89 | integer, intent(in) :: param_name 90 | character(len=*), intent(out) :: param_value 91 | integer, intent(out) :: errcode_ret 92 | end subroutine clGetProgramBuildInfo_str 93 | 94 | end interface clGetProgramBuildInfo 95 | 96 | ! ---------------------------------------------------- 97 | 98 | interface clCreateProgramWithSource 99 | module procedure clCreateProgramWithSource_str 100 | end interface clCreateProgramWithSource 101 | 102 | ! ---------------------------------------------------- 103 | 104 | contains 105 | 106 | type(cl_program) function clCreateProgramWithSource_str(context, string, errcode_ret) result(program) 107 | type(cl_context), intent(inout) :: context 108 | character(len=*), intent(in) :: string 109 | integer, intent(out) :: errcode_ret 110 | 111 | interface 112 | subroutine clCreateProgramWithSource_low(context, string, errcode_ret, program) 113 | use cl_types_m 114 | 115 | implicit none 116 | 117 | type(cl_context), intent(inout) :: context 118 | character(len=*), intent(in) :: string 119 | integer, intent(out) :: errcode_ret 120 | type(cl_program), intent(out) :: program 121 | end subroutine clCreateProgramWithSource_low 122 | end interface 123 | 124 | 125 | call clCreateProgramWithSource_low(context, string, errcode_ret, program) 126 | 127 | end function clCreateProgramWithSource_str 128 | 129 | end module cl_program_m 130 | 131 | !! Local Variables: 132 | !! mode: f90 133 | !! coding: utf-8 134 | !! End: 135 | -------------------------------------------------------------------------------- /src/cl_program_low.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** Copyright (C) 2010-2012 X. Andrade 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | #include 22 | #include "localcl.h" 23 | 24 | #include 25 | 26 | /* -----------------------------------------------------------------------*/ 27 | 28 | void FC_FUNC_(clcreateprogramwithsource_low, CLCREATEPROGRAMWITHSOURCE_LOW) 29 | (cl_context * context, STR_F_TYPE string, int * retcode_err, cl_program * program STR_ARG1){ 30 | char * string_c; 31 | cl_int retcode_err_cl; 32 | 33 | TO_C_STR1(string, string_c); 34 | 35 | *program = clCreateProgramWithSource(*context, 1, (const char**) &string_c, NULL, &retcode_err_cl); 36 | *retcode_err = (int) retcode_err_cl; 37 | 38 | free(string_c); 39 | } 40 | 41 | /* -----------------------------------------------------------------------*/ 42 | 43 | void FC_FUNC_(clbuildprogram_nodevices,CLBUILDPROGRAM_NODEVICES) 44 | (cl_program * program, STR_F_TYPE options, int * retcode_err STR_ARG1){ 45 | char * options_c; 46 | 47 | TO_C_STR1(options, options_c); 48 | 49 | *retcode_err = (int) clBuildProgram(*program, 0, NULL, options_c, NULL, NULL); 50 | 51 | free(options_c); 52 | } 53 | 54 | /* -----------------------------------------------------------------------*/ 55 | 56 | void FC_FUNC_(clgetprogrambuildinfo_str,CLGETPROGRAMBUILDINFO_STR) 57 | (cl_program * program, cl_device_id * device, const int * param_name, 58 | STR_F_TYPE param_value, int * retcode_err STR_ARG1){ 59 | char param_value_c[2000]; 60 | 61 | *retcode_err = (int) clGetProgramBuildInfo(*program, *device, (cl_program_build_info) *param_name, 62 | sizeof(param_value_c), param_value_c, NULL); 63 | 64 | TO_F_STR1(param_value_c, param_value); 65 | } 66 | 67 | /* -----------------------------------------------------------------------*/ 68 | 69 | void FC_FUNC_(clreleaseprogram_low, CLRELEASEPROGRAM_LOW) 70 | (cl_program * program, int * status){ 71 | 72 | *status = (int) clReleaseProgram(*program); 73 | } 74 | 75 | /* -----------------------------------------------------------------------*/ 76 | 77 | void FC_FUNC_(clretainprogram_low, CLRETAINPROGRAM_LOW) 78 | (cl_program * program, int * status){ 79 | 80 | *status = (int) clRetainProgram(*program); 81 | } 82 | 83 | -------------------------------------------------------------------------------- /src/cl_types.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2010-2011 X. Andrade 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 . 15 | !! 16 | !! $Id$ 17 | 18 | module cl_types_m 19 | implicit none 20 | 21 | type :: cl_platform_id 22 | private 23 | integer, pointer :: p 24 | end type cl_platform_id 25 | 26 | type :: cl_device_id 27 | private 28 | integer, pointer :: p 29 | end type cl_device_id 30 | 31 | type :: cl_context 32 | private 33 | integer, pointer :: p 34 | end type cl_context 35 | 36 | type :: cl_command_queue 37 | private 38 | integer, pointer :: p 39 | end type cl_command_queue 40 | 41 | type :: cl_mem 42 | private 43 | integer, pointer :: p 44 | end type cl_mem 45 | 46 | type :: cl_program 47 | private 48 | integer, pointer :: p 49 | end type cl_program 50 | 51 | type :: cl_kernel 52 | private 53 | integer, pointer :: p 54 | end type cl_kernel 55 | 56 | type :: cl_event 57 | private 58 | integer, pointer :: p 59 | end type cl_event 60 | 61 | type :: cl_sampler 62 | private 63 | integer, pointer :: p 64 | end type cl_sampler 65 | 66 | end module cl_types_m 67 | 68 | !! Local Variables: 69 | !! mode: f90 70 | !! coding: utf-8 71 | !! End: 72 | -------------------------------------------------------------------------------- /src/localcl.h: -------------------------------------------------------------------------------- 1 | /* 2 | ** Copyright (C) 2012 X. Andrade 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | 22 | #ifdef HAVE_OPENCL_CL_H 23 | #include 24 | #else 25 | #include 26 | #endif 27 | -------------------------------------------------------------------------------- /src/string_f.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2003 M. Marques, A. Castro, A. Rubio, G. Bertsch 3 | 4 | FortranCL is free software; you can redistribute it and/or modify 5 | it under the terms of the GNU Lesser General Public License as published by 6 | the Free Software Foundation; either version 2, or (at your option) 7 | any later version. 8 | 9 | FortranCL is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU Lesser General Public License for more details. 13 | 14 | You should have received a copy of the GNU Lesser General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 17 | 02111-1307, USA. 18 | 19 | $Id: string_f.h 3341 2007-10-12 15:47:30Z marques $ 20 | */ 21 | 22 | /* --------------------- Fortran to C string compatibility ---------------------- */ 23 | #include 24 | 25 | #if defined(_CRAY) 26 | #include 27 | 28 | #define to_c_str(f, c) { \ 29 | char *fc; int slen; \ 30 | fc = _fcdtocp(f); \ 31 | for(slen=_fcdlen(f)-1; slen>=0 && fc[slen]==' '; slen--); \ 32 | slen++; \ 33 | c = (char *)malloc(slen+1); \ 34 | strncpy(c, _fcdtocp(f), slen); \ 35 | c[slen] = '\0'; \ 36 | } 37 | 38 | #define to_f_str(c, f) { \ 39 | char *fc; int flen, clen, i; \ 40 | flen = _fcdlen(f); \ 41 | fc = _fcdtocp(f); \ 42 | clen = strlen(c); \ 43 | for(i=0; i=0; ll--) \ 66 | if(f[ll] != ' ') break; \ 67 | ll++; \ 68 | c = (char *)malloc((ll+1)*sizeof(char)); \ 69 | for(i=0; i 3 | ** 4 | ** FortranCL is free software: you can redistribute it and/or modify 5 | ** it under the terms of the GNU Lesser General Public License as published by 6 | ** the Free Software Foundation, either version 3 of the License, or 7 | ** (at your option) any later version. 8 | ** 9 | ** FortranCL is distributed in the hope that it will be useful, 10 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | ** GNU Lesser General Public License for more details. 13 | ** 14 | ** You should have received a copy of the GNU Lesser General Public License 15 | ** along with this program. If not, see . 16 | ** 17 | ** $Id$ 18 | */ 19 | 20 | #include 21 | #include 22 | #include 23 | #include "localcl.h" 24 | 25 | #include 26 | 27 | typedef void* ptrtype; 28 | 29 | /* -----------------------------------------------------------------------*/ 30 | 31 | void FC_FUNC_(fortrancl_get_component, FORTRANCL_GET_COMPONENT) 32 | (const ptrtype * array, const int * index, ptrtype * component){ 33 | *component = array[*index]; 34 | } 35 | 36 | 37 | /* -----------------------------------------------------------------------*/ 38 | 39 | void FC_FUNC_(fortrancl_set_component, FORTRANCL_SET_COMPONENT) 40 | (ptrtype * array, const int * index, const ptrtype * component){ 41 | array[*index] = *component; 42 | } 43 | 44 | /* -----------------------------------------------------------------------*/ 45 | 46 | void FC_FUNC_(fortrancl_set_null, FORTRANCL_SET_NULL) 47 | (ptrtype * ptr){ 48 | *ptr = NULL; 49 | } 50 | -------------------------------------------------------------------------------- /testsuite/Makefile.am: -------------------------------------------------------------------------------- 1 | ## Process this file with automake to produce Makefile.in 2 | 3 | ## Copyright (C) 2011 X. Andrade 4 | ## 5 | ## FortranCL 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 3 of the License, or 8 | ## (at your option) any later version. 9 | ## 10 | ## FortranCL is distributed in the hope that it will be useful, 11 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ## GNU Lesser General Public License for more details. 14 | ## 15 | ## You should have received a copy of the GNU Lesser General Public License 16 | ## along with this program. If not, see . 17 | ## 18 | ## $Id$ 19 | 20 | check_PROGRAMS = devices queue sum char 21 | dist_noinst_DATA = sum.cl char.cl queue.cl 22 | 23 | TESTS = $(check_PROGRAMS) 24 | 25 | UTILS = utils.f90 26 | UTILS_O = utils.o 27 | 28 | sum_SOURCES = sum.f90 $(UTILS) 29 | sum_LDADD = $(top_builddir)/src/libfortrancl.la @CL_LIBS@ 30 | 31 | char_SOURCES = char.f90 $(UTILS) 32 | char_LDADD = $(top_builddir)/src/libfortrancl.la @CL_LIBS@ 33 | 34 | queue_SOURCES = queue.f90 $(UTILS) 35 | queue_LDADD = $(top_builddir)/src/libfortrancl.la @CL_LIBS@ 36 | 37 | devices_SOURCES = devices.f90 38 | devices_LDADD = $(top_builddir)/src/libfortrancl.la @CL_LIBS@ 39 | 40 | AM_FCFLAGS = @F90_MODULE_FLAG@$(top_builddir)/src 41 | 42 | CLEANFILES = *~ *.bak *.mod *.MOD *.il *.d *.pc* ifc* $(noinst_PROGRAMS) 43 | 44 | sum.o : sum.f90 $(UTILS_O) 45 | char.o : char.f90 $(UTILS_O) 46 | queue.o : queue.f90 $(UTILS_O) 47 | -------------------------------------------------------------------------------- /testsuite/char.cl: -------------------------------------------------------------------------------- 1 | /* Copyright (C) 2012 X. Andrade 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 . 15 | ** 16 | ** $Id$ 17 | **/ 18 | 19 | __kernel void replace(const char sea, const char rep, __global char * string) { 20 | int ii = get_global_id(0); 21 | 22 | if(string[ii] == sea) string[ii] = rep; 23 | 24 | } 25 | 26 | /* 27 | Local Variables: 28 | mode: c 29 | coding: utf-8 30 | End: 31 | */ 32 | -------------------------------------------------------------------------------- /testsuite/char.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2011 X. Andrade 2 | !! 3 | !! FortranCL is free software; you can redistribute it and/or modify 4 | !! it under the terms of the GNU General Public License as published by 5 | !! the Free Software Foundation; either version 2, or (at your option) 6 | !! 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 General Public License for more details. 12 | !! 13 | !! You should have received a copy of the GNU General Public License 14 | !! along with this program; if not, write to the Free Software 15 | !! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 16 | !! 02111-1307, USA. 17 | !! 18 | !! $Id$ 19 | 20 | program char 21 | use cl 22 | use utils 23 | 24 | implicit none 25 | 26 | type(cl_device_id) :: device 27 | type(cl_context) :: context 28 | type(cl_command_queue) :: command_queue 29 | type(cl_kernel) :: kernel 30 | integer :: size, ierr 31 | integer(8) :: size_in_bytes, globalsize, localsize 32 | type(cl_mem) :: cl_string 33 | integer, parameter :: string_length = 1024 34 | character(len=string_length) :: string1, string2 35 | 36 | call initialize(device, context, command_queue) 37 | 38 | call build_kernel('char.cl', 'replace', context, device, kernel) 39 | 40 | !===================== 41 | ! RUN THE KERNEL 42 | !===================== 43 | size_in_bytes = int(string_length, 8) 44 | 45 | cl_string = clCreateBuffer(context, CL_MEM_READ_ONLY, size_in_bytes, ierr) 46 | 47 | string1 = 'Pepper clemens sent the messenger nevertheless the reverend left the herd' 48 | print*, trim(string1) 49 | 50 | call clEnqueueWriteBuffer(command_queue, cl_string, cl_bool(.true.), 0_8, size_in_bytes, string1(1:1), ierr) 51 | 52 | call clSetKernelArg(kernel, 0, 'e', ierr) 53 | call clSetKernelArg(kernel, 1, 'a', ierr) 54 | call clSetKernelArg(kernel, 2, cl_string, ierr) 55 | 56 | call clGetKernelWorkGroupInfo(kernel, device, CL_KERNEL_WORK_GROUP_SIZE, localsize, ierr) 57 | 58 | globalsize = int(string_length, 8) 59 | 60 | ! execute the kernel 61 | call clEnqueueNDRangeKernel(command_queue, kernel, (/globalsize/), (/localsize/), ierr) 62 | call clFinish(command_queue, ierr) 63 | 64 | call clEnqueueReadBuffer(command_queue, cl_string, cl_bool(.true.), 0_8, size_in_bytes, string2(1:1), ierr) 65 | 66 | print*, trim(string2) 67 | 68 | if(string2 /= 'Pappar clamans sant tha massangar navarthalass tha ravarand laft tha hard') then 69 | call error_exit('Wrong result') 70 | end if 71 | 72 | !===================== 73 | ! RELEASE EVERYTHING 74 | !===================== 75 | 76 | call clReleaseKernel(kernel, ierr) 77 | call clReleaseCommandQueue(command_queue, ierr) 78 | call clReleaseContext(context, ierr) 79 | 80 | end program char 81 | -------------------------------------------------------------------------------- /testsuite/devices.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2011 X. Andrade 2 | !! 3 | !! FortranCL is free software; you can redistribute it and/or modify 4 | !! it under the terms of the GNU General Public License as published by 5 | !! the Free Software Foundation; either version 2, or (at your option) 6 | !! 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 General Public License for more details. 12 | !! 13 | !! You should have received a copy of the GNU General Public License 14 | !! along with this program; if not, write to the Free Software 15 | !! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 16 | !! 02111-1307, USA. 17 | !! 18 | !! $Id$ 19 | 20 | program devs 21 | use cl 22 | 23 | implicit none 24 | 25 | type(cl_platform_id), allocatable :: platforms(:) 26 | type(cl_device_id), allocatable :: devices(:) 27 | integer :: num_platforms, num_devices, ierr, iplat, idev 28 | integer(8) :: val 29 | character(len=200) :: info 30 | 31 | ! get the number of platforms 32 | call clGetPlatformIDs(num_platforms, ierr) 33 | 34 | allocate(platforms(1:num_platforms)) 35 | 36 | write(*, '(a,i1)') 'Number of CL platforms : ', num_platforms 37 | write(*, '(a)') '' 38 | 39 | 40 | ! get an array of platforms 41 | call clGetPlatformIDs(platforms, num_platforms, ierr) 42 | 43 | ! iterate over platforms 44 | do iplat = 1, num_platforms 45 | 46 | ! print some info 47 | write(*, '(a,i1)') 'Platform number : ', iplat 48 | 49 | call clGetPlatformInfo(platforms(iplat), CL_PLATFORM_VENDOR, info, ierr) 50 | write(*, '(2a)') 'Vendor : ', trim(info) 51 | 52 | call clGetPlatformInfo(platforms(iplat), CL_PLATFORM_NAME, info, ierr) 53 | write(*, '(2a)') 'Name : ', trim(info) 54 | 55 | call clGetPlatformInfo(platforms(iplat), CL_PLATFORM_VERSION, info, ierr) 56 | write(*, '(2a)') 'Version : ', trim(info) 57 | 58 | ! get the device ID 59 | call clGetDeviceIDs(platforms(iplat), CL_DEVICE_TYPE_ALL, num_devices, ierr) 60 | 61 | write(*, '(a,i1)') 'Number of devices : ', num_devices 62 | write(*, '(a)') '' 63 | 64 | allocate(devices(1:num_devices)) 65 | 66 | ! get the device ID 67 | call clGetDeviceIDs(platforms(iplat), CL_DEVICE_TYPE_ALL, devices, num_devices, ierr) 68 | 69 | do idev = 1, num_devices 70 | write(*, '(a,i1)') ' Device number : ', idev 71 | 72 | call clGetDeviceInfo(devices(idev), CL_DEVICE_TYPE, val, ierr) 73 | select case(val) 74 | case(CL_DEVICE_TYPE_CPU) 75 | info = 'CPU' 76 | case(CL_DEVICE_TYPE_GPU) 77 | info = 'GPU' 78 | case(CL_DEVICE_TYPE_ACCELERATOR) 79 | info = 'Accelerator' 80 | end select 81 | 82 | write(*, '(2a)') ' Device type : ', trim(info) 83 | 84 | call clGetDeviceInfo(devices(idev), CL_DEVICE_VENDOR, info, ierr) 85 | write(*, '(2a)') ' Device vendor : ', trim(info) 86 | 87 | call clGetDeviceInfo(devices(idev), CL_DEVICE_NAME, info, ierr) 88 | write(*, '(2a)') ' Device name : ', trim(info) 89 | 90 | call clGetDeviceInfo(devices(idev), CL_DEVICE_GLOBAL_MEM_SIZE, val, ierr) 91 | write(*, '(a,i4)') ' Device memory : ', val/1024**2 92 | 93 | write(*, '(a)') '' 94 | end do 95 | 96 | deallocate(devices) 97 | write(*, '(a)') '' 98 | 99 | end do 100 | 101 | 102 | deallocate(platforms) 103 | 104 | end program devs 105 | -------------------------------------------------------------------------------- /testsuite/queue.cl: -------------------------------------------------------------------------------- 1 | /* Copyright (C) 2011 X. Andrade 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 . 15 | ** 16 | ** $Id$ 17 | **/ 18 | 19 | __kernel void dummy(){ 20 | 21 | } 22 | 23 | /* 24 | Local Variables: 25 | mode: c 26 | coding: utf-8 27 | End: 28 | */ 29 | -------------------------------------------------------------------------------- /testsuite/queue.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2011 X. Andrade 2 | !! 3 | !! FortranCL is free software; you can redistribute it and/or modify 4 | !! it under the terms of the GNU General Public License as published by 5 | !! the Free Software Foundation; either version 2, or (at your option) 6 | !! 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 General Public License for more details. 12 | !! 13 | !! You should have received a copy of the GNU General Public License 14 | !! along with this program; if not, write to the Free Software 15 | !! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 16 | !! 02111-1307, USA. 17 | !! 18 | !! $Id$ 19 | 20 | program queue 21 | use cl 22 | use utils 23 | 24 | implicit none 25 | 26 | type(cl_device_id) :: device 27 | type(cl_context) :: context 28 | type(cl_command_queue) :: command_queue 29 | type(cl_kernel) :: kernel 30 | type(cl_event) :: event, events(1:2) 31 | integer :: size, ierr 32 | integer(8) :: size_in_bytes, globalsize, localsize 33 | type(cl_mem) :: cl_string 34 | integer, parameter :: string_length = 1024 35 | 36 | call initialize(device, context, command_queue) 37 | 38 | call clFinish(command_queue, ierr) 39 | if(ierr /= CL_SUCCESS) call error_exit('Error in clFinish.') 40 | 41 | call clFlush(command_queue, ierr) 42 | if(ierr /= CL_SUCCESS) call error_exit('Error in clFlush.') 43 | 44 | call build_kernel('queue.cl', 'dummy', context, device, kernel) 45 | 46 | ! get the localsize for the kernel (note that the sizes are integer(8) variable) 47 | call clGetKernelWorkGroupInfo(kernel, device, CL_KERNEL_WORK_GROUP_SIZE, localsize, ierr) 48 | globalsize = 1024_8*localsize 49 | 50 | ! execute the kernel 51 | call clEnqueueNDRangeKernel(command_queue, kernel, (/globalsize/), (/localsize/), event, ierr) 52 | if(ierr /= CL_SUCCESS) call error_exit('Error in clEnqueueNDRangeKernel.') 53 | 54 | call clFinish(command_queue, ierr) 55 | 56 | call clWaitForEvents(event, ierr) 57 | if(ierr /= CL_SUCCESS) call error_exit('Error in clWaitForEvents.') 58 | 59 | call clRetainEvent(event, ierr) 60 | if(ierr /= CL_SUCCESS) call error_exit('Error in clRetainEvent.') 61 | call clReleaseEvent(event, ierr) 62 | if(ierr /= CL_SUCCESS) call error_exit('Error in clReleaseEvent.') 63 | call clReleaseEvent(event, ierr) 64 | if(ierr /= CL_SUCCESS) call error_exit('Error in clReleaseEvent.') 65 | 66 | ! execute the kernel 67 | call clEnqueueNDRangeKernel(command_queue, kernel, (/globalsize/), (/localsize/), events(1), ierr) 68 | if(ierr /= CL_SUCCESS) call error_exit('Error in clEnqueueNDRangeKernel.') 69 | 70 | call clEnqueueNDRangeKernel(command_queue, kernel, (/globalsize/), (/localsize/), events(2), ierr) 71 | if(ierr /= CL_SUCCESS) call error_exit('Error in clEnqueueNDRangeKernel.') 72 | 73 | call clWaitForEvents(events, ierr) 74 | if(ierr /= CL_SUCCESS) call error_exit('Error in clWaitForEvents.') 75 | 76 | call clReleaseEvent(events(1), ierr) 77 | if(ierr /= CL_SUCCESS) call error_exit('Error in clReleaseEvent.') 78 | 79 | call clReleaseEvent(events(2), ierr) 80 | if(ierr /= CL_SUCCESS) call error_exit('Error in clReleaseEvent.') 81 | 82 | 83 | call clReleaseCommandQueue(command_queue, ierr) 84 | call clReleaseContext(context, ierr) 85 | 86 | end program queue 87 | -------------------------------------------------------------------------------- /testsuite/sum.cl: -------------------------------------------------------------------------------- 1 | /* Copyright (C) 2011 X. Andrade 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 . 15 | ** 16 | ** $Id$ 17 | **/ 18 | 19 | __kernel void sum(const int size, const __global float * vec1, __global float * vec2){ 20 | int ii = get_global_id(0); 21 | 22 | if(ii < size) vec2[ii] += vec1[ii]; 23 | 24 | } 25 | 26 | /* 27 | Local Variables: 28 | mode: c 29 | coding: utf-8 30 | End: 31 | */ 32 | -------------------------------------------------------------------------------- /testsuite/sum.f90: -------------------------------------------------------------------------------- 1 | !! Copyright (C) 2011 X. Andrade 2 | !! 3 | !! FortranCL is free software; you can redistribute it and/or modify 4 | !! it under the terms of the GNU General Public License as published by 5 | !! the Free Software Foundation; either version 2, or (at your option) 6 | !! 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 General Public License for more details. 12 | !! 13 | !! You should have received a copy of the GNU General Public License 14 | !! along with this program; if not, write to the Free Software 15 | !! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 16 | !! 02111-1307, USA. 17 | !! 18 | !! $Id$ 19 | 20 | program sum 21 | use cl 22 | use utils 23 | 24 | implicit none 25 | 26 | type(cl_device_id) :: device 27 | type(cl_context) :: context 28 | type(cl_command_queue) :: command_queue 29 | type(cl_kernel) :: kernel 30 | integer :: size, ierr 31 | integer(8) :: size_in_bytes, globalsize, localsize 32 | real, allocatable :: vec1(:), vec2(:) 33 | type(cl_mem) :: cl_vec1, cl_vec2 34 | 35 | call initialize(device, context, command_queue) 36 | 37 | call build_kernel('sum.cl', 'sum', context, device, kernel) 38 | 39 | !===================== 40 | ! RUN THE KERNEL 41 | !===================== 42 | 43 | size = 50000 44 | size_in_bytes = int(size, 8)*4_8 45 | allocate(vec1(1:size)) 46 | allocate(vec2(1:size)) 47 | 48 | vec1 = 1.0 49 | vec2 = 2.0 50 | 51 | ! allocate device memory 52 | cl_vec1 = clCreateBuffer(context, CL_MEM_READ_ONLY, size_in_bytes, ierr) 53 | cl_vec2 = clCreateBuffer(context, CL_MEM_READ_WRITE, size_in_bytes, ierr) 54 | 55 | ! copy data to device memory 56 | call clEnqueueWriteBuffer(command_queue, cl_vec1, cl_bool(.true.), 0_8, size_in_bytes, vec1(1), ierr) 57 | call clEnqueueWriteBuffer(command_queue, cl_vec2, cl_bool(.true.), 0_8, size_in_bytes, vec2(1), ierr) 58 | 59 | ! set the kernel arguments 60 | call clSetKernelArg(kernel, 0, size, ierr) 61 | call clSetKernelArg(kernel, 1, cl_vec1, ierr) 62 | call clSetKernelArg(kernel, 2, cl_vec2, ierr) 63 | 64 | ! get the localsize for the kernel (note that the sizes are integer(8) variable) 65 | call clGetKernelWorkGroupInfo(kernel, device, CL_KERNEL_WORK_GROUP_SIZE, localsize, ierr) 66 | globalsize = int(size, 8) 67 | if(mod(globalsize, localsize) /= 0) globalsize = globalsize + localsize - mod(globalsize, localsize) 68 | 69 | ! execute the kernel 70 | call clEnqueueNDRangeKernel(command_queue, kernel, (/globalsize/), (/localsize/), ierr) 71 | call clFinish(command_queue, ierr) 72 | 73 | ! read the resulting vector from device memory 74 | call clEnqueueReadBuffer(command_queue, cl_vec2, cl_bool(.true.), 0_8, size_in_bytes, vec2(1), ierr) 75 | 76 | if(any(abs(vec2 - 3.0) > epsilon(3.0))) call error_exit('Wrong result') 77 | 78 | !===================== 79 | ! RELEASE EVERYTHING 80 | !===================== 81 | 82 | call clReleaseKernel(kernel, ierr) 83 | call clReleaseCommandQueue(command_queue, ierr) 84 | call clReleaseContext(context, ierr) 85 | 86 | end program sum 87 | -------------------------------------------------------------------------------- /testsuite/utils.f90: -------------------------------------------------------------------------------- 1 | module utils 2 | 3 | use cl 4 | 5 | implicit none 6 | 7 | private 8 | 9 | public :: & 10 | error_exit, & 11 | initialize, & 12 | build_kernel 13 | 14 | contains 15 | 16 | subroutine error_exit(msg, ierr) 17 | character(len=*), intent(in) :: msg 18 | integer, optional, intent(in) :: ierr 19 | 20 | write(*,'(a)') msg 21 | if(present(ierr)) write(*,'(a,i6)') 'Error code = ', ierr 22 | stop 1 23 | 24 | end subroutine error_exit 25 | 26 | ! ----------------------------------------------- 27 | 28 | subroutine initialize(device, context, command_queue) 29 | type(cl_device_id), intent(out) :: device 30 | type(cl_context), intent(out) :: context 31 | type(cl_command_queue), intent(out) :: command_queue 32 | 33 | integer :: num, ierr 34 | character(len = 100) :: info 35 | type(cl_platform_id) :: platform 36 | 37 | ! get the platform ID 38 | call clGetPlatformIDs(platform, num, ierr) 39 | if(ierr /= CL_SUCCESS) call error_exit('Cannot get CL platform.') 40 | 41 | ! get the device ID 42 | call clGetDeviceIDs(platform, CL_DEVICE_TYPE_ALL, device, num, ierr) 43 | if(ierr /= CL_SUCCESS) call error_exit('Cannot get CL device.') 44 | 45 | ! get the device name and print it 46 | call clGetDeviceInfo(device, CL_DEVICE_NAME, info, ierr) 47 | print*, "CL device: ", info 48 | 49 | ! create the context and the command queue 50 | context = clCreateContext(platform, device, ierr) 51 | command_queue = clCreateCommandQueue(context, device, CL_QUEUE_PROFILING_ENABLE, ierr) 52 | 53 | end subroutine initialize 54 | 55 | ! ----------------------------------------------- 56 | 57 | subroutine build_kernel(filename, kernelname, context, device, kernel) 58 | character(len=*), intent(in) :: filename 59 | character(len=*), intent(in) :: kernelname 60 | type(cl_context), intent(inout) :: context 61 | type(cl_device_id), intent(in) :: device 62 | type(cl_kernel), intent(out) :: kernel 63 | 64 | integer, parameter :: iunit = 10 65 | integer, parameter :: source_length = 1000 66 | character(len = source_length) :: source 67 | integer :: irec, ierr 68 | type(cl_program) :: prog 69 | 70 | ! read the source file 71 | open(unit = iunit, file = trim(filename), access='direct', status = 'old', action = 'read', iostat = ierr, recl = 1) 72 | if (ierr /= 0) then 73 | call error_exit('Cannot open file '//trim(filename)) 74 | end if 75 | 76 | source = '' 77 | irec = 1 78 | do 79 | read(unit = iunit, rec = irec, iostat = ierr) source(irec:irec) 80 | if (ierr /= 0) exit 81 | if(irec == source_length) call error_exit('Error: CL source file is too big') 82 | irec = irec + 1 83 | end do 84 | close(unit = iunit) 85 | 86 | ! create the program 87 | prog = clCreateProgramWithSource(context, source, ierr) 88 | if(ierr /= CL_SUCCESS) call error_exit('Error: cannot create program from source.') 89 | 90 | ! build 91 | call clBuildProgram(prog, '-cl-mad-enable', ierr) 92 | 93 | ! get the compilation log 94 | call clGetProgramBuildInfo(prog, device, CL_PROGRAM_BUILD_LOG, source, irec) 95 | if(len(trim(source)) > 0) print*, trim(source) 96 | 97 | if(ierr /= CL_SUCCESS) call error_exit('Error: program build failed.') 98 | 99 | ! finally get the kernel and release the program 100 | kernel = clCreateKernel(prog, trim(kernelname), ierr) 101 | call clReleaseProgram(prog, ierr) 102 | 103 | end subroutine build_kernel 104 | 105 | end module utils 106 | --------------------------------------------------------------------------------