├── src ├── .gitignore ├── fortran_wrapper.cpp └── arrayfire.f90 ├── lib └── .gitignore ├── examples ├── .gitignore ├── template.f90 ├── timer.f90 ├── Makefile ├── dla.f90 ├── indexing.f90 └── basic.f90 ├── common.mk ├── Makefile ├── LICENSE └── README.md /src/.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | -------------------------------------------------------------------------------- /lib/.gitignore: -------------------------------------------------------------------------------- 1 | *.so 2 | *.f90 3 | -------------------------------------------------------------------------------- /examples/.gitignore: -------------------------------------------------------------------------------- 1 | *_cuda 2 | *_ocl 3 | *.mod 4 | -------------------------------------------------------------------------------- /examples/template.f90: -------------------------------------------------------------------------------- 1 | program template 2 | use arrayfire 3 | implicit none 4 | 5 | call device_info() 6 | 7 | end program template 8 | -------------------------------------------------------------------------------- /common.mk: -------------------------------------------------------------------------------- 1 | AF_PATH?=/opt/arrayfire 2 | AF_LIB_NAME?=af 3 | AF_FORT=af_fortran 4 | 5 | LIB:=lib 6 | AF_CFLAGS = -I$(AF_PATH)/include 7 | 8 | AF_FORT_LIB_PATH = $(AF_FORT_PATH)/$(LIB)/ 9 | AF_LIB_PATH = $(AF_PATH)/$(LIB)/ 10 | 11 | AF_FORT_LIB=$(AF_FORT_LIB_PATH)/lib$(AF_FORT).so 12 | AF_FORT_FILE=$(AF_FORT_LIB_PATH)/arrayfire.f90 13 | -------------------------------------------------------------------------------- /examples/timer.f90: -------------------------------------------------------------------------------- 1 | program timer 2 | use arrayfire 3 | implicit none 4 | double precision elapsed 5 | type(array) A, B 6 | 7 | ! Generate a random matrix 8 | A = randu(1024, 2048) 9 | 10 | ! Start the timer 11 | call timer_start() 12 | 13 | ! Perform operations here. 14 | B = matmul(A, transpose(A)) 15 | 16 | ! Stop the timer 17 | elapsed = timer_stop() 18 | 19 | ! Print time taken 20 | write (*,"(a15, d8.2)") "Time taken: ", elapsed 21 | end program timer 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | AF_FORT_PATH=$(shell pwd) 2 | 3 | -include $(AF_FORT_PATH)/common.mk 4 | 5 | all: $(AF_FORT_LIB) $(AF_FORT_FILE) 6 | 7 | $(AF_FORT_FILE): $(AF_FORT_PATH)/src/arrayfire.f90 8 | @echo Copying $(shell (basename $@)) 9 | @cp $< $@ 10 | 11 | $(AF_FORT_LIB): $(AF_FORT_PATH)/src/fortran_wrapper.cpp 12 | @echo Building $(shell (basename $@)) 13 | @gfortran -shared -fPIC $< $(AF_CFLAGS) -L$(AF_LIB_PATH) -l$(AF_LIB_NAME) -o $@ 14 | 15 | clean: 16 | rm -f $(AF_FORT_LIB) 17 | rm -f $(AF_FORT_FILE) 18 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | AF_FORT_EXAMPLE_DIR=$(shell pwd) 2 | AF_FORT_PATH?=$(shell (dirname $(AF_FORT_EXAMPLE_DIR))) 3 | AF_FORT_BIN_DIR?=$(AF_FORT_PATH)/bin 4 | 5 | -include $(AF_FORT_PATH)/common.mk 6 | 7 | AF_FORT_MOD = $(AF_FORT_LIB_PATH)/arrayfire.f90 8 | LDFLAGS += -Wl,--no-as-needed -L$(AF_FORT_LIB_PATH) -l$(AF_FORT) -L$(AF_LIB_PATH) -l$(AF_LIB_NAME) 9 | LDFLAGS += -Wl,-rpath,$(AF_FORT_LIB_PATH),-rpath,$(abspath $(AF_FORT_LIB_PATH)) 10 | LDFLAGS += -Wl,-rpath,$(AF_LIB_PATH),-rpath,$(abspath $(AF_LIB_PATH)) 11 | 12 | SRC:=$(wildcard $(AF_FORT_EXAMPLE_DIR)/*.f90) 13 | BIN:=$(patsubst $(AF_FORT_EXAMPLE_DIR)/%.f90, $(AF_FORT_BIN_DIR)/%, $(SRC)) 14 | 15 | all: $(BIN) 16 | 17 | $(AF_FORT_BIN_DIR)/.flag: 18 | mkdir -p $(AF_FORT_BIN_DIR) 19 | touch $@ 20 | 21 | $(AF_FORT_BIN_DIR)/%: $(AF_FORT_EXAMPLE_DIR)/%.f90 $(AF_FORT_MOD) $(AF_FORT_BIN_DIR)/.flag 22 | @echo Building $(shell (basename $@)) 23 | @gfortran -L$(AF_PATH)/$(LIB) $(CFLAGS) $(LDFLAGS) $(AF_FORT_MOD) -o $@ $< 24 | 25 | clean: 26 | rm -f $(BIN) 27 | rm -f $(AF_FORT_BIN_DIR)/.flag 28 | rmdir $(AF_FORT_BIN_DIR) 29 | -------------------------------------------------------------------------------- /examples/dla.f90: -------------------------------------------------------------------------------- 1 | program dla 2 | use arrayfire 3 | implicit none 4 | 5 | type(array) A, B, C, X0, X1, X2 6 | type(array) l, u, p, r, diff 7 | integer :: N 8 | 9 | ! Set the size of the matrix 10 | N = 5 11 | 12 | ! Randomly generate a system 13 | A = randu(N, N) 14 | X0 = randu(N, 1) 15 | 16 | ! LU decomposition 17 | call lu(l, u, p, A) 18 | 19 | ! Construct a positive definite matrix 20 | C = A + transpose(A) + identity(N, N) * 100.0 21 | call cholesky(r, C) 22 | 23 | ! Solve a general system of equations 24 | B = matmul(A, X0) 25 | X1 = solve(A, B) 26 | call print(max(abs(X0 - X1)), "absolute error: Solving general system") 27 | 28 | ! Solve a positive definite system of equations 29 | B = matmul(C, X0) 30 | X2 = solve(C, B) 31 | call print(max(abs(X0 - X2)), "absolute error: Solving positive definite system") 32 | 33 | ! Invert a matrix 34 | r = inverse(A) 35 | diff = abs(identity(N, N) - matmul(r, A)) 36 | call print(max(moddims(diff, N * N, 1)), "absolute error: Inverting a matrix") 37 | 38 | end program dla 39 | -------------------------------------------------------------------------------- /examples/indexing.f90: -------------------------------------------------------------------------------- 1 | program template 2 | use arrayfire 3 | implicit none 4 | 5 | type(array) A1, A2, tmp 6 | integer :: I1(2), I2(2) 7 | 8 | ! 1D indexing 9 | A1 = randu(5, 1) 10 | A2 = constant(0, 5, 1) 11 | tmp = get(A1, [3,5]) ! Get elements 3 through 5 12 | call set(A2, tmp, [1,3]) ! Set elements 1 through 3 with values from tmp 13 | call print(A1,"A1") 14 | call print(tmp, "tmp") 15 | call print(A2,"A2") 16 | 17 | ! 2D indexing 18 | A1 = randu(3,3) 19 | A2 = constant(1,3,3) 20 | I1 = [1, 3] 21 | I2 = [2, 3] 22 | tmp = get(A1, idx(I1), idx(I2)) ! Get rows 1 and 3 for columns 2 and 3 23 | call set(A2, tmp, idx(I2), idx(I1)) ! Set rows 2 and 3 for columns 1 and 3 with values from tmp 24 | call print(A1, "A1") 25 | call print(tmp, "tmp") 26 | call print(A2, "A2") 27 | 28 | ! 3D indexing 29 | A1 = randu(3,3,2) 30 | A2 = constant(1,3,3,2) 31 | I1 = [1, 3] 32 | I2 = [2, 3] 33 | tmp = get(A1, idx(I1), [1,3,2], [1]) ! Get rows 1 and 3 for columns 1 and 3, tile 1 34 | call set(A2, tmp, idx(I2), [1,2], [2]) ! Set rows 2 and 3 for columns 1 and 2, tile 2 with tmp 35 | call print(A1, "A1") 36 | call print(tmp, "tmp") 37 | call print(A2, "A2") 38 | 39 | end program template 40 | -------------------------------------------------------------------------------- /examples/basic.f90: -------------------------------------------------------------------------------- 1 | program basic 2 | use arrayfire 3 | implicit none 4 | 5 | real, dimension(3,3) :: a 6 | real, dimension(:,:), allocatable :: b 7 | type(array) M1, M2, tmp 8 | 9 | a(1,:) = [1, 0, 0] 10 | a(2,:) = [0, 3, 0] 11 | a(3,:) = [0, 0, 2] 12 | 13 | ! Copy data from host to device 14 | M1 = a 15 | write(*,*) "Showing the matrix after mem copy from host (M1)" 16 | call print(M1) 17 | 18 | ! Generate a uniformly random, single precision matrix 19 | M2 = randu(3,3, ty=f32) 20 | write(*,*) "Showing a randomly generated matrix (M2)" 21 | call print(M2) 22 | 23 | ! Transpose of matrix 24 | tmp = transpose(M2) 25 | call print(tmp, "Transpose of M2") ! Displays array after printing message 26 | 27 | ! Element wise addition 28 | tmp = M1 + M2 29 | call print(tmp, "M1 + M2") 30 | 31 | ! element wise subtraction 32 | call print(-M2, "-M2") 33 | 34 | ! Trignometric functions 35 | write(*,*) "Displaying sin(M2)**2 + cos(M2)**2" 36 | call print(sin(M2)**2.0 + cos(M2)**2.0) 37 | 38 | ! Multiplication of matrices 39 | ! Matrix multiply 40 | write(*, *) "Matrix multiply: matmul(M1, M2)" 41 | call print(matmul(M1, M2)) 42 | 43 | ! Element wise multiplication 44 | write(*, *) "Element wise multiplication: M1 * M2" 45 | call print(M1 * M2) 46 | 47 | ! minimum value 48 | tmp = min(M2) 49 | call print(tmp, "min(M2)") 50 | 51 | ! Get back to host 52 | b = tmp 53 | write(*,*) "Showing min(M2) data back on host " 54 | write(*,*) b(:,:) 55 | 56 | end program basic 57 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, AccelerEyes LLC 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, this 11 | list of conditions and the following disclaimer in the documentation and/or 12 | other materials provided with the distribution. 13 | 14 | * Neither the name of the AccelerEyes LLC nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 22 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 23 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 24 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 25 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | arrayfire-fortran 2 | ================= 3 | 4 | This project provides Fotran bindings for ArrayFire. 5 | 6 | Prerequisites 7 | --------------- 8 | 9 | - The latest version of ArrayFire. You can get ArrayFire in the following ways. 10 | - [Binary Installer](http://www.arrayfire.com/download) 11 | - [Install from source](http://github.com/arrayfire/arrayfire) 12 | 13 | - `gfortran` 14 | 15 | - `make` 16 | 17 | Contents 18 | --------------- 19 | 20 | - `src/`: Contains the source files for the ArrayFire Fortran wrapper 21 | - `fortran_wrapper.cpp` The C++ part of the wrapper 22 | - `arrayfire.f90` The fortran part of the wrapper 23 | 24 | - `lib/` The location where the wrapper library and the fortran module are stored. 25 | 26 | - `examples`: contains a few examples demonstrating the usage 27 | 28 | 29 | Usage 30 | ---------------- 31 | 32 | After you the necessary pre-requisites, edit the following paramets in `common.mk` 33 | 34 | - Change `AF_PATH` to the right location 35 | - Change `AF_LIB_NAME` to point to the right backend. 36 | 37 | 38 | ### Linux 39 | 40 | - To build the Fortran Wrapper for ArrayFire run 41 | - `make all`(generates `libaf_fortran.so`) 42 | 43 | - To build the examples do one of the following from the examples directory 44 | - `make -C examples` (generates `examplename` in `bin` directory) 45 | 46 | Documentation 47 | --------------- 48 | 49 | - Work under progress 50 | 51 | License 52 | --------------- 53 | 54 | This project is licensed under BSD 3 clause license. 55 | 56 | Please check the LICENSE file in the root directory for more information. 57 | -------------------------------------------------------------------------------- /src/fortran_wrapper.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | using namespace af; 8 | using namespace std; 9 | 10 | typedef struct node { 11 | void *curr; 12 | struct node *left; 13 | struct node *right; 14 | bool cleanup; 15 | } Node; 16 | 17 | vector vec; 18 | 19 | void destroy(void *ptr) 20 | { 21 | for (int i = 0; i < vec.size(); i++){ 22 | 23 | if (vec[i].curr == ptr) { 24 | if (vec[i].left ) destroy(vec[i].left->curr ); 25 | if (vec[i].right) destroy(vec[i].right->curr); 26 | delete (array *)vec[i].curr; 27 | vec[i].cleanup = true; 28 | return; 29 | } 30 | 31 | } 32 | } 33 | 34 | int getnode(void *ptr) 35 | { 36 | for (int i = 0; i < vec.size(); i++) { 37 | if (vec[i].curr == ptr) return i; 38 | } 39 | return -1; 40 | } 41 | 42 | bool iscleanup(Node n) { return n.cleanup; } 43 | 44 | void cleanup(void *ptr) 45 | { 46 | int l = getnode(ptr); 47 | if (l < 0) return; 48 | 49 | if (vec[l].left ) destroy(vec[l].left->curr ); 50 | if (vec[l].right) destroy(vec[l].right->curr); 51 | vec[l].cleanup = true; 52 | 53 | vec.erase(std::remove_if(vec.begin(), vec.end(), iscleanup), vec.end()); 54 | } 55 | 56 | void vec_add(void *dst, void *in1=NULL, void *in2=NULL) 57 | { 58 | int l = getnode(in1); 59 | int r = getnode(in2); 60 | Node *left = (l < 0) ? NULL : &vec[l]; 61 | Node *right = (r < 0) ? NULL : &vec[r]; 62 | Node n = {dst, left, right, false}; 63 | vec.push_back(n); 64 | } 65 | 66 | extern "C" { 67 | 68 | void af_device_info_() { af::info(); return; } 69 | void af_device_get_(int *n) { *n = getDevice(); return; } 70 | void af_device_set_(int *n) { setDevice(*n); return; } 71 | void af_device_count_(int *n) {*n = getDeviceCount(); return; } 72 | 73 | void af_device_eval_(void **arr) { af::eval(*(array *)arr); return; } 74 | void af_device_sync_() { af::sync(); return; } 75 | 76 | void af_timer_start_() { timer::start(); return; } 77 | void af_timer_stop_(double *elapsed) { *elapsed = timer::stop(); return; } 78 | 79 | #define DEVICE(X, ty) \ 80 | void af_arr_device_##X##_(void **ptr, ty *a, \ 81 | int *shape, int *err) \ 82 | { \ 83 | try { \ 84 | *ptr = (void *)new array(); \ 85 | array *tmp = (array *)*ptr; \ 86 | *tmp = array(shape[0], shape[1], \ 87 | shape[2], shape[3], a); \ 88 | vec_add(*ptr); \ 89 | } catch (af::exception& ex) { \ 90 | *err = 1; \ 91 | printf("%s\n", ex.what()); \ 92 | exit(-1); \ 93 | } \ 94 | } \ 95 | 96 | DEVICE(s, float); 97 | DEVICE(d, double); 98 | DEVICE(c, cfloat); 99 | DEVICE(z, cdouble); 100 | 101 | void af_arr_copy_(void **dst, void **src, int *err) 102 | { 103 | try { 104 | if (*dst) delete (array *)*dst; 105 | *dst = *src; 106 | cleanup(*dst); 107 | } catch (af::exception& ex) { 108 | *err = 2; 109 | printf("%s\n", ex.what()); 110 | exit(-1); 111 | } 112 | } 113 | 114 | #define GEN(fn) \ 115 | void af_arr_##fn##_(void **ptr, int *x, \ 116 | int *fty, int *err) \ 117 | { \ 118 | try { \ 119 | dtype ty = (dtype)(*fty - 1); \ 120 | *ptr = (void *)new array(); \ 121 | array *tmp = (array *)*ptr; \ 122 | *tmp = fn(x[0], x[1], x[2], x[3], ty); \ 123 | vec_add(*ptr); \ 124 | } catch (af::exception& ex) { \ 125 | *err = 3; \ 126 | printf("%s\n", ex.what()); \ 127 | exit(-1); \ 128 | } \ 129 | } \ 130 | 131 | GEN(randu); 132 | GEN(randn); 133 | GEN(identity); 134 | #undef GEN 135 | 136 | void af_arr_constant_(void **ptr, int *val, int *x, int *fty, int *err) 137 | { 138 | try { 139 | dtype ty = (dtype)(*fty - 1); 140 | *ptr = (void *)new array(); 141 | array *tmp = (array *)*ptr; 142 | *tmp = constant(*val, x[0], x[1], x[2], x[3], ty); 143 | vec_add(*ptr); 144 | } catch (af::exception& ex) { 145 | *err = 3; 146 | printf("%sn", ex.what()); 147 | exit(-1); 148 | } 149 | } 150 | 151 | #define HOST(X, ty) \ 152 | void af_arr_host_##X##_(ty *a, void **ptr, \ 153 | int *dim, int *err) \ 154 | { try { \ 155 | array tmp = *(array *)*ptr; \ 156 | dim4 d = tmp.dims(); \ 157 | int bytes = tmp.elements() * sizeof(ty); \ 158 | tmp.host((void *)a); \ 159 | } catch (af::exception& ex) { \ 160 | *err = 5; \ 161 | printf("%s\n", ex.what()); \ 162 | exit(-1); \ 163 | } \ 164 | } \ 165 | 166 | HOST(s, float); 167 | HOST(d, double); 168 | HOST(c, cfloat); 169 | HOST(z, cdouble); 170 | 171 | #define SCOP(fn, op) \ 172 | void af_arr_sc##fn##_(void **dst, void **src, \ 173 | double *a, int *err) \ 174 | { \ 175 | try { \ 176 | *dst = (void *)new array(); \ 177 | array *in = (array *)*src; \ 178 | array *out = (array *)*dst; \ 179 | *out = *in op *a; \ 180 | vec_add(*dst, *src); \ 181 | } catch (af::exception& ex) { \ 182 | *err = 6; \ 183 | printf("%s\n", ex.what()); \ 184 | exit(-1); \ 185 | } \ 186 | } \ 187 | 188 | SCOP(plus , +) 189 | SCOP(minus , -) 190 | SCOP(times , *) 191 | SCOP(div , /) 192 | SCOP(le , <=) 193 | SCOP(lt , < ) 194 | SCOP(ge , >=) 195 | SCOP(gt , > ) 196 | SCOP(eq , ==) 197 | SCOP(ne , !=) 198 | 199 | #define ELOP(fn, op) \ 200 | void af_arr_el##fn##_(void **dst, void **src, \ 201 | void **tsd, int *err) \ 202 | { \ 203 | try { \ 204 | *dst = (void *)new array(); \ 205 | array *left = (array *)*src; \ 206 | array *right = (array *)*tsd; \ 207 | array *out = (array *)*dst; \ 208 | *out = *left op *right; \ 209 | vec_add(*dst, *src, *tsd); \ 210 | } catch (af::exception& ex) { \ 211 | *err = 7; \ 212 | printf("%s\n", ex.what()); \ 213 | exit(-1); \ 214 | } \ 215 | } \ 216 | 217 | ELOP(plus , +) 218 | ELOP(minus , -) 219 | ELOP(times , *) 220 | ELOP(div , /) 221 | ELOP(le , <=) 222 | ELOP(lt , < ) 223 | ELOP(ge , >=) 224 | ELOP(gt , > ) 225 | ELOP(eq , ==) 226 | ELOP(ne , !=) 227 | ELOP(and , &&) 228 | ELOP(or , ||) 229 | 230 | void af_arr_negate_(void **dst, void **src, int *err) 231 | { 232 | try { 233 | *dst = (void *)new array(); 234 | array *in = (array *)*src; 235 | array *out = (array *)*dst; 236 | *out = -(*in); 237 | vec_add(*dst, *src); 238 | } catch (af::exception& ex) { 239 | *err = 8; 240 | printf("%s\n", ex.what()); 241 | exit(-1); 242 | } 243 | } 244 | 245 | void af_arr_not_(void **dst, void **src, int *err) 246 | { 247 | try { 248 | *dst = (void *)new array(); 249 | array *in = (array *)*src; 250 | array *out = (array *)*dst; 251 | *out = !(*in); 252 | vec_add(*dst, *src); 253 | } catch (af::exception& ex) { 254 | *err = 8; 255 | printf("%s\n", ex.what()); 256 | exit(-1); 257 | } 258 | } 259 | 260 | void af_arr_scpow_(void **dst, void **src, double *a, int *err) 261 | { 262 | try { 263 | *dst = (void *)new array(); 264 | array *in = (array *)*src; 265 | array *out = (array *)*dst; 266 | *out = pow(*in , *a); 267 | vec_add(*dst, *src); 268 | } catch (af::exception& ex) { 269 | *err = 8; 270 | printf("%s\n", ex.what()); 271 | exit(-1); 272 | } 273 | } 274 | 275 | void af_arr_elpow_(void **dst, void **src, void **tsd, int *err) 276 | { 277 | try { 278 | *dst = (void *)new array(); 279 | array *left = (array *)*src; 280 | array *right = (array *)*tsd; 281 | array *out = (array *)*dst; 282 | *out = pow(*left , *right); 283 | vec_add(*dst, *src, *tsd); 284 | } catch (af::exception& ex) { 285 | *err = 9; 286 | printf("%s\n", ex.what()); 287 | exit(-1); 288 | } 289 | } 290 | 291 | #define OP(fn) \ 292 | void af_arr_##fn##_(void **dst, void **src, \ 293 | int *err) \ 294 | { \ 295 | try { \ 296 | *dst = (void *)new array(); \ 297 | array *in = (array *)*src; \ 298 | array *out = (array *)*dst; \ 299 | *out = af::fn(*in); \ 300 | vec_add(*dst, *src); \ 301 | } catch (af::exception& ex) { \ 302 | *err = 10; \ 303 | printf("%s\n", ex.what()); \ 304 | exit(-1); \ 305 | } \ 306 | } \ 307 | 308 | OP(sin); 309 | OP(cos); 310 | OP(tan); 311 | OP(log); 312 | OP(abs); 313 | OP(exp); 314 | OP(sort); 315 | OP(upper); 316 | OP(lower); 317 | OP(diag); 318 | OP(real); 319 | OP(imag); 320 | OP(complex); 321 | OP(conjg); 322 | OP(mean); 323 | OP(var); 324 | OP(stdev); 325 | 326 | #undef OP 327 | 328 | #define OP_NAME(fn, afn) \ 329 | void af_arr_##fn##_(void **dst, void **src, \ 330 | int *dim, int *err) \ 331 | { \ 332 | try { \ 333 | *dst = (void *)new array(); \ 334 | array *in = (array *)*src; \ 335 | array *out = (array *)*dst; \ 336 | *out = afn(*in, (*dim - 1)); \ 337 | vec_add(*dst, *src); \ 338 | } catch (af::exception& ex) { \ 339 | *err = 10; \ 340 | printf("%s\n", ex.what()); \ 341 | exit(-1); \ 342 | } \ 343 | } \ 344 | 345 | #define OP(fn) OP_NAME(fn, fn) 346 | 347 | OP(sum); 348 | OP(product); 349 | OP(min); 350 | OP(max); 351 | 352 | OP_NAME(anytrue, anyTrue); 353 | OP_NAME(alltrue, allTrue); 354 | 355 | #undef OP_NAME 356 | #undef OP 357 | 358 | void af_arr_moddims_(void **dst, void **src, int *x, int *err) 359 | { 360 | try { 361 | *dst = (void *)new array(); 362 | array *in = (array *)*src; 363 | array *out = (array *)*dst; 364 | *out = moddims(*in, x[0], x[1], x[2], x[3]); 365 | vec_add(*dst, *src); 366 | } catch (af::exception& ex) { 367 | *err = 11; 368 | printf("%sn", ex.what()); 369 | exit(-1); 370 | } 371 | } 372 | 373 | void af_arr_tile_(void **dst, void **src, int *x, int *err) 374 | { 375 | try { 376 | *dst = (void *)new array(); 377 | array *in = (array *)*src; 378 | array *out = (array *)*dst; 379 | dim4 dims(x[0], x[1], x[2], x[3]); 380 | *out = tile(*in, dims); 381 | vec_add(*dst, *src); 382 | } catch (af::exception& ex) { 383 | *err = 11; 384 | printf("%sn", ex.what()); 385 | exit(-1); 386 | } 387 | } 388 | 389 | void af_arr_t_(void **dst, void **src, int *err) 390 | { 391 | try { 392 | *dst = (void *)new array(); 393 | array *in = (array *)*src; 394 | array *out = (array *)*dst; 395 | *out = (*in).T(); 396 | vec_add(*dst, *src); 397 | } catch (af::exception& ex) { 398 | *err = 11; 399 | printf("%s\n", ex.what()); 400 | exit(-1); 401 | } 402 | } 403 | 404 | void af_arr_h_(void **dst, void **src, int *err) 405 | { 406 | try { 407 | *dst = (void *)new array(); 408 | array *in = (array *)*src; 409 | array *out = (array *)*dst; 410 | *out = (*in).H(); 411 | vec_add(*dst, *src); 412 | } catch (af::exception& ex) { 413 | *err = 11; 414 | printf("%s\n", ex.what()); 415 | exit(-1); 416 | } 417 | } 418 | 419 | void af_arr_reorder_(void **dst, void **src, int *shape, int *err) 420 | { 421 | try { 422 | *dst = (void *)new array(); 423 | array *in = (array *)*src; 424 | array *out = (array *)*dst; 425 | *out = reorder(*in, shape[0]-1, shape[1]-1, shape[2]-1, shape[3]-1); 426 | vec_add(*dst, *src); 427 | } catch (af::exception& ex) { 428 | *err = 11; 429 | printf("%s\n", ex.what()); 430 | exit(-1); 431 | } 432 | } 433 | 434 | void af_arr_complex2_(void **dst, void **re, void **im, int *err) 435 | { 436 | try { 437 | *dst = (void *)new array(); 438 | array *in1 = (array *)*re; 439 | array *in2 = (array *)*im; 440 | array *out = (array *)*dst; 441 | *out = af::complex(*in1, *in2); 442 | vec_add(*dst, *re, *im); 443 | } catch (af::exception& ex) { 444 | *err = 11; 445 | printf("%s\n", ex.what()); 446 | exit(-1); 447 | } 448 | } 449 | 450 | void af_arr_norm_(double *dst, void **src, int *err) 451 | { 452 | try { 453 | array *in = (array *)*src; 454 | *dst = (double)norm(*in); 455 | } catch (af::exception& ex) { 456 | *err = 11; 457 | printf("%s\n", ex.what()); 458 | exit(-1); 459 | } 460 | } 461 | 462 | void af_arr_pnorm_(double *dst, void **src, float *p, int *err) 463 | { 464 | try { 465 | array *in = (array *)*src; 466 | *dst = (double)norm(*in, AF_NORM_VECTOR_P, *p); 467 | } catch (af::exception& ex) { 468 | *err = 11; 469 | printf("%s\n", ex.what()); 470 | exit(-1); 471 | } 472 | } 473 | 474 | void af_arr_matmul_(void **dst, void **src, void **tsd, int *err) 475 | { 476 | try { 477 | 478 | *dst = (void *)new array(); 479 | array *left = (array *)*src; 480 | array *right = (array *)*tsd; 481 | array *out = (array *)*dst; 482 | *out = matmul(*left, *right); 483 | vec_add(*dst, *src, *tsd); 484 | } catch (af::exception& ex) { 485 | *err = 11; 486 | printf("%s\n", ex.what()); 487 | exit(-1); 488 | } 489 | } 490 | 491 | void af_arr_lu_(void **l, void **u, void **p, void **in, int *err) 492 | { 493 | try { 494 | *l = (void *)new array(); 495 | *u = (void *)new array(); 496 | *p = (void *)new array(); 497 | 498 | array *L = (array *)*l, *U = (array *)*u, *P = (array *)*p, *A = (array *)*in; 499 | lu(*L, *U, *P, *A); 500 | } 501 | catch (af::exception& ex) { 502 | *err = 11; 503 | printf("%s\n", ex.what()); 504 | exit(-1); 505 | } 506 | } 507 | 508 | 509 | void af_arr_lu_inplace_(void **in, int *err) 510 | { 511 | try { 512 | array *A = (array *)*in; 513 | int m = A->dims(0), n = A->dims(1); 514 | array pivot; 515 | luInPlace(pivot, *A, true); 516 | } 517 | catch (af::exception& ex) { 518 | *err = 11; 519 | printf("%s\n", ex.what()); 520 | exit(-1); 521 | } 522 | } 523 | 524 | 525 | void af_arr_qr_(void **q, void **r, void **in, int *err) 526 | { 527 | try { 528 | *q = (void *)new array(); 529 | *r = (void *)new array(); 530 | 531 | array *Q = (array *)*q, *R = (array *)*r, *A = (array *)*in; 532 | qr(*Q, *R, *A); 533 | } 534 | catch (af::exception& ex) { 535 | *err = 11; 536 | printf("%s\n", ex.what()); 537 | exit(-1); 538 | } 539 | } 540 | 541 | 542 | void af_arr_cholesky_(void **r, void **in, int *err) 543 | { 544 | try { 545 | *r = (void *)new array(); 546 | unsigned info; 547 | array *R = (array *)*r, *A = (array *)*in; 548 | *err = cholesky(*R, *A, false); 549 | } 550 | catch (af::exception& ex) { 551 | *err = 11; 552 | printf("%s\n", ex.what()); 553 | exit(-1); 554 | } 555 | } 556 | 557 | 558 | void af_arr_cholesky_inplace_(void **r, int *err) 559 | { 560 | try { 561 | unsigned info; 562 | array *R = (array *)*r; 563 | *err = choleskyInPlace(*R, true); 564 | } 565 | catch (af::exception& ex) { 566 | *err = 11; 567 | printf("%s\n", ex.what()); 568 | exit(-1); 569 | } 570 | } 571 | 572 | void af_arr_singular_(void **s, void **u, void **v, void **in, int *err) 573 | { 574 | try { 575 | *s = (void *)new array(); 576 | *u = (void *)new array(); 577 | *v = (void *)new array(); 578 | 579 | array *S = (array *)*s, *U = (array *)*u, *V = (array *)*v, *A = (array *)*in; 580 | svd(*S, *U, *V, *A); 581 | } 582 | catch (af::exception& ex) { 583 | printf("%s\n", ex.what()); 584 | exit(1); 585 | } 586 | *err = 0; 587 | } 588 | 589 | void af_arr_inverse_(void **r, void **in, int *err) 590 | { 591 | try { 592 | *r = (void *)new array(); 593 | array *R = (array *)*r, *A = (array *)*in; 594 | *R = inverse(*A); 595 | vec_add((void *)r, *in); 596 | } 597 | catch (af::exception& ex) { 598 | *err = 11; 599 | printf("%s\n", ex.what()); 600 | exit(-1); 601 | } 602 | } 603 | 604 | void af_arr_solve_(void **x, void **a, void **b, int *err) 605 | { 606 | try { 607 | *x = (void *)new array(); 608 | 609 | array *A = (array *)*a, *B = (array *)*b, *X = (array *)*x; 610 | *X = solve(*A, *B); 611 | vec_add(*x, *a, *b); 612 | } 613 | catch (af::exception& ex) { 614 | *err = 11; 615 | printf("%s\n", ex.what()); 616 | exit(-1); 617 | } 618 | } 619 | 620 | void af_arr_get_(void **out, void **in, 621 | void **d0, void **d1, int *d2, int *d3, int *dims, 622 | int *err) 623 | { 624 | try { 625 | *out = (void *)new array(); 626 | array *R = (array *)*out; 627 | array A = *(array *)*in; 628 | 629 | array idx0 = (*(array *)*d0) - 1; 630 | array idx1 = array(A.dims(1)); 631 | seq idx2 = span; 632 | int idx3 = 0; 633 | 634 | if (*dims >= 2) idx1 = (*(array *)*d1) - 1; 635 | if (*dims >= 3) idx2 = seq(d2[0], d2[2], d2[1]); 636 | if (*dims >= 4) idx3 = d3[0]; 637 | 638 | if (*dims == 3) { 639 | *R = A(idx0, idx1, idx2); 640 | } else { 641 | if (d2[0] != d2[1]) { 642 | printf("When using 4d indexing, last two dimensions should be integers\n"); 643 | exit(-1); 644 | } 645 | int lastdim = idx3 * A.dims(2) + d2[0]; 646 | *R = A(idx0, idx1, lastdim); 647 | } 648 | 649 | vec_add(*out, *in); 650 | } catch (af::exception& ex) { 651 | *err = 12; 652 | printf("%s\n", ex.what()); 653 | exit(-1); 654 | } 655 | } 656 | 657 | void af_arr_get2_(void **out, void **in, 658 | void **d0, int *d1, int *d2, int *dims, 659 | int *err) 660 | { 661 | try { 662 | *out = (void *)new array(); 663 | array *R = (array *)*out; 664 | array A = *(array *)*in; 665 | 666 | array idx0 = (*(array *)*d0) - 1; 667 | seq idx1 = span; 668 | seq idx2 = span; 669 | 670 | if (*dims >= 2) idx1 = seq(d1[0], d1[2], d1[1]); 671 | if (*dims >= 3) idx2 = seq(d2[0], d2[2], d2[1]); 672 | 673 | *R = A(idx0, idx1, idx2); 674 | vec_add(*out, *in); 675 | 676 | } catch (af::exception& ex) { 677 | *err = 12; 678 | printf("%s\n", ex.what()); 679 | exit(-1); 680 | } 681 | } 682 | 683 | void af_arr_get_seq_(void **out, void **in, 684 | int *d0, int *d1, int *d2, int *d3, 685 | int *dim, int *err) 686 | { 687 | try { 688 | *out = (void *)new array(); 689 | array *R = (array *)*out; 690 | array A = *(array *)*in; 691 | 692 | seq s0 = seq(d0[0], d0[2], d0[1]); 693 | seq s1 = span; 694 | seq s2 = span; 695 | seq s3 = span; 696 | 697 | if (*dim >= 2) s1 = seq(d1[0], d1[2], d1[1]); 698 | if (*dim >= 3) s2 = seq(d2[0], d2[2], d2[1]); 699 | if (*dim >= 4) s3 = seq(d3[0], d3[2], d3[1]); 700 | 701 | *R = A(s0, s1, s2, s3); 702 | 703 | vec_add(*out, *in); 704 | } catch (af::exception& ex) { 705 | *err = 12; 706 | printf("%s\n", ex.what()); 707 | exit(-1); 708 | } 709 | } 710 | 711 | void af_arr_set_(void **out, void **in, 712 | void **d0, void **d1, int *d2, int *d3, int *dims, 713 | int *err) 714 | { 715 | try { 716 | array *R = (array *)*out; 717 | array A = *(array *)*in; 718 | 719 | array idx0 = (*(array *)*d0) - 1; 720 | array idx1 = array(A.dims(1)); 721 | seq idx2 = span; 722 | int idx3 = 0; 723 | 724 | if (*dims >= 2) idx1 = (*(array *)*d1) - 1; 725 | if (*dims >= 3) idx2 = seq(d2[0], d2[2], d2[1]); 726 | if (*dims >= 4) idx3 = d3[0]; 727 | 728 | if (*dims == 3) { 729 | (*R)(idx0, idx1, idx2) = A; 730 | } else { 731 | if (d2[0] != d2[1]) { 732 | printf("When using 4d indexing, last two dimensions should be integers\n"); 733 | exit(-1); 734 | } 735 | int lastdim = idx3 * R->dims(2) + d2[0]; 736 | (*R)(idx0, idx1, lastdim) = A; 737 | } 738 | 739 | } catch (af::exception& ex) { 740 | *err = 12; 741 | printf("%s\n", ex.what()); 742 | exit(-1); 743 | } 744 | } 745 | 746 | void af_arr_set2_(void **out, void **in, 747 | void **d0, int *d1, int *d2, int *dims, 748 | int *err) 749 | { 750 | try { 751 | array *R = (array *)*out; 752 | array A = *(array *)*in; 753 | 754 | array idx0 = (*(array *)*d0) - 1; 755 | seq idx1 = span; 756 | seq idx2 = span; 757 | 758 | if (*dims >= 2) idx1 = seq(d1[0], d1[2], d1[1]); 759 | if (*dims >= 3) idx2 = seq(d2[0], d2[2], d2[1]); 760 | 761 | (*R)(idx0, idx1, idx2) = A; 762 | } catch (af::exception& ex) { 763 | *err = 12; 764 | printf("%s\n", ex.what()); 765 | exit(-1); 766 | } 767 | } 768 | 769 | void af_arr_set_seq_(void **out, void **in, 770 | int *d0, int *d1, int *d2, int *d3, 771 | int *dim, int *err) 772 | { 773 | try { 774 | array *R = (array *)*out; 775 | array A = *(array *)*in; 776 | 777 | seq s0 = seq(d0[0], d0[2], d0[1]); 778 | seq s1 = span; 779 | seq s2 = span; 780 | seq s3 = span; 781 | 782 | if (*dim >= 2) s1 = seq(d1[0], d1[2], d1[1]); 783 | if (*dim >= 3) s2 = seq(d2[0], d2[2], d2[1]); 784 | if (*dim >= 4) s3 = seq(d3[0], d3[2], d3[1]); 785 | 786 | (*R)(s0, s1, s2, s3) = A; 787 | } catch (af::exception& ex) { 788 | *err = 12; 789 | printf("%s\n", ex.what()); 790 | exit(-1); 791 | } 792 | } 793 | 794 | void af_idx_seq_(void **out, int *first, int *last, int *step, int *err) 795 | { 796 | try { 797 | *out = (void *)new array(); 798 | array *R = (array *)*out; 799 | *R = array(seq(*first, *step, *last)); 800 | vec_add((void *)out); 801 | } catch (af::exception& ex) { 802 | *err = 12; 803 | printf("%s\n", ex.what()); 804 | exit(-1); 805 | } 806 | } 807 | 808 | void af_idx_vec_(void **out, int* indices, int *numel, int *err) 809 | { 810 | try { 811 | *out = (void *)new array(); 812 | array *R = (array *)*out; 813 | *R = array(*numel, indices, afHost).as(f32); 814 | vec_add((void *)out); 815 | } catch (af::exception& ex) { 816 | *err = 12; 817 | printf("%s\n", ex.what()); 818 | exit(-1); 819 | } 820 | } 821 | 822 | void af_arr_join_(int *dim, void **out, void **in1, void **in2, int *err) 823 | { 824 | try { 825 | *out = (void *)new array(); 826 | array *R = (array *)*out; 827 | array *F = (array *)*in1; 828 | array *S = (array *)*in2; 829 | *R = join(*dim -1, *F, *S); 830 | vec_add((void *)out, *in1, *in2); 831 | } catch (af::exception& ex) { 832 | *err = 12; 833 | printf("%s\n", ex.what()); 834 | exit(-1); 835 | } 836 | } 837 | 838 | void init_post_(void **in, int *shape, int *rank) 839 | { 840 | try { 841 | array *R = (array *)*in; 842 | for (int i = 0; i < 4; i++) shape[i] = R->dims(i); 843 | *rank = R->numdims(); 844 | } catch (af::exception& ex) { 845 | printf("%s\n", ex.what()); 846 | exit(-1); 847 | } 848 | } 849 | 850 | void af_arr_print_(void **ptr, int *err) 851 | { 852 | try { 853 | array *tmp = (array *)*ptr; 854 | af::print("", *tmp); 855 | } catch (af::exception& ex) { 856 | *err = 4; 857 | printf("%s\n", ex.what()); 858 | exit(-1); 859 | } 860 | } 861 | } 862 | -------------------------------------------------------------------------------- /src/arrayfire.f90: -------------------------------------------------------------------------------- 1 | module arrayfire 2 | use, intrinsic :: ISO_C_Binding, only: C_ptr, C_NULL_ptr 3 | implicit none 4 | 5 | !> Contains the last known error in the arrayfire module 6 | integer :: err 7 | 8 | !> Single precision, real type 9 | integer :: f32 = 1 10 | !> Single precision, complex type 11 | integer :: c32 = 2 12 | !> Double precision, real type 13 | integer :: f64 = 3 14 | !> Double precision, complex type 15 | integer :: c64 = 4 16 | !> Boolean type 17 | integer :: b8 = 5 18 | 19 | !> type(array) containing information about device 20 | type array 21 | !> Dimensions of array 22 | integer :: shape(4) 23 | !> Rank of the array 24 | integer :: rank 25 | !> Device pointer 26 | type(C_ptr) :: ptr = C_NULL_ptr 27 | ! not supported in gfortran 4.3 28 | ! contains 29 | ! procedure :: get => array_get 30 | ! procedure :: set => array_set 31 | end type array 32 | 33 | !> @defgroup basic Basics 34 | !! @{ 35 | 36 | !> @defgroup mem Create arrays from host data 37 | !> @{ 38 | !> Memory transfer from host to device, device to host. 39 | !> @param[in] rhs -- Can be type array, real, double precision, complex, double complex 40 | !> @returns lhs after assigning rhs to lhs 41 | !> @code 42 | !! type(array) arr 43 | !! real, dimension(2, 2) :: a 44 | !! a(1,1) = 1 45 | !! a(2,2) = 1 46 | !! ! a is now identity matrix of width 2 47 | !! arr = a ! Data is now on device 48 | !! arr = arr + 1.0 ! Increment arr by 1 49 | !! a = log(arr) ! Return log(arr) to host 50 | !! @endcode 51 | interface assignment (=) 52 | module procedure device1_s, device1_d, device1_c, device1_z 53 | module procedure device2_s, device2_d, device2_c, device2_z 54 | module procedure device3_s, device3_d, device3_c, device3_z 55 | module procedure device4_s, device4_d, device4_c, device4_z 56 | module procedure assign 57 | module procedure host1_s, host1_d, host1_c, host1_z 58 | module procedure host2_s, host2_d, host2_c, host2_z 59 | module procedure host3_s, host3_d, host3_c, host3_z 60 | module procedure host4_s, host4_d, host4_c, host4_z 61 | end interface assignment (=) 62 | 63 | interface getptr 64 | module procedure hostp1_s, hostp1_d, hostp1_c, hostp1_z 65 | module procedure hostp2_s, hostp2_d, hostp2_c, hostp2_z 66 | module procedure hostp3_s, hostp3_d, hostp3_c, hostp3_z 67 | module procedure hostp4_s, hostp4_d, hostp4_c, hostp4_z 68 | end interface getptr 69 | 70 | !> @} 71 | 72 | 73 | !> @defgroup gen Generate random or constant matrices 74 | !> Matrix generation 75 | !> @code 76 | !! type(array) res 77 | !! res = randu(3, 3) ! Uniformly distributed random matrix, single precision by default 78 | !! res = randn(3, 3) ! Normally distributed random matrix, single precision by default 79 | !! res = constant(1,5, 5, ty = f32) ! Single precision matrix of all ones 80 | !! res = constant(0,4, 4,ty = f64) ! Double precision matrix of all zeros 81 | !! res = identity(2, 2) ! Identity Matrix, single precision by default 82 | !! @endcode 83 | !> @{ 84 | !> Generate matrices on the devices 85 | 86 | !> @{ 87 | !> Random, uniformly distributed 88 | !> @param[in] x1 -- The 1st dimension in the array (should be integer) 89 | !> @param[in] x2 -- The 2nd dimension in the array (should be integer, optional, default: 1) 90 | !> @param[in] x3 -- The 3rd dimension in the array (should be integer, optional, default: 1) 91 | !> @param[in] x4 -- The 4th dimension in the array (should be integer, optional, default: 1) 92 | !> @param[in] ty -- Should be one of (f32, f64, c32, c64), (optional, default: f32) 93 | !> @returns output of size (x1, x2, x3, x4) filled with the required data type 94 | interface randu 95 | module procedure array_randu 96 | end interface randu 97 | !> @} 98 | 99 | !> @{ 100 | !> Random, normally distributed 101 | !> @param[in] x1 -- The 1st dimension in the array (should be integer) 102 | !> @param[in] x2 -- The 2nd dimension in the array (should be integer, optional, default: 1) 103 | !> @param[in] x3 -- The 3rd dimension in the array (should be integer, optional, default: 1) 104 | !> @param[in] x4 -- The 4th dimension in the array (should be integer, optional, default: 1) 105 | !> @param[in] ty -- Should be one of (f32, f64, c32, c64), (optional, default: f32) 106 | !> @returns output of size (x1, x2, x3, x4) filled with the required data type 107 | interface randn 108 | module procedure array_randn 109 | end interface randn 110 | !> @} 111 | 112 | !> @{ 113 | !> Constant value 114 | !> @param[in] val -- constant value to constant with 115 | !> @param[in] x1 -- The 1st dimension in the array (should be integer) 116 | !> @param[in] x2 -- The 2nd dimension in the array (should be integer, optional, default: 1) 117 | !> @param[in] x3 -- The 3rd dimension in the array (should be integer, optional, default: 1) 118 | !> @param[in] x4 -- The 4th dimension in the array (should be integer, optional, default: 1) 119 | !> @param[in] ty -- Should be one of (f32, f64, c32, c64), (optional, default: f32) 120 | !> @returns output of size (x1, x2, x3, x4) constanted with the required data type 121 | interface constant 122 | module procedure array_constant 123 | end interface constant 124 | !> @} 125 | 126 | !> @{ 127 | !> Constant, identity 128 | !> @param[in] x1 -- The 1st dimension in the array (should be integer) 129 | !> @param[in] x2 -- The 2nd dimension in the array (should be integer, optional, default: 1) 130 | !> @param[in] ty -- Should be one of (f32, f64, c32, c64), (optional, default: f32) 131 | !> @returns output of size (x1, x2, x3, x4) filled with the required data type 132 | interface identity 133 | module procedure array_identity 134 | end interface identity 135 | !> @} 136 | !> @} 137 | 138 | !> @defgroup indexing Array Indexing 139 | !> @{ 140 | !> Setting and getting values from an array 141 | !> @code 142 | !> type(array) r, s, z 143 | !> r = randu(5,5) 144 | !> z = constant(0,5,5) 145 | !> s = get(a, idx(2), seq(1,5,2)) !Get the second row and every other column between 1 and 5 146 | !> call set(z, s, idx(1), seq(1,3)) !Set s as the first row and columsn 1 through 3 147 | !> @endcode 148 | 149 | !> @{ 150 | !> @param[in] in Input array 151 | !> @param[in] d1 type(array) denoting indices along 1st dimension 152 | !> @param[in] d2 type(array) denoting indices along 2nd dimension. Optional. 153 | !> @param[in] d3 integer denoting the index of the 3rd dimension. Optional. 154 | !> @param[in] d4 integer denoting the index of the 4th dimension. Optional. 155 | !> @returns subarry of in referenced by d1,d2,d3,d4 156 | interface get 157 | module procedure array_get, array_get2, array_get_seq 158 | end interface get 159 | !> @} 160 | 161 | !> @{ 162 | !> @param[in] lhs Array whos values are being set by rhs 163 | !> @param[in] rhs The value being set 164 | !> @param[in] d1 type(array) denoting indices along 1st dimension 165 | !> @param[in] d2 type(array) denoting indices along 2nd dimension. Optional. 166 | !> @param[in] d3 integer denoting the index of the 3rd dimension. Optional. 167 | !> @param[in] d4 integer denoting the index of the 4th dimension. Optional. 168 | interface set 169 | module procedure array_set, array_set2, array_set_seq 170 | end interface set 171 | !> @} 172 | 173 | !> @{ 174 | !> @param[in] index Can be an integer scalar or array 175 | !> @returns type(array) holding the value of index 176 | interface idx 177 | module procedure idx_scalar, idx_vector 178 | end interface idx 179 | !> @} 180 | 181 | !> @{ 182 | !> @param[in] first The first element of the sequence. Optional. Default: 0. 183 | !> @param[in] last The last element of the sequence. Optional. Default: 0. 184 | !> @param[in] setp The step size. Optional. Default: 1. 185 | interface seq 186 | module procedure arr_seq 187 | end interface seq 188 | !> @} 189 | !> @} 190 | 191 | 192 | !> @defgroup tile Tiling and reshaping 193 | !> @{ 194 | !> moddims, flat, tile, etc 195 | 196 | !> @{ 197 | !> Moddims an array 198 | !> @param[in] A an array 199 | !> @param[in] x1 -- The 1st dimension in the array (should be integer) 200 | !> @param[in] x2 -- The 2nd dimension in the array (should be integer, optional, default: 1) 201 | !> @param[in] x3 -- The 3rd dimension in the array (should be integer, optional, default: 1) 202 | !> @param[in] x4 -- The 4th dimension in the array (should be integer, optional, default: 1) 203 | !> @returns output of size (x1, x2, x3, x4) with the same data as input 204 | !> @code 205 | !! type(array) A, B 206 | !! A = randu(2, 4) ! 2 dimensional array 207 | !! B = moddims(A, 2, 2, 2) ! 3 dimensional array 208 | !! @endcode 209 | interface moddims 210 | module procedure array_moddims 211 | end interface moddims 212 | !> @} 213 | 214 | !> @{ 215 | !> Flatten an array 216 | !> @param[in] A an array 217 | !> @returns output of size with the same data as input, but as a column vector 218 | !> @code 219 | !! type(array) A, B 220 | !! A = randu(2, 4) ! 2 dimensional array 221 | !! B = flat(A) ! 1 dimensional array 222 | !! @endcode 223 | interface flat 224 | module procedure array_flat 225 | end interface flat 226 | !> @} 227 | 228 | !> @{ 229 | !> Tile an array 230 | !> @param[in] A an array 231 | !> @param[in] x1 -- The 1st dimension in the array (should be integer, optional, default: 1) 232 | !> @param[in] x2 -- The 2nd dimension in the array (should be integer, optional, default: 1) 233 | !> @param[in] x3 -- The 3rd dimension in the array (should be integer, optional, default: 1) 234 | !> @param[in] x4 -- The 4th dimension in the array (should be integer, optional, default: 1) 235 | !> @returns output of size (x1, x2, x3, x4) with the same data as input 236 | !> @code 237 | !! type(array) A, B 238 | !! A = randu(2, 4) ! 2 dimensional array 239 | !! B = tile(A, 1, 1, 2) ! 3 dimensional array 240 | !! @endcode 241 | interface tile 242 | module procedure array_tile 243 | end interface tile 244 | !> @} 245 | 246 | !> @{ 247 | !> Join two arrays 248 | !> @param[in] d -- The dimension along which two arrays are to be joined 249 | !> @param[in] first -- The first array 250 | !> @param[in] second -- The second array 251 | !> @returns output which is the combined array of first and second 252 | !> @code 253 | !! type(array) A, B, C 254 | !! A = randu(2, 4) ! 2 dimensional array 255 | !! B = randu(3, 4) ! 2 dimensional array 256 | !! C = join(1, A, B) ! 3 dimensional array. Size: 5, 4 257 | !! @endcode 258 | interface join 259 | module procedure array_join 260 | end interface join 261 | !> @} 262 | !> @} 263 | 264 | 265 | !> @defgroup manip Reorder and sorting: (transpose, reorder, sort) 266 | !> @{ 267 | !> Functions that perform data re-ordering and sorting 268 | 269 | !> @{ 270 | !> Matrix transpose 271 | !> @param[in] A -- type array of size M x N 272 | !> @returns B of size N x M which is the matrix transpose of A 273 | !> @code 274 | !! type(array) A, B 275 | !! A = randu(20, 25) ! Random matrix 276 | !! B = transpose(A) ! Matrix transpose 277 | !! @endcode 278 | interface transpose 279 | module procedure array_transpose 280 | end interface transpose 281 | !> @} 282 | 283 | !> @{ 284 | !> Matrix hermitian transpose 285 | !> @param[in] A -- type array of size M x N 286 | !> @returns B of size N x M which is the matrix transpose of A 287 | !> @code 288 | !! type(array) Re, Im, Cplx, Cplx2, Im2 289 | !! Re = randu(5, 5) ! Random matrix, real part 290 | !! Im = randu(5, 5) ! Random matrix, imaginary part 291 | !! Cplx = complex(Re, Im) ! Create complex matrix 292 | !! Cplx2 = htranspose(Cplx) ! Hermitian transpose 293 | !! Im2 = imag(Cplx2) ! Extract imaginary part. same 294 | !! call print(sum(Im + Im2)) ! Im is equal to -Im2 295 | !! @endcode 296 | interface htranspose 297 | module procedure array_htranspose 298 | end interface htranspose 299 | !> @} 300 | 301 | !> @{ 302 | !> Matrix reorder 303 | !> @param[in] A -- type array of size M x N 304 | !> @param[in] d1 -- integer, optional. 1st output dimension corresponding to an input dimension. 305 | !> @param[in] d2 -- integer, optional. 2nd output dimension corresponding to an input dimension. 306 | !> @param[in] d3 -- integer, optional. 3rd output dimension corresponding to an input dimension. 307 | !> @param[in] d4 -- integer, optional. 4th output dimension corresponding to an input dimension. 308 | !> @returns B of size N x M which is the matrix reorder of A 309 | !> @code 310 | !! type(array) A, B 311 | !! A = randu(5, 2, 3, 4) ! Random matrix of size 5 x 2 x 3 x 4 312 | !! B = reorder(A, 4, 1, 3, 2) ! reordered matrix of size 4 x 5 x 3 x 2 313 | !! @endcode 314 | interface reorder 315 | module procedure array_reorder 316 | end interface reorder 317 | !> @} 318 | 319 | !> @{ 320 | !> Matrix sort 321 | !> @param[in] A - Matrix 322 | !> @returns B whose columns are in sorted order of A 323 | !> @code 324 | !! type(array) A, B 325 | !! A = randu(10, 10) ! Random matrix 326 | !! B = sort(A) ! sort each column 327 | !! @endcode 328 | interface sort 329 | module procedure array_sort 330 | end interface sort 331 | !> @} 332 | !> @} 333 | 334 | !> @defgroup extract Extraction: (lower, upper, real, imaginary) 335 | !> @{ 336 | !> Functions that perform data re-ordering and sorting 337 | 338 | !> @{ 339 | !> Matrix lower 340 | !> @param[in] A - Matrix 341 | !> @returns B the lower marix of A 342 | !> @code 343 | !! type(array) A, B 344 | !! A = randu(10, 10) ! Random matrix 345 | !! B = lower(A) ! Extract lower matrix of A 346 | !! @endcode 347 | interface lower 348 | module procedure array_lower 349 | end interface lower 350 | !> @} 351 | 352 | !> @{ 353 | !> Matrix upper 354 | !> @param[in] A - Matrix 355 | !> @returns B the upper marix of A 356 | !> @code 357 | !! type(array) A, B 358 | !! A = randu(10, 10) ! Random matrix 359 | !! B = upper(A) ! Extract upper matrix of A 360 | !! @endcode 361 | interface upper 362 | module procedure array_upper 363 | end interface upper 364 | !> @} 365 | 366 | !> @{ 367 | !> Matrix diag 368 | !> @param[in] A - Matrix 369 | !> @returns B the diag marix of A 370 | !> @code 371 | !! type(array) A, B 372 | !! A = randu(10, 10) ! Random matrix 373 | !! B = diag(A) ! Extract diag matrix of A 374 | !! @endcode 375 | interface diag 376 | module procedure array_diag 377 | end interface diag 378 | !> @} 379 | 380 | !> @{ 381 | !> Matrix real 382 | !> @param[in] A - Matrix 383 | !> @returns B the real marix of A 384 | !> @code 385 | !! type(array) Re, Im, Cplx, Re2, Im2 386 | !! Re = randu(10, 10) ! Random matrix, real part 387 | !! Im = randu(10, 10) ! Random matrix, imaginary part 388 | !! Cplx = complex(Re, Im) ! Create complex matrix 389 | !! Re2 = real(Cplx) ! Extract real part, Same as Re 390 | !! Im2 = imag(Cplx) ! Extract imaginary part, Same as Im 391 | !! @endcode 392 | interface real 393 | module procedure array_real 394 | end interface real 395 | !> @} 396 | 397 | !> @{ 398 | !> Matrix imag 399 | !> @param[in] A - Matrix 400 | !> @returns B the imag marix of A 401 | !> @code 402 | !! type(array) Re, Im, Cplx, Re2, Im2 403 | !! Re = randu(10, 10) ! Random matrix, real part 404 | !! Im = randu(10, 10) ! Random matrix, imaginary part 405 | !! Cplx = complex(Re, Im) ! Create complex matrix 406 | !! Re2 = real(Cplx) ! Extract real part, Same as Re 407 | !! Im2 = imag(Cplx) ! Extract imaginary part, Same as Im 408 | !! @endcode 409 | interface imag 410 | module procedure array_imag 411 | end interface imag 412 | !> @} 413 | 414 | !> @{ 415 | !> Matrix complex 416 | !> @param[in] A - Matrix 417 | !> @returns B the complex marix of A 418 | !> @code 419 | !! type(array) Re, Im, Cplx, Re2, Im2 420 | !! Re = randu(10, 10) ! Random matrix, real part 421 | !! Im = randu(10, 10) ! Random matrix, imaginary part 422 | !! Cplx = complex(Re, Im) ! Create complex matrix 423 | !! Re2 = real(Cplx) ! Extract real part, Same as Re 424 | !! Im2 = imag(Cplx) ! Extract imaginary part, Same as Im 425 | !! @endcode 426 | interface complex 427 | module procedure array_complex, array_complex2 428 | end interface complex 429 | !> @} 430 | 431 | !> @{ 432 | !> Matrix complex conjugate 433 | !> @param[in] A - Matrix (complex type) 434 | !> @returns B the complex conjugate marix of A 435 | !> @code 436 | !! type(array) Re, Im, Cplx, Conj 437 | !! Re = randu(10, 10) ! Random matrix, real part 438 | !! Im = randu(10, 10) ! Random matrix, imaginary part 439 | !! Cplx = complex(Re, Im) ! Create complex matrix 440 | !! Conj = conjg(Cplx) ! Create complex conjugate 441 | !! @endcode 442 | interface conjg 443 | module procedure array_conjg 444 | end interface conjg 445 | !> @} 446 | !> @} 447 | 448 | !> @defgroup help Helper functions (show, info, eval, sync) 449 | !> @{ 450 | !> Functions useful for debugging. 451 | 452 | !> @{ 453 | !> Displays the contens of type array 454 | !> @param[in] in -- Conents of type array 455 | !> @param[in] STR -- String to be displayed before displaying in (Optional) 456 | !> @code 457 | !! call print(randu(3,3)) 458 | !! call print(constant(1,3,3), "Matrix of all ones") 459 | !! @endcode 460 | interface print 461 | module procedure array_print 462 | end interface print 463 | !> @} 464 | 465 | !> @{ 466 | !> Displays system and arayfire information 467 | !> @code 468 | !! call device_info() 469 | !! @endcode 470 | interface device_info 471 | module procedure device_info_ 472 | end interface device_info 473 | !> @} 474 | 475 | !> @{ 476 | !> Syncs all operations on the current GPU 477 | !> @code 478 | !! call device_sync() 479 | !! @endcode 480 | interface device_sync 481 | module procedure device_sync_ 482 | end interface device_sync 483 | !> @} 484 | 485 | !> @{ 486 | !> Forces evaluation on the device 487 | !> @code 488 | !! call device_eval(A + B) 489 | !! @endcode 490 | interface device_eval 491 | module procedure device_eval_ 492 | end interface device_eval 493 | !> @} 494 | !> @} 495 | 496 | !> @defgroup gpu Multi-GPU and device handling 497 | !> @{ 498 | !> Functions useful for Multi-GPU. Requires ArrayFire Pro. 499 | 500 | !> @{ 501 | !> Get the count of gpus available 502 | !> @code 503 | !! integer count = device_count 504 | !! @endcode 505 | interface device_count 506 | module procedure device_count_ 507 | end interface device_count 508 | !> @} 509 | 510 | !> @{ 511 | !> Switch to a particular gpu 512 | !> @code 513 | !! call device_set(1) ! Switch to gpu 1 514 | !! @endcode 515 | interface device_set 516 | module procedure device_set_ 517 | end interface device_set 518 | !> @} 519 | 520 | !> @{ 521 | !> Get current gpu 522 | !> @code 523 | !! integer current = device_get() ! 0 by default 524 | !! @endcode 525 | interface device_get 526 | module procedure device_get_ 527 | end interface device_get 528 | !> @} 529 | 530 | !> @} 531 | 532 | !> @defgroup time Timing code 533 | !> @{ 534 | !> Functions useful for timing GPU code 535 | 536 | !> @{ 537 | !> Start timer 538 | !> @code 539 | !! double precision elapsed 540 | !! type(array) A, B 541 | !! A = randu(1024, 2048) 542 | !! call timer_start() 543 | !! B = matmul(A, transpose(A)) 544 | !! elapsed = timer_stop() 545 | !! @endcode 546 | interface timer_start 547 | module procedure timer_start_ 548 | end interface timer_start 549 | !> @} 550 | 551 | !> @{ 552 | !> Stop timer 553 | !> @code 554 | !! double precision elapsed 555 | !! type(array) A, B 556 | !! A = randu(1024, 2048) 557 | !! call timer_start() 558 | !! B = matmul(A, transpose(A)) 559 | !! elapsed = timer_stop() 560 | !! @endcode 561 | interface timer_stop 562 | module procedure timer_stop_ 563 | end interface timer_stop 564 | !> @} 565 | 566 | !> @} 567 | !> @} 568 | 569 | !> @defgroup op Mathematical operations 570 | !> @{ 571 | !> Arithmetic, relational, logical and other element wise operations 572 | 573 | 574 | !> @defgroup arith Arithmetic operations 575 | !> Basic arithmetic operations 576 | !> @code 577 | !! type(array) lhs, rhs, res 578 | !! real scalar 579 | !! scalar = 0.5 580 | !! lhs = constant(1,3, 3) ! All zeros 581 | !! rhs = constant(0,3, 3) ! All ones 582 | !! res = lhs + rhs ! All zeros 583 | !! res = lhs * rhs ! All ones 584 | !! res = lhs - scalar ! All 0.5 585 | !! res = lhs / scalar ! All 2.0 586 | !! @endcode 587 | !! @{ 588 | 589 | !> @{ 590 | !> Element wise addition 591 | !> @param[in] lhs -- Should be type array 592 | !> @param[in] rhs -- Can be type array, real or integer 593 | !> @returns output which contains element wise operation of lhs and rhs 594 | interface operator (+) 595 | module procedure array_plus 596 | module procedure array_plus_s, array_lplus_s 597 | module procedure array_plus_d, array_lplus_d 598 | module procedure array_plus_i, array_lplus_i 599 | end interface operator (+) 600 | !> @} 601 | 602 | !> @{ 603 | !> Element wise subtraction 604 | !> @param[in] lhs -- Should be type array 605 | !> @param[in] rhs -- Can be type array, real or integer 606 | !> @returns output which contains element wise operation of lhs and rhs 607 | interface operator (-) 608 | module procedure array_minus 609 | module procedure array_minus_s, array_lminus_s 610 | module procedure array_minus_d, array_lminus_d 611 | module procedure array_minus_i, array_lminus_i 612 | module procedure array_negate 613 | end interface operator (-) 614 | !> @} 615 | 616 | !> @{ 617 | !> Element wise multiplication 618 | !> @param[in] lhs -- Should be type array 619 | !> @param[in] rhs -- Can be type array, real or integer 620 | !> @returns output which contains element wise operation of lhs and rhs 621 | interface operator (*) 622 | module procedure array_times 623 | module procedure array_times_s, array_ltimes_s 624 | module procedure array_times_d, array_ltimes_d 625 | module procedure array_times_i, array_ltimes_i 626 | end interface operator (*) 627 | !> @} 628 | 629 | !> @{ 630 | !> Element wise division 631 | !> @param[in] lhs -- Should be type array 632 | !> @param[in] rhs -- Can be type array, real or integer 633 | !> @returns output which contains element wise operation of lhs and rhs 634 | interface operator (/) 635 | module procedure array_div 636 | module procedure array_div_s, array_ldiv_s 637 | module procedure array_div_d, array_ldiv_d 638 | module procedure array_div_i, array_ldiv_i 639 | end interface operator (/) 640 | !> @} 641 | 642 | !> @{ 643 | !> Element wise power 644 | !> @param[in] lhs -- Should be type array 645 | !> @param[in] rhs -- Should be real or integer 646 | !> @returns output which contains element wise operation of lhs and rhs 647 | interface operator (**) 648 | module procedure array_pow 649 | module procedure array_pow_s, array_pow_d, array_pow_i 650 | end interface operator (**) 651 | !> @} 652 | !> @} 653 | 654 | !> @defgroup relate Relational operations (<, >, ==, /=) 655 | !> Relational operations 656 | !> @code 657 | !! type(array) lhs, rhs, res 658 | !! real scalar 659 | !! scalar = 0.5 660 | !! lhs = constant(1,3, 3) ! All zeros 661 | !! rhs = constant(0,3, 3) ! All ones 662 | !! res = lhs < rhs ! All false 663 | !! res = lhs > rhs ! All true 664 | !! res = lhs == scalar ! All false 665 | !! res = lhs /= scalar ! All true 666 | !! @endcode 667 | !! @{ 668 | 669 | !> @{ 670 | !> Compare greater than 671 | !> @param[in] lhs -- Should be type array 672 | !> @param[in] rhs -- Can be type array or real 673 | !> @returns output which contains element wise operation of lhs and rhs 674 | interface operator (>) 675 | module procedure array_ge 676 | module procedure array_gt_s, array_lgt_s 677 | module procedure array_gt_d, array_lgt_d 678 | module procedure array_gt_i, array_lgt_i 679 | end interface operator (>) 680 | !> @} 681 | 682 | !> @{ 683 | !> Compare less than 684 | !> @param[in] lhs -- Should be type array 685 | !> @param[in] rhs -- Can be type array or real 686 | !> @returns output which contains element wise operation of lhs and rhs 687 | interface operator (<) 688 | module procedure array_le 689 | module procedure array_lt_s, array_llt_s 690 | module procedure array_lt_d, array_llt_d 691 | module procedure array_lt_i, array_llt_i 692 | end interface operator (<) 693 | !> @} 694 | 695 | !> @{ 696 | !> Compare greater than or equal to 697 | !> @param[in] lhs -- Should be type array 698 | !> @param[in] rhs -- Can be type array or real 699 | !> @returns output which contains element wise operation of lhs and rhs 700 | interface operator (>=) 701 | module procedure array_ge 702 | module procedure array_ge_s, array_lge_s 703 | module procedure array_ge_d, array_lge_d 704 | module procedure array_ge_i, array_lge_i 705 | end interface operator (>=) 706 | !> @} 707 | 708 | !> @{ 709 | !> Compare less than or equal to 710 | !> @param[in] lhs -- Should be type array 711 | !> @param[in] rhs -- Can be type array or real 712 | !> @returns output which contains element wise operation of lhs and rhs 713 | interface operator (<=) 714 | module procedure array_le 715 | module procedure array_le_s, array_lle_s 716 | module procedure array_le_d, array_lle_d 717 | module procedure array_le_i, array_lle_i 718 | end interface operator (<=) 719 | !> @} 720 | 721 | !> @{ 722 | !> Compare equal to 723 | !> @param[in] lhs -- Should be type array 724 | !> @param[in] rhs -- Can be type array or real 725 | !> @returns output which contains element wise operation of lhs and rhs 726 | interface operator (==) 727 | module procedure array_eq 728 | module procedure array_eq_s, array_leq_s 729 | module procedure array_eq_d, array_leq_d 730 | module procedure array_eq_i, array_leq_i 731 | end interface operator (==) 732 | !> @} 733 | 734 | !> @{ 735 | !> Compare not equal to 736 | !> @param[in] lhs -- Should be type array 737 | !> @param[in] rhs -- Can be type array or real 738 | !> @returns output which contains element wise operation of lhs and rhs 739 | interface operator (/=) 740 | module procedure array_ne 741 | module procedure array_ne_s, array_lne_s 742 | module procedure array_ne_d, array_lne_d 743 | module procedure array_ne_i, array_lne_i 744 | end interface operator (/=) 745 | !> @} 746 | !> @} 747 | 748 | !> @defgroup logic Logical operations (.and., .or., .not.) 749 | !> Relational operations 750 | !> @code 751 | !! type(array) lhs, rhs, res 752 | !! real scalar 753 | !! scalar = 0.5 754 | !! lhs = randu(3, 3) 755 | !! rhs = randu(3, 3) 756 | !! res = lhs < rhs .and. lhs == 0.5 757 | !! res = rhs > 0.3 .or. rhs <= 0.25 758 | !! @endcode 759 | !! @{ 760 | 761 | !> @{ 762 | !> Logical AND operator 763 | !> @param[in] lhs -- Should be type array 764 | !> @param[in] rhs -- should be type array 765 | !> @returns output which contains element wise operation of lhs and rhs 766 | interface operator (.and.) 767 | module procedure array_and 768 | end interface operator (.and.) 769 | !> @} 770 | 771 | !> @{ 772 | !> Logical OR operator 773 | !> @param[in] lhs -- Should be type array 774 | !> @param[in] rhs -- should be type array 775 | !> @returns output which contains element wise operation of lhs and rhs 776 | interface operator (.or.) 777 | module procedure array_or 778 | end interface operator (.or.) 779 | !> @} 780 | 781 | !> @{ 782 | !> Logical NOT operator 783 | !> @param[in] lhs -- Should be type array 784 | !> @param[in] rhs -- should be type array 785 | !> @returns output which contains element wise operation of lhs and rhs 786 | interface operator (.not.) 787 | module procedure array_not 788 | end interface operator (.not.) 789 | !> @} 790 | !> @} 791 | 792 | !> @defgroup elem Element wise functions (sin, cos, exp, log ..) 793 | !> @code 794 | !! type(array) in, out 795 | !! in = randu(3, 3) ! Random matrix 796 | !! out = sin(in) ! similarily cos(in), tan(in) 797 | !! out = exp(in) ! similarily log(in) 798 | !! out = abs(in - 0.5) ! absolute values 799 | !! @endcode 800 | !! @{ 801 | 802 | !> @{ 803 | !> sine of an array 804 | !> @param[in] in -- Should be type array 805 | !> @returns output which performs the function element wise 806 | interface sin 807 | module procedure array_sin 808 | end interface sin 809 | !> @} 810 | 811 | !> @{ 812 | !> co-sine of an array 813 | !> @param[in] in -- Should be type array 814 | !> @returns output which performs the function element wise 815 | interface cos 816 | module procedure array_cos 817 | end interface cos 818 | !> @} 819 | 820 | !> @{ 821 | !> tangent of an array 822 | interface tan 823 | module procedure array_tan 824 | end interface tan 825 | !> @} 826 | 827 | !> @{ 828 | !> logarithm of an array 829 | !> @param[in] in -- Should be type array 830 | !> @returns output which performs the function element wise 831 | interface log 832 | module procedure array_log 833 | end interface log 834 | !> @} 835 | 836 | !> @{ 837 | !> exponential of an array 838 | !> @param[in] in -- Should be type array 839 | !> @returns output which performs the function element wise 840 | interface exp 841 | module procedure array_exp 842 | end interface exp 843 | !> @} 844 | 845 | !> @{ 846 | !> absolute of an array 847 | !> @param[in] in -- Should be type array 848 | !> @returns output which performs the function element wise 849 | interface abs 850 | module procedure array_abs 851 | end interface abs 852 | !> @} 853 | 854 | !> @} 855 | !> @} 856 | 857 | 858 | !> @defgroup alg Linear Algebra 859 | !> @{ 860 | !> Linear Algebra routines 861 | 862 | !> @defgroup blas Basic linear algebra (Matrix multiply and dot product) 863 | !! @{ 864 | !> Matrix multiply, inner and outer products 865 | 866 | !> @{ 867 | !> Matrix multiply 868 | !> @param[in] A -- type array of size M x K 869 | !> @param[in] B -- type array of size K x N 870 | !> @returns C of size M x N which is the matrix product of A, B 871 | !> @code 872 | !! type(array) A, B, C 873 | !! A = randu(20, 25) ! Random matrix 874 | !! B = randu(25, 10) ! Random matrix 875 | !! C = matmul(A, B) ! Matrix multiply 876 | !! @endcode 877 | interface matmul 878 | module procedure array_matmul 879 | end interface matmul 880 | !> @} 881 | 882 | !> @} 883 | 884 | 885 | !> @defgroup dla Factorization: lu, qr, cholesky, singular values 886 | !> @{ 887 | !> Dense linear algebra: Factorization routines 888 | 889 | !> @{ 890 | !> LU decomposition 891 | !> Double-precision or complex input requires ArrayFire Pro. 892 | !> (Double and 893 | !> @param[out] L -- Optional (Contains lower triangular matrix on exit) 894 | !> @param[out] U -- Optional (Contains upper triangular matrix on exit) 895 | !> @param[out] p -- Optional (Contains permutation matrix on exit, such that L * U = A * p) 896 | !> @param[in] A - Input matrix. (Contains packed LU matrices, if performed in place) 897 | !> @code 898 | !! type(array) A, B 899 | !! type(array) L, U, p 900 | !! A = randu(5,5) ! Generate random matrix 901 | !! B = A ! Make a copy of A 902 | !! call lu(L, U, p, A) ! Out of place LU Decomposition 903 | !! call lu(B) ! In place decomposition 904 | !! !B now has L below the diagonal and U above the diagonal 905 | !! @endcode 906 | interface lu 907 | module procedure array_lu, array_lu_inplace 908 | end interface lu 909 | !> @} 910 | 911 | !> @{ 912 | !> Cholesky decomposition 913 | !> Double-precision or complex input requires ArrayFire Pro. 914 | !> (Double and 915 | !> @param[out] R -- Optional (Contains lower triangular matrix on exit, such that A = R*transpose(R)) 916 | !> @param[in] A - Input matrix. (Contains R in the lower triangle, if performed in place) 917 | !> @code 918 | !! type(array) A, B 919 | !! type(array) R 920 | !! A = randu(5,5) ! Generate random matrix 921 | !! B = A ! Make a copy of A 922 | !! call cholesky(R, A) ! Out of place cholesky Decomposition 923 | !! call cholesky(B) ! In place decomposition 924 | !! !B now has R below the diagonal 925 | !! @endcode 926 | interface cholesky 927 | module procedure array_cholesky, array_cholesky_inplace 928 | end interface cholesky 929 | !> @} 930 | 931 | !> @{ 932 | !> QR decomposition 933 | !> Double-precision or complex input requires ArrayFire Pro. 934 | !> (Double and 935 | !> @param[out] Q -- Contains the orthogonal basis of input matrix 936 | !> @param[out] R -- Contains a upper upper trianular matrix such that A = Q * R 937 | !> @param[in] A -- Input matrix. 938 | !> @code 939 | !! type(array) A 940 | !! type(array) Q, R 941 | !! A = randu(5,5) ! Generate random matrix 942 | !! call qr(Q, R, A) 943 | !! @endcode 944 | interface qr 945 | module procedure array_qr 946 | end interface qr 947 | !> @} 948 | 949 | !> @{ 950 | !> singular value decomposition 951 | !> This function requires ArrayFire Pro. 952 | !> @param[out] S -- Contains the singular values of input 953 | !> @param[out] U -- Contains the left unitary matrix 954 | !> @param[out] V -- Contains the right unitary matrix 955 | !> @param[in] A -- Input matrix. 956 | !> @code 957 | !! type(array) A 958 | !! type(array) S, V, U 959 | !! A = randu(5,5) ! Generate random matrix 960 | !! call singular(S, U, V, A) 961 | !! @endcode 962 | interface singular 963 | module procedure array_singular 964 | end interface singular 965 | !> @} 966 | !> @} 967 | 968 | !> @defgroup solve Solving linear systems 969 | !> @{ 970 | !> Comprehensive options for solving linear systems 971 | 972 | !> @{ 973 | !> Solve a system of equations 974 | !> Double-precision or complex input requires ArrayFire Pro. 975 | !> @param[out] R -- Contains the solution to the system of equations 976 | !> @param[in] A -- Co-efficient matrix 977 | !> @param[in] B -- Observations 978 | !> @code 979 | !! type(array) A, B, X0, X 980 | !! ! Generate random system 981 | !! A = randu(5,5) 982 | !! X0 = randu(5,1) 983 | !! B = matmul(A, X0) 984 | !! X = solve(A, B) 985 | !! @endcode 986 | interface solve 987 | module procedure array_solve 988 | end interface solve 989 | !> @} 990 | !> @} 991 | 992 | !> @defgroup linops Other Linear algebra operations: inverse, matrix power, norm, rank 993 | !> @{ 994 | !> Matrix inverse, power, norm and rank 995 | 996 | !> @{ 997 | !> inverse of a matrix 998 | !> This function requires ArrayFire Pro. 999 | !> @param[out] R -- Contains the inverse values of input 1000 | !> @param[in] A -- Input matrix. 1001 | !> @code 1002 | !! type(array) A 1003 | !! type(array) R 1004 | !! A = randu(5,5) ! Generate random matrix 1005 | !! call inverse( R, A) 1006 | !! @endcode 1007 | interface inverse 1008 | module procedure array_inverse 1009 | end interface inverse 1010 | !> @} 1011 | 1012 | !> @{ 1013 | !> Matrix norm 1014 | !> @param[in] A -- type array of size M x N 1015 | !> @returns B of size N x M which is the matrix norm of A 1016 | !> @code 1017 | !! type(array) A 1018 | !! double precision :: res 1019 | !! real :: p = 1.5 1020 | !! A = randu(10,10) ! Random matrix 1021 | !! res = norm(A) ! 2-norm 1022 | !! res = norm(A, p) ! p-norm 1023 | !! @endcode 1024 | interface norm 1025 | module procedure array_norm, array_pnorm 1026 | end interface norm 1027 | !> @} 1028 | !> @} 1029 | !> @} 1030 | 1031 | !> @defgroup data Data Analysis 1032 | !> Routines useful for data analysis 1033 | !> @{ 1034 | 1035 | !> @defgroup sumprod Sum and product 1036 | !> Sum and product of elements in the array 1037 | !> @code 1038 | !! type(array) A, sm, pr 1039 | !! ! Generate random system 1040 | !! A = randu(5,5) 1041 | !! sm = sum(A) ! Get sum of elements along columns (default). Same as sum(A,1) 1042 | !! pr = mul(A, 2) ! Get multiplication of elements along rows 1043 | !! @endcode 1044 | !! @{ 1045 | 1046 | !> @{ 1047 | !> Sum of elements in an array, along a given dimension 1048 | !> @param[in] A -- Input matrix 1049 | !> @param[in] dim -- Integer (dimension of the operation). Optional. Default: 1 1050 | !> @returns R -- Sum of the input 1051 | interface sum 1052 | module procedure array_sum 1053 | end interface sum 1054 | !> @} 1055 | 1056 | !> @{ 1057 | !> Product of elements in an array, along a given dimension 1058 | !> @param[in] A -- Input matrix 1059 | !> @param[in] dim -- Integer (dimension of the operation). Optional. Default: 1 1060 | !> @returns R -- Product of input 1061 | interface product 1062 | module procedure array_product 1063 | end interface product 1064 | !> @} 1065 | !> @} 1066 | 1067 | !> @defgroup minmax Minimum and Maximum 1068 | !> Minimum and maximum values of elements in the array 1069 | !> @code 1070 | !! type(array) A, mn, mx 1071 | !! ! Generate random system 1072 | !! A = randu(5,5) 1073 | !! mx = max(A) ! Get maximum of elements along columns (default). Same as max(A,1) 1074 | !! mn = min(A, 2) ! Get minimum of elements along rows 1075 | !! @endcode 1076 | !! @{ 1077 | 1078 | !> @{ 1079 | !> Minimum of elements in an array, along a given dimension 1080 | !> @param[in] A -- Input matrix 1081 | !> @param[in] dim -- Integer (dimension of the operation). Optional. Default: 1 1082 | !> @returns R -- Minimum value of input 1083 | interface min 1084 | module procedure array_min 1085 | end interface min 1086 | !> @} 1087 | 1088 | !> @{ 1089 | !> Maximum of elements in an array, along a given dimension 1090 | !> @param[in] A -- Input matrix 1091 | !> @param[in] dim -- Integer (dimension of the operation). Optional. Default: 1 1092 | !> @returns R -- Maximum value of input 1093 | interface max 1094 | module procedure array_max 1095 | end interface max 1096 | !> @} 1097 | !> @} 1098 | 1099 | !> @defgroup anyall Test if any / all true 1100 | !> Test if any / all elements in the array are true 1101 | !> @code 1102 | !! type(array) A, an, al 1103 | !! ! Generate random system 1104 | !! A = randu(5,5) 1105 | !! an = anytrue(A >= 1.0) ! Check if any elment is greater than 1.0 1106 | !! al = alltrue(A >= 0.0) ! Check if all elements are greater than 0.0 1107 | !! @endcode 1108 | !! @{ 1109 | 1110 | !> @{ 1111 | !> Find if any element in an array is true, along a given dimension 1112 | !> @param[in] A -- Input matrix 1113 | !> @param[in] dim -- Integer (dimension of the operation). Optional. Default: 1 1114 | !> @returns R -- true if anything in input is true, else false 1115 | interface anytrue 1116 | module procedure array_anytrue 1117 | end interface anytrue 1118 | !> @} 1119 | 1120 | !> @{ 1121 | !> Find if all elements in an array are true, along a given dimension 1122 | !> @param[in] A -- Input matrix 1123 | !> @param[in] dim -- Integer (dimension of the operation). Optional. Default: 1 1124 | !> @returns R -- true if everything in input is true, else false 1125 | interface alltrue 1126 | module procedure array_alltrue 1127 | end interface alltrue 1128 | !> @} 1129 | !> @} 1130 | 1131 | !> @defgroup stat Statistical functions: mean, median, standard deviation, variance 1132 | !> Helpful statistical functions 1133 | !> @code 1134 | !! type(array) A, mn, vr 1135 | !! ! Generate random system 1136 | !! A = randu(5,5) 1137 | !! an = mean(A) ! Get the mean of A 1138 | !! al = var(A) ! Get the variance of A 1139 | !! @endcode 1140 | !! @{ 1141 | 1142 | !> @{ 1143 | !> Mean of elements in an array, along a given dimension 1144 | !> @param[in] A -- Input matrix 1145 | !> @param[in] dim -- Integer (dimension of the operation). Optional. Default: 1 1146 | !> @returns R -- Mean value of input 1147 | interface mean 1148 | module procedure array_mean 1149 | end interface mean 1150 | !> @} 1151 | 1152 | !> @{ 1153 | !> Standard deviation of elements in an array, along a given dimension 1154 | !> @param[in] A -- Input matrix 1155 | !> @param[in] dim -- Integer (dimension of the operation). Optional. Default: 1 1156 | !> @returns R -- Standard deviation of input 1157 | interface std 1158 | module procedure array_std 1159 | end interface std 1160 | !> @} 1161 | 1162 | !> @{ 1163 | !> Variance of elements in an array, along a given dimension 1164 | !> @param[in] A -- Input matrix 1165 | !> @param[in] dim -- Integer (dimension of the operation). Optional. Default: 1 1166 | !> @returns R -- Variance of input 1167 | interface var 1168 | module procedure array_var 1169 | end interface var 1170 | !> @} 1171 | 1172 | !> @} 1173 | !> @} 1174 | 1175 | contains 1176 | 1177 | function elements(A) result(num) 1178 | type(array), intent(in) :: A 1179 | integer :: num 1180 | num = product(A%shape) 1181 | end function elements 1182 | 1183 | function safeidx(d) result(idx) 1184 | integer, dimension(:), intent(in) :: d 1185 | integer, dimension(3) :: idx 1186 | integer, allocatable, dimension(:) :: S 1187 | integer :: f 1188 | integer :: l 1189 | integer :: st 1190 | 1191 | S = shape(d) 1192 | 1193 | if (S(1) == 1) then 1194 | f = d(1) 1195 | l = d(1) 1196 | st = 1 1197 | end if 1198 | 1199 | if (S(1) == 2) then 1200 | f = d(1) 1201 | l = d(2) 1202 | st = 1 1203 | end if 1204 | 1205 | if (S(1) == 3) then 1206 | f = d(1) 1207 | l = d(2) 1208 | st = d(3) 1209 | end if 1210 | 1211 | idx = [f-1, l-1, st] 1212 | 1213 | end function safeidx 1214 | 1215 | subroutine init_1d(A, S) 1216 | type(array), intent(inout) :: A 1217 | integer, intent(in) :: S(1) 1218 | A%shape(1) = S(1) 1219 | A%shape(2) = 1 1220 | A%shape(3) = 1 1221 | A%shape(4) = 1 1222 | A%rank = 1 1223 | end subroutine init_1d 1224 | 1225 | subroutine init_2d(A, S) 1226 | type(array), intent(inout) :: A 1227 | integer, intent(in) :: S(2) 1228 | A%shape(1) = S(1) 1229 | A%shape(2) = S(2) 1230 | A%shape(3) = 1 1231 | A%shape(4) = 1 1232 | A%rank = 2 1233 | end subroutine init_2d 1234 | 1235 | subroutine init_3d(A, S) 1236 | type(array), intent(inout) :: A 1237 | integer, intent(in) :: S(3) 1238 | A%shape(1) = S(1) 1239 | A%shape(2) = S(2) 1240 | A%shape(3) = S(3) 1241 | A%shape(4) = 1 1242 | A%rank = 3 1243 | end subroutine init_3d 1244 | 1245 | subroutine init_4d(A, S) 1246 | type(array), intent(inout) :: A 1247 | integer, intent(in) :: S(4) 1248 | A%shape(1) = S(1) 1249 | A%shape(2) = S(2) 1250 | A%shape(4) = S(3) 1251 | A%shape(4) = S(4) 1252 | A%rank = 4 1253 | end subroutine init_4d 1254 | 1255 | subroutine init_eq(L, R) 1256 | type(array), intent(inout) :: L 1257 | type(array), intent(in) :: R 1258 | L%rank = R%rank 1259 | L%shape = R%shape 1260 | end subroutine init_eq 1261 | 1262 | function idx_scalar(scalar) result(R) 1263 | integer, intent(in) :: scalar 1264 | type(array) :: R 1265 | integer :: S(1) 1266 | S = [1] 1267 | call init_1d(R, S) 1268 | call af_idx_seq(R%ptr, scalar, scalar, 1, err) 1269 | end function idx_scalar 1270 | 1271 | function idx_vector(indices) result(R) 1272 | integer, intent(in) :: indices(:) 1273 | type(array) :: R 1274 | call init_1d(R, shape(indices)) 1275 | call af_idx_vec(R%ptr, indices, elements(R), err) 1276 | end function idx_vector 1277 | 1278 | function arr_seq(first, last, step) result(R) 1279 | integer, intent(in), optional :: first 1280 | integer, intent(in), optional :: last 1281 | integer, intent(in), optional :: step 1282 | integer :: f, l, s 1283 | type(array) :: R 1284 | f = 0 1285 | l = 0 1286 | s = 1 1287 | 1288 | if (present(first)) f = first 1289 | if (present(last )) l = last 1290 | if (present(step )) s = step 1291 | 1292 | call af_idx_seq(R%ptr, f, l, s, err) 1293 | call init_post(R%ptr, R%shape, R%rank) 1294 | 1295 | end function arr_seq 1296 | 1297 | function array_get(in, d1, d2, d3, d4) result(R) 1298 | type(array), intent(in) :: in 1299 | type(array), intent(in) :: d1 1300 | type(array), intent(in), optional :: d2 1301 | integer, dimension(:), intent(in), optional :: d3 1302 | integer, dimension(:), intent(in), optional :: d4 1303 | integer :: dims 1304 | 1305 | type(array) :: R 1306 | type(C_ptr) :: idx1 = C_NULL_ptr 1307 | type(C_ptr) :: idx2 = C_NULL_ptr 1308 | integer, dimension(3) :: idx3 1309 | integer, dimension(3) :: idx4 1310 | 1311 | idx1 = d1%ptr 1312 | dims = 1 1313 | 1314 | if (present(d2)) then 1315 | idx2 = d2%ptr 1316 | dims = 2 1317 | end if 1318 | 1319 | if (present(d3)) then 1320 | idx3 = safeidx(d3) 1321 | dims = 3 1322 | end if 1323 | 1324 | if (present(d4)) then 1325 | idx4 = safeidx(d4) 1326 | dims = 4 1327 | end if 1328 | 1329 | call af_arr_get(R%ptr, in%ptr, idx1, idx2, idx3, idx4, dims, err) 1330 | call init_post(R%ptr, R%shape, R%rank) 1331 | 1332 | end function array_get 1333 | 1334 | function array_get2(in, d1, d2, d3) result(R) 1335 | type(array), intent(in) :: in 1336 | type(array), intent(in) :: d1 1337 | integer, dimension(:), intent(in) :: d2 1338 | integer, dimension(:), intent(in), optional :: d3 1339 | integer :: dims 1340 | 1341 | type(array) :: R 1342 | type(C_ptr) :: idx1 = C_NULL_ptr 1343 | integer, dimension(3) :: idx2 1344 | integer, dimension(3) :: idx3 1345 | 1346 | idx1 = d1%ptr 1347 | idx2 = safeidx(d2) 1348 | dims = 2 1349 | 1350 | if (present(d3)) then 1351 | idx3 = safeidx(d3) 1352 | dims = 3 1353 | end if 1354 | 1355 | call af_arr_get2(R%ptr, in%ptr, idx1, idx2, idx3, dims, err) 1356 | call init_post(R%ptr, R%shape, R%rank) 1357 | 1358 | end function array_get2 1359 | 1360 | function array_get_seq(in, d1, d2, d3, d4) result(R) 1361 | type(array), intent(in) :: in 1362 | integer, intent(in) :: d1(:) 1363 | integer, intent(in), optional :: d2(:) 1364 | integer, intent(in), optional :: d3(:) 1365 | integer, intent(in), optional :: d4(:) 1366 | type(array) :: R 1367 | 1368 | integer, dimension(3) :: idx1 1369 | integer, dimension(3) :: idx2 1370 | integer, dimension(3) :: idx3 1371 | integer, dimension(3) :: idx4 1372 | integer :: dims = 1 1373 | 1374 | idx1 = safeidx(d1) 1375 | idx2 = safeidx(d1) 1376 | idx3 = safeidx(d1) 1377 | idx4 = safeidx(d1) 1378 | 1379 | if (present(d2)) then 1380 | idx2 = safeidx(d2) 1381 | dims = 2 1382 | end if 1383 | 1384 | if (present(d3)) then 1385 | idx3 = safeidx(d3) 1386 | dims = 3 1387 | end if 1388 | 1389 | if (present(d4)) then 1390 | idx4 = safeidx(d4) 1391 | dims = 4 1392 | end if 1393 | 1394 | call af_arr_get_seq(R%ptr, in%ptr, idx1, idx2, idx3, idx4, dims, err) 1395 | call init_post(R%ptr, R%shape, R%rank) 1396 | end function array_get_seq 1397 | 1398 | subroutine array_set(lhs, rhs, d1, d2, d3, d4) 1399 | type(array), intent(in) :: lhs 1400 | type(array), intent(inout) :: rhs 1401 | type(array), intent(in) :: d1 1402 | type(array), intent(in), optional :: d2 1403 | integer, dimension(:), intent(in), optional :: d3 1404 | integer, dimension(:), intent(in), optional :: d4 1405 | 1406 | type(C_ptr) :: idx1 = C_NULL_ptr 1407 | type(C_ptr) :: idx2 = C_NULL_ptr 1408 | integer, dimension(3) :: idx3 1409 | integer, dimension(3) :: idx4 1410 | integer :: dims 1411 | 1412 | idx1 = d1%ptr 1413 | dims = 1 1414 | 1415 | if (present(d2)) then 1416 | idx2 = d2%ptr 1417 | dims = 2 1418 | end if 1419 | 1420 | if (present(d3)) then 1421 | idx3 = safeidx(d3) 1422 | dims = 3 1423 | end if 1424 | 1425 | if (present(d4)) then 1426 | idx4 = safeidx(d4) 1427 | dims = 4 1428 | end if 1429 | 1430 | call af_arr_set(lhs%ptr, rhs%ptr, idx1, idx2, idx3, idx4, dims, err) 1431 | end subroutine array_set 1432 | 1433 | subroutine array_set2(lhs, rhs, d1, d2, d3) 1434 | type(array), intent(in) :: lhs 1435 | type(array), intent(inout) :: rhs 1436 | type(array), intent(in) :: d1 1437 | integer, dimension(:), intent(in) :: d2 1438 | integer, dimension(:), intent(in), optional :: d3 1439 | 1440 | type(C_ptr) :: idx1 = C_NULL_ptr 1441 | integer, dimension(3) :: idx2 1442 | integer, dimension(3) :: idx3 1443 | integer :: dims 1444 | 1445 | idx1 = d1%ptr 1446 | idx2 = safeidx(d2) 1447 | dims = 2 1448 | 1449 | if (present(d3)) then 1450 | idx3 = safeidx(d3) 1451 | dims = 3 1452 | end if 1453 | 1454 | call af_arr_set2(lhs%ptr, rhs%ptr, idx1, idx2, idx3, dims, err) 1455 | end subroutine array_set2 1456 | 1457 | subroutine array_set_seq(R, in, d1, d2, d3, d4) 1458 | type(array), intent(in) :: in 1459 | integer, intent(in) :: d1(:) 1460 | integer, intent(in), optional :: d2(:) 1461 | integer, intent(in), optional :: d3(:) 1462 | integer, intent(in), optional :: d4(:) 1463 | type(array), intent(inout) :: R 1464 | 1465 | integer, dimension(3) :: idx1 1466 | integer, dimension(3) :: idx2 1467 | integer, dimension(3) :: idx3 1468 | integer, dimension(3) :: idx4 1469 | integer :: dims = 1 1470 | 1471 | idx1 = safeidx(d1) 1472 | idx2 = safeidx(d1) 1473 | idx3 = safeidx(d1) 1474 | idx4 = safeidx(d1) 1475 | 1476 | if (present(d2)) then 1477 | idx2 = safeidx(d2) 1478 | dims = 2 1479 | end if 1480 | 1481 | if (present(d3)) then 1482 | idx3 = safeidx(d3) 1483 | dims = 3 1484 | end if 1485 | 1486 | if (present(d4)) then 1487 | idx4 = safeidx(d4) 1488 | dims = 4 1489 | end if 1490 | 1491 | call af_arr_set_seq(R%ptr, in%ptr, idx1, idx2, idx3, idx4, dims, err) 1492 | call init_post(R%ptr, R%shape, R%rank) 1493 | end subroutine array_set_seq 1494 | 1495 | !> Assigns data to array 1496 | subroutine assign(L, R) 1497 | type(array), intent(inout) :: L 1498 | type(array), intent(in) :: R 1499 | call init_eq(L, R) 1500 | call af_arr_copy(L%ptr, R%ptr, err) 1501 | end subroutine assign 1502 | 1503 | !> Assigns data to array 1504 | subroutine device1_s(A, B) 1505 | type(array), intent(inout) :: A 1506 | real, intent(in) :: B(:) 1507 | call init_1d(A, shape(B)) 1508 | call af_arr_device_s(A%ptr, B, A%shape, err) 1509 | end subroutine device1_s 1510 | 1511 | !> Assigns data to array 1512 | subroutine device1_d(A, B) 1513 | type(array), intent(inout) :: A 1514 | double precision, intent(in) :: B(:) 1515 | call init_1d(A, shape(B)) 1516 | call af_arr_device_d(A%ptr, B, A%shape, err) 1517 | end subroutine device1_d 1518 | 1519 | !> Assigns data to array 1520 | subroutine device1_c(A, B) 1521 | type(array), intent(inout) :: A 1522 | complex, intent(in) :: B(:) 1523 | call init_1d(A, shape(B)) 1524 | call af_arr_device_c(A%ptr, B, A%shape, err) 1525 | end subroutine device1_c 1526 | 1527 | !> Assigns data to array 1528 | subroutine device1_z(A, B) 1529 | type(array), intent(inout) :: A 1530 | double complex, intent(in) :: B(:) 1531 | call init_1d(A, shape(B)) 1532 | call af_arr_device_z(A%ptr, B, A%shape, err) 1533 | end subroutine device1_z 1534 | 1535 | !> Assigns data to array 1536 | subroutine device2_s(A, B) 1537 | type(array), intent(inout) :: A 1538 | real, intent(in) :: B(:,:) 1539 | call init_2d(A, shape(B)) 1540 | call af_arr_device_s(A%ptr, B, A%shape, err) 1541 | end subroutine device2_s 1542 | 1543 | !> Assigns data to array 1544 | subroutine device2_d(A, B) 1545 | type(array), intent(inout) :: A 1546 | double precision, intent(in) :: B(:,:) 1547 | call init_2d(A, shape(B)) 1548 | call af_arr_device_d(A%ptr, B, A%shape, err) 1549 | end subroutine device2_d 1550 | 1551 | !> Assigns data to array 1552 | subroutine device2_c(A, B) 1553 | type(array), intent(inout) :: A 1554 | complex, intent(in) :: B(:,:) 1555 | call init_2d(A, shape(B)) 1556 | call af_arr_device_c(A%ptr, B, A%shape, err) 1557 | end subroutine device2_c 1558 | 1559 | !> Assigns data to array 1560 | subroutine device2_z(A, B) 1561 | type(array), intent(inout) :: A 1562 | double complex, intent(in) :: B(:,:) 1563 | call init_2d(A, shape(B)) 1564 | call af_arr_device_z(A%ptr, B, A%shape, err) 1565 | end subroutine device2_z 1566 | 1567 | !> Assigns data to array 1568 | subroutine device3_s(A, B) 1569 | type(array), intent(inout) :: A 1570 | real, intent(in) :: B(:,:,:) 1571 | call init_3d(A, shape(B)) 1572 | call af_arr_device_s(A%ptr, B, A%shape, err) 1573 | end subroutine device3_s 1574 | 1575 | !> Assigns data to array 1576 | subroutine device3_d(A, B) 1577 | type(array), intent(inout) :: A 1578 | double precision, intent(in) :: B(:,:,:) 1579 | call init_3d(A, shape(B)) 1580 | call af_arr_device_d(A%ptr, B, A%shape, err) 1581 | end subroutine device3_d 1582 | 1583 | !> Assigns data to array 1584 | subroutine device3_c(A, B) 1585 | type(array), intent(inout) :: A 1586 | complex, intent(in) :: B(:,:,:) 1587 | call init_3d(A, shape(B)) 1588 | call af_arr_device_c(A%ptr, B, A%shape, err) 1589 | end subroutine device3_c 1590 | 1591 | !> Assigns data to array 1592 | subroutine device3_z(A, B) 1593 | type(array), intent(inout) :: A 1594 | double complex, intent(in) :: B(:,:,:) 1595 | call init_3d(A, shape(B)) 1596 | call af_arr_device_z(A%ptr, B, A%shape, err) 1597 | end subroutine device3_z 1598 | 1599 | !> Assigns data to array 1600 | subroutine device4_s(A, B) 1601 | type(array), intent(inout) :: A 1602 | real, intent(in) :: B(:,:,:,:) 1603 | call init_4d(A, shape(B)) 1604 | call af_arr_device_s(A%ptr, B, A%shape, err) 1605 | end subroutine device4_s 1606 | 1607 | !> Assigns data to array 1608 | subroutine device4_d(A, B) 1609 | type(array), intent(inout) :: A 1610 | double precision, intent(in) :: B(:,:,:,:) 1611 | call init_4d(A, shape(B)) 1612 | call af_arr_device_d(A%ptr, B, A%shape, err) 1613 | end subroutine device4_d 1614 | 1615 | !> Assigns data to array 1616 | subroutine device4_c(A, B) 1617 | type(array), intent(inout) :: A 1618 | complex, intent(in) :: B(:,:,:,:) 1619 | call init_4d(A, shape(B)) 1620 | call af_arr_device_c(A%ptr, B, A%shape, err) 1621 | end subroutine device4_c 1622 | 1623 | !> Assigns data to array 1624 | subroutine device4_z(A, B) 1625 | type(array), intent(inout) :: A 1626 | double complex, intent(in) :: B(:,:,:,:) 1627 | call init_4d(A, shape(B)) 1628 | call af_arr_device_z(A%ptr, B, A%shape, err) 1629 | end subroutine device4_z 1630 | 1631 | !> Get the array data back to host 1632 | subroutine host1_s(R, A) 1633 | type(array), intent(in) :: A 1634 | real, intent(inout), dimension(:), allocatable :: R 1635 | allocate(R(A%shape(1))) 1636 | call af_arr_host_s(R, A%ptr, 1, err) 1637 | end subroutine host1_s 1638 | 1639 | !> Get the array data back to host 1640 | subroutine host1_d(R, A) 1641 | type(array), intent(in) :: A 1642 | double precision, intent(inout), dimension(:), allocatable :: R 1643 | allocate(R(A%shape(1))) 1644 | call af_arr_host_d(R, A%ptr, 1, err) 1645 | end subroutine host1_d 1646 | 1647 | !> Get the array data back to host 1648 | subroutine host1_c(R, A) 1649 | type(array), intent(in) :: A 1650 | complex, intent(inout), dimension(:), allocatable :: R 1651 | allocate(R(A%shape(1))) 1652 | call af_arr_host_c(R, A%ptr, 1, err) 1653 | end subroutine host1_c 1654 | 1655 | !> Get the array data back to host 1656 | subroutine host1_z(R, A) 1657 | type(array), intent(in) :: A 1658 | double complex, intent(inout), dimension(:), allocatable :: R 1659 | allocate(R(A%shape(1))) 1660 | call af_arr_host_z(R, A%ptr, 1, err) 1661 | end subroutine host1_z 1662 | 1663 | !> Get the array data back to host 1664 | subroutine host2_s(R, A) 1665 | type(array), intent(in) :: A 1666 | real, intent(inout), dimension(:,:), allocatable :: R 1667 | allocate(R(A%shape(1), A%shape(2))) 1668 | call af_arr_host_s(R, A%ptr, 2, err) 1669 | end subroutine host2_s 1670 | 1671 | !> Get the array data back to host 1672 | subroutine host2_d(R, A) 1673 | type(array), intent(in) :: A 1674 | double precision, intent(inout), dimension(:,:), allocatable :: R 1675 | allocate(R(A%shape(1), A%shape(2))) 1676 | call af_arr_host_d(R, A%ptr, 2, err) 1677 | end subroutine host2_d 1678 | 1679 | !> Get the array data back to host 1680 | subroutine host2_c(R, A) 1681 | type(array), intent(in) :: A 1682 | complex, intent(inout), dimension(:,:), allocatable :: R 1683 | allocate(R(A%shape(1), A%shape(2))) 1684 | call af_arr_host_c(R, A%ptr, 2, err) 1685 | end subroutine host2_c 1686 | 1687 | !> Get the array data back to host 1688 | subroutine host2_z(R, A) 1689 | type(array), intent(in) :: A 1690 | double complex, intent(inout), dimension(:,:), allocatable :: R 1691 | allocate(R(A%shape(1), A%shape(2))) 1692 | call af_arr_host_z(R, A%ptr, 2, err) 1693 | end subroutine host2_z 1694 | 1695 | !> Get the array data back to host 1696 | subroutine host3_s(R, A) 1697 | type(array), intent(in) :: A 1698 | real, intent(inout), dimension(:,:,:), allocatable :: R 1699 | allocate(R(A%shape(1), A%shape(2), A%shape(3))) 1700 | call af_arr_host_s(R, A%ptr, 3, err) 1701 | end subroutine host3_s 1702 | 1703 | !> Get the array data back to host 1704 | subroutine host3_d(R, A) 1705 | type(array), intent(in) :: A 1706 | double precision, intent(inout), dimension(:,:,:), allocatable :: R 1707 | allocate(R(A%shape(1), A%shape(2), A%shape(3))) 1708 | call af_arr_host_d(R, A%ptr, 3, err) 1709 | end subroutine host3_d 1710 | 1711 | !> Get the array data back to host 1712 | subroutine host3_c(R, A) 1713 | type(array), intent(in) :: A 1714 | complex, intent(inout), dimension(:,:,:), allocatable :: R 1715 | allocate(R(A%shape(1), A%shape(2), A%shape(3))) 1716 | call af_arr_host_c(R, A%ptr, 3, err) 1717 | end subroutine host3_c 1718 | 1719 | !> Get the array data back to host 1720 | subroutine host3_z(R, A) 1721 | type(array), intent(in) :: A 1722 | double complex, intent(inout), dimension(:,:,:), allocatable :: R 1723 | allocate(R(A%shape(1), A%shape(2), A%shape(3))) 1724 | call af_arr_host_z(R, A%ptr, 3, err) 1725 | end subroutine host3_z 1726 | 1727 | !> Get the array data back to host 1728 | subroutine host4_s(R, A) 1729 | type(array), intent(in) :: A 1730 | real, intent(inout), dimension(:,:,:,:), allocatable :: R 1731 | allocate(R(A%shape(1), A%shape(2), A%shape(3), A%shape(4))) 1732 | call af_arr_host_s(R, A%ptr, 4, err) 1733 | end subroutine host4_s 1734 | 1735 | !> Get the array data back to host 1736 | subroutine host4_d(R, A) 1737 | type(array), intent(in) :: A 1738 | double precision, intent(inout), dimension(:,:,:,:), allocatable :: R 1739 | allocate(R(A%shape(1), A%shape(2), A%shape(3), A%shape(4))) 1740 | call af_arr_host_d(R, A%ptr, 4, err) 1741 | end subroutine host4_d 1742 | 1743 | !> Get the array data back to host 1744 | subroutine host4_c(R, A) 1745 | type(array), intent(in) :: A 1746 | complex, intent(inout), dimension(:,:,:,:), allocatable :: R 1747 | allocate(R(A%shape(1), A%shape(2), A%shape(3), A%shape(4))) 1748 | call af_arr_host_c(R, A%ptr, 4, err) 1749 | end subroutine host4_c 1750 | 1751 | !> Get the array data back to host 1752 | subroutine host4_z(R, A) 1753 | type(array), intent(in) :: A 1754 | double complex, intent(inout), dimension(:,:,:,:), allocatable :: R 1755 | allocate(R(A%shape(1), A%shape(2), A%shape(3), A%shape(4))) 1756 | call af_arr_host_z(R, A%ptr, 4, err) 1757 | end subroutine host4_z 1758 | 1759 | !> Get the array data back to hostp 1760 | subroutine hostp1_s(R, A) 1761 | type(array), intent(in) :: A 1762 | real, pointer, intent(inout), dimension(:) :: R 1763 | call af_arr_host_s(R, A%ptr, 1, err) 1764 | end subroutine hostp1_s 1765 | 1766 | !> Get the array data back to hostp 1767 | subroutine hostp1_d(R, A) 1768 | type(array), intent(in) :: A 1769 | double precision, pointer, intent(inout), dimension(:) :: R 1770 | call af_arr_host_d(R, A%ptr, 1, err) 1771 | end subroutine hostp1_d 1772 | 1773 | !> Get the array data back to hostp 1774 | subroutine hostp1_c(R, A) 1775 | type(array), intent(in) :: A 1776 | complex, pointer, intent(inout), dimension(:) :: R 1777 | call af_arr_host_c(R, A%ptr, 1, err) 1778 | end subroutine hostp1_c 1779 | 1780 | !> Get the array data back to hostp 1781 | subroutine hostp1_z(R, A) 1782 | type(array), intent(in) :: A 1783 | double complex, pointer, intent(inout), dimension(:) :: R 1784 | call af_arr_host_z(R, A%ptr, 1, err) 1785 | end subroutine hostp1_z 1786 | 1787 | !> Get the array data back to hostp 1788 | subroutine hostp2_s(R, A) 1789 | type(array), intent(in) :: A 1790 | real, pointer, intent(inout), dimension(:,:) :: R 1791 | call af_arr_host_s(R, A%ptr, 2, err) 1792 | end subroutine hostp2_s 1793 | 1794 | !> Get the array data back to hostp 1795 | subroutine hostp2_d(R, A) 1796 | type(array), intent(in) :: A 1797 | double precision, pointer, intent(inout), dimension(:,:) :: R 1798 | call af_arr_host_d(R, A%ptr, 2, err) 1799 | end subroutine hostp2_d 1800 | 1801 | !> Get the array data back to hostp 1802 | subroutine hostp2_c(R, A) 1803 | type(array), intent(in) :: A 1804 | complex, pointer, intent(inout), dimension(:,:) :: R 1805 | call af_arr_host_c(R, A%ptr, 2, err) 1806 | end subroutine hostp2_c 1807 | 1808 | !> Get the array data back to hostp 1809 | subroutine hostp2_z(R, A) 1810 | type(array), intent(in) :: A 1811 | double complex, pointer, intent(inout), dimension(:,:) :: R 1812 | call af_arr_host_z(R, A%ptr, 2, err) 1813 | end subroutine hostp2_z 1814 | 1815 | !> Get the array data back to hostp 1816 | subroutine hostp3_s(R, A) 1817 | type(array), intent(in) :: A 1818 | real, pointer, intent(inout), dimension(:,:,:) :: R 1819 | call af_arr_host_s(R, A%ptr, 3, err) 1820 | end subroutine hostp3_s 1821 | 1822 | !> Get the array data back to hostp 1823 | subroutine hostp3_d(R, A) 1824 | type(array), intent(in) :: A 1825 | double precision, pointer, intent(inout), dimension(:,:,:) :: R 1826 | call af_arr_host_d(R, A%ptr, 3, err) 1827 | end subroutine hostp3_d 1828 | 1829 | !> Get the array data back to hostp 1830 | subroutine hostp3_c(R, A) 1831 | type(array), intent(in) :: A 1832 | complex, pointer, intent(inout), dimension(:,:,:) :: R 1833 | call af_arr_host_c(R, A%ptr, 3, err) 1834 | end subroutine hostp3_c 1835 | 1836 | !> Get the array data back to hostp 1837 | subroutine hostp3_z(R, A) 1838 | type(array), intent(in) :: A 1839 | double complex, pointer, intent(inout), dimension(:,:,:) :: R 1840 | call af_arr_host_z(R, A%ptr, 3, err) 1841 | end subroutine hostp3_z 1842 | 1843 | !> Get the array data back to hostp 1844 | subroutine hostp4_s(R, A) 1845 | type(array), intent(in) :: A 1846 | real, pointer, intent(inout), dimension(:,:,:,:) :: R 1847 | call af_arr_host_s(R, A%ptr, 4, err) 1848 | end subroutine hostp4_s 1849 | 1850 | !> Get the array data back to hostp 1851 | subroutine hostp4_d(R, A) 1852 | type(array), intent(in) :: A 1853 | double precision, pointer, intent(inout), dimension(:,:,:,:) :: R 1854 | call af_arr_host_d(R, A%ptr, 4, err) 1855 | end subroutine hostp4_d 1856 | 1857 | !> Get the array data back to hostp 1858 | subroutine hostp4_c(R, A) 1859 | type(array), intent(in) :: A 1860 | complex, pointer, intent(inout), dimension(:,:,:,:) :: R 1861 | call af_arr_host_c(R, A%ptr, 4, err) 1862 | end subroutine hostp4_c 1863 | 1864 | !> Get the array data back to hostp 1865 | subroutine hostp4_z(R, A) 1866 | type(array), intent(in) :: A 1867 | double complex, pointer, intent(inout), dimension(:,:,:,:) :: R 1868 | call af_arr_host_z(R, A%ptr, 4, err) 1869 | end subroutine hostp4_z 1870 | 1871 | !> Display array, optionally with a message 1872 | subroutine array_print(A, STR) 1873 | type(array), intent(in) :: A 1874 | character(len=*), intent(in), optional :: STR 1875 | if (present(STR)) write(*,*) STR 1876 | call af_arr_print(A%ptr, err) 1877 | end subroutine array_print 1878 | 1879 | !> Moddims an input array 1880 | function array_moddims(A, x1, x2, x3, x4) result(R) 1881 | type(array), intent(in) :: A 1882 | type(array) :: R 1883 | integer, intent(in) :: x1 1884 | integer, intent(in), optional :: x2, x3, x4 1885 | 1886 | R%shape = [x1, 1, 1, 1] 1887 | R%rank = 1 1888 | if (present(x2)) then 1889 | R%shape(2) = x2 1890 | R%rank = 2 1891 | end if 1892 | if (present(x3)) then 1893 | R%shape(3) = x3 1894 | R%rank = 3 1895 | end if 1896 | if (present(x4)) then 1897 | R%shape(4) = x4 1898 | R%rank = 4 1899 | end if 1900 | 1901 | call af_arr_moddims(R%ptr, A%ptr, R%shape, err) 1902 | end function array_moddims 1903 | 1904 | !> Flat an input array 1905 | function array_flat(A) result(R) 1906 | type(array), intent(in) :: A 1907 | type(array) :: R 1908 | R%shape = [1, 1, 1, 1] 1909 | R%shape(1) = elements(A) 1910 | R%rank = 1 1911 | call af_arr_moddims(R%ptr, A%ptr, R%shape, err) 1912 | end function array_flat 1913 | 1914 | !> Tile an input array 1915 | function array_tile(A, x1, x2, x3, x4) result(R) 1916 | type(array), intent(in) :: A 1917 | type(array) :: R 1918 | integer, intent(in), optional :: x1, x2, x3, x4 1919 | 1920 | call init_eq(R, A) 1921 | 1922 | if (present(x1)) then 1923 | R%shape(1) = R%shape(1) * x1 1924 | end if 1925 | if (present(x2)) then 1926 | R%shape(2) = R%shape(2) * x2 1927 | if (x2 > 1 .and. R%rank < 2) R%rank = 2 1928 | end if 1929 | if (present(x3)) then 1930 | R%shape(3) = R%shape(3) * x3 1931 | if (x3 > 1 .and. R%rank < 3) R%rank = 3 1932 | end if 1933 | if (present(x4)) then 1934 | R%shape(4) = R%shape(4) * x4 1935 | if (x4 > 1 .and. R%rank < 4) R%rank = 4 1936 | end if 1937 | 1938 | call af_arr_tile(R%ptr, A%ptr, R%shape, err) 1939 | end function array_tile 1940 | 1941 | !> Join two arrays 1942 | function array_join(d, first, second) result(output) 1943 | type(array), intent(in) :: first 1944 | type(array), intent(in) :: second 1945 | integer, intent(in) :: d 1946 | type(array) :: output 1947 | call af_arr_join(d, output%ptr, first%ptr, second%ptr, err) 1948 | call init_post(output%ptr, output%shape, output%rank) 1949 | end function array_join 1950 | 1951 | 1952 | !> Generate uniformly distributed random matrix 1953 | function array_randu(x1, x2, x3, x4, ty) result(R) 1954 | type(array) :: R 1955 | integer, intent(in) :: x1 1956 | integer, intent(in), optional :: x2, x3, x4, ty 1957 | integer :: tt = 1 1958 | 1959 | R%shape = [x1, 1, 1, 1] 1960 | R%rank = 1 1961 | if (present(x2)) then 1962 | R%shape(2) = x2 1963 | R%rank = 2 1964 | end if 1965 | if (present(x3)) then 1966 | R%shape(3) = x3 1967 | R%rank = 3 1968 | end if 1969 | if (present(x4)) then 1970 | R%shape(4) = x4 1971 | R%rank = 4 1972 | end if 1973 | 1974 | if (present(ty)) tt = ty 1975 | 1976 | call af_arr_randu(R%ptr, R%shape, tt, err) 1977 | end function array_randu 1978 | 1979 | !> Generate normally distributed random matrix 1980 | function array_randn(x1, x2, x3, x4, ty) result(R) 1981 | type(array) :: R 1982 | integer, intent(in) :: x1 1983 | integer, intent(in), optional :: x2, x3, x4, ty 1984 | integer :: tt = 1 1985 | 1986 | R%shape = [x1, 1, 1, 1] 1987 | R%rank = 1 1988 | if (present(x2)) then 1989 | R%shape(2) = x2 1990 | R%rank = 2 1991 | end if 1992 | if (present(x3)) then 1993 | R%shape(3) = x3 1994 | R%rank = 3 1995 | end if 1996 | if (present(x4)) then 1997 | R%shape(4) = x4 1998 | R%rank = 4 1999 | end if 2000 | 2001 | if (present(ty)) tt = ty 2002 | 2003 | call af_arr_randn(R%ptr, R%shape, tt, err) 2004 | end function array_randn 2005 | 2006 | !> Generate an array of constant value 2007 | function array_constant(val, x1, x2, x3, x4, ty) result(R) 2008 | type(array) :: R 2009 | integer, intent(in) :: val 2010 | integer, intent(in) :: x1 2011 | integer, intent(in), optional :: x2, x3, x4, ty 2012 | integer :: tt = 1 2013 | 2014 | R%shape = [x1, 1, 1, 1] 2015 | R%rank = 1 2016 | if (present(x2)) then 2017 | R%shape(2) = x2 2018 | R%rank = 2 2019 | end if 2020 | if (present(x3)) then 2021 | R%shape(3) = x3 2022 | R%rank = 3 2023 | end if 2024 | if (present(x4)) then 2025 | R%shape(4) = x4 2026 | R%rank = 4 2027 | end if 2028 | 2029 | if (present(ty)) tt = ty 2030 | 2031 | call af_arr_constant(R%ptr, val, R%shape, tt, err) 2032 | end function array_constant 2033 | 2034 | !> Generate an identity matrix 2035 | function array_identity(x1, x2, ty) result(R) 2036 | type(array) :: R 2037 | integer, intent(in) :: x1, x2 2038 | integer, intent(in), optional :: ty 2039 | integer :: tt = 1 2040 | 2041 | R%shape = [x1, x2, 1, 1] 2042 | R%rank = 2 2043 | 2044 | if (present(ty)) tt = ty 2045 | 2046 | call af_arr_identity(R%ptr, R%shape, tt, err) 2047 | end function array_identity 2048 | 2049 | !> Add two array matrices 2050 | function array_plus(A, B) result(R) 2051 | type(array), intent(in) :: A 2052 | type(array), intent(in) :: B 2053 | type(array) :: R 2054 | call init_eq(R, A) 2055 | call af_arr_elplus(R%ptr, A%ptr, B%ptr, err) 2056 | end function array_plus 2057 | 2058 | !> Subtract two array matrices 2059 | function array_minus(A, B) result(R) 2060 | type(array), intent(in) :: A, B 2061 | type(array) :: R 2062 | call init_eq(R, A) 2063 | call af_arr_elminus(R%ptr, A%ptr, B%ptr, err) 2064 | end function array_minus 2065 | 2066 | !> Multiply two array matrices (element wise) 2067 | function array_times(A, B) result(R) 2068 | type(array), intent(in) :: A, B 2069 | type(array) :: R 2070 | call init_eq(R, A) 2071 | call af_arr_eltimes(R%ptr, A%ptr, B%ptr, err) 2072 | end function array_times 2073 | 2074 | !> Divide two array matrices (element wise) 2075 | function array_div(A, B) result(R) 2076 | type(array), intent(in) :: A, B 2077 | type(array) :: R 2078 | call init_eq(R, A) 2079 | call af_arr_eldiv(R%ptr, A%ptr, B%ptr, err) 2080 | end function array_div 2081 | 2082 | !> Element wise power with matrix exponent 2083 | function array_pow(A, B) result(R) 2084 | type(array), intent(in) :: A, B 2085 | type(array) :: R 2086 | call init_eq(R, A) 2087 | call af_arr_elpow(R%ptr, A%ptr, B%ptr, err) 2088 | end function array_pow 2089 | 2090 | !> Negate an array 2091 | function array_negate(A) result(R) 2092 | type(array), intent(in) :: A 2093 | type(array) :: R 2094 | call init_eq(R, A) 2095 | call af_arr_negate(R%ptr, A%ptr, err) 2096 | end function array_negate 2097 | 2098 | !> Add scalar to array 2099 | function array_plus_d(A, B) result(R) 2100 | type(array), intent(in) :: A 2101 | double precision, intent(in) :: B 2102 | type(array) :: R 2103 | call init_eq(R, A) 2104 | call af_arr_scplus(R%ptr, A%ptr, B, err) 2105 | end function array_plus_d 2106 | 2107 | !> Add array to scalar 2108 | function array_lplus_d(B, A) result(R) 2109 | type(array), intent(in) :: A 2110 | double precision, intent(in) :: B 2111 | type(array) :: R 2112 | R = A + B 2113 | end function array_lplus_d 2114 | 2115 | !> Add scalar to array 2116 | function array_plus_s(A, B) result(R) 2117 | type(array), intent(in) :: A 2118 | real, intent(in) :: B 2119 | type(array) :: R 2120 | R = A + dble(B) 2121 | end function array_plus_s 2122 | 2123 | !> Add array to scalar 2124 | function array_lplus_s(B, A) result(R) 2125 | type(array), intent(in) :: A 2126 | real, intent(in) :: B 2127 | type(array) :: R 2128 | R = A + dble(B) 2129 | end function array_lplus_s 2130 | 2131 | !> Add scalar to array 2132 | function array_plus_i(A, B) result(R) 2133 | type(array), intent(in) :: A 2134 | integer, intent(in) :: B 2135 | type(array) :: R 2136 | R = A + dble(B) 2137 | end function array_plus_i 2138 | 2139 | !> Add array to scalar 2140 | function array_lplus_i(B, A) result(R) 2141 | type(array), intent(in) :: A 2142 | integer, intent(in) :: B 2143 | type(array) :: R 2144 | R = A + dble(B) 2145 | end function array_lplus_i 2146 | 2147 | !> Add scalar to array 2148 | function array_minus_d(A, B) result(R) 2149 | type(array), intent(in) :: A 2150 | double precision, intent(in) :: B 2151 | type(array) :: R 2152 | call init_eq(R, A) 2153 | call af_arr_scminus(R%ptr, A%ptr, B, err) 2154 | end function array_minus_d 2155 | 2156 | !> Add array to scalar 2157 | function array_lminus_d(B, A) result(R) 2158 | type(array), intent(in) :: A 2159 | double precision, intent(in) :: B 2160 | type(array) :: R 2161 | R = A - B 2162 | end function array_lminus_d 2163 | 2164 | !> Add scalar to array 2165 | function array_minus_s(A, B) result(R) 2166 | type(array), intent(in) :: A 2167 | real, intent(in) :: B 2168 | type(array) :: R 2169 | R = A - dble(B) 2170 | end function array_minus_s 2171 | 2172 | !> Add array to scalar 2173 | function array_lminus_s(B, A) result(R) 2174 | type(array), intent(in) :: A 2175 | real, intent(in) :: B 2176 | type(array) :: R 2177 | R = A - dble(B) 2178 | end function array_lminus_s 2179 | 2180 | !> Add scalar to array 2181 | function array_minus_i(A, B) result(R) 2182 | type(array), intent(in) :: A 2183 | integer, intent(in) :: B 2184 | type(array) :: R 2185 | R = A - dble(B) 2186 | end function array_minus_i 2187 | 2188 | !> Add array to scalar 2189 | function array_lminus_i(B, A) result(R) 2190 | type(array), intent(in) :: A 2191 | integer, intent(in) :: B 2192 | type(array) :: R 2193 | R = A - dble(B) 2194 | end function array_lminus_i 2195 | 2196 | !> Add scalar to array 2197 | function array_times_d(A, B) result(R) 2198 | type(array), intent(in) :: A 2199 | double precision, intent(in) :: B 2200 | type(array) :: R 2201 | call init_eq(R, A) 2202 | call af_arr_sctimes(R%ptr, A%ptr, B, err) 2203 | end function array_times_d 2204 | 2205 | !> Add array to scalar 2206 | function array_ltimes_d(B, A) result(R) 2207 | type(array), intent(in) :: A 2208 | double precision, intent(in) :: B 2209 | type(array) :: R 2210 | R = A * B 2211 | end function array_ltimes_d 2212 | 2213 | !> Add scalar to array 2214 | function array_times_s(A, B) result(R) 2215 | type(array), intent(in) :: A 2216 | real, intent(in) :: B 2217 | type(array) :: R 2218 | R = A * dble(B) 2219 | end function array_times_s 2220 | 2221 | !> Add array to scalar 2222 | function array_ltimes_s(B, A) result(R) 2223 | type(array), intent(in) :: A 2224 | real, intent(in) :: B 2225 | type(array) :: R 2226 | R = A * dble(B) 2227 | end function array_ltimes_s 2228 | 2229 | !> Add scalar to array 2230 | function array_times_i(A, B) result(R) 2231 | type(array), intent(in) :: A 2232 | integer, intent(in) :: B 2233 | type(array) :: R 2234 | R = A * dble(B) 2235 | end function array_times_i 2236 | 2237 | !> Add array to scalar 2238 | function array_ltimes_i(B, A) result(R) 2239 | type(array), intent(in) :: A 2240 | integer, intent(in) :: B 2241 | type(array) :: R 2242 | R = A * dble(B) 2243 | end function array_ltimes_i 2244 | 2245 | !> Add scalar to array 2246 | function array_div_d(A, B) result(R) 2247 | type(array), intent(in) :: A 2248 | double precision, intent(in) :: B 2249 | type(array) :: R 2250 | call init_eq(R, A) 2251 | call af_arr_scdiv(R%ptr, A%ptr, B, err) 2252 | end function array_div_d 2253 | 2254 | !> Add array to scalar 2255 | function array_ldiv_d(B, A) result(R) 2256 | type(array), intent(in) :: A 2257 | double precision, intent(in) :: B 2258 | type(array) :: R 2259 | R = A / B 2260 | end function array_ldiv_d 2261 | 2262 | !> Add scalar to array 2263 | function array_div_s(A, B) result(R) 2264 | type(array), intent(in) :: A 2265 | real, intent(in) :: B 2266 | type(array) :: R 2267 | R = A / dble(B) 2268 | end function array_div_s 2269 | 2270 | !> Add array to scalar 2271 | function array_ldiv_s(B, A) result(R) 2272 | type(array), intent(in) :: A 2273 | real, intent(in) :: B 2274 | type(array) :: R 2275 | R = A / dble(B) 2276 | end function array_ldiv_s 2277 | 2278 | !> Add scalar to array 2279 | function array_div_i(A, B) result(R) 2280 | type(array), intent(in) :: A 2281 | integer, intent(in) :: B 2282 | type(array) :: R 2283 | R = A / dble(B) 2284 | end function array_div_i 2285 | 2286 | !> Add array to scalar 2287 | function array_ldiv_i(B, A) result(R) 2288 | type(array), intent(in) :: A 2289 | integer, intent(in) :: B 2290 | type(array) :: R 2291 | R = A / dble(B) 2292 | end function array_ldiv_i 2293 | 2294 | !> Element wise power with scalar exponent 2295 | function array_pow_d(A, B) result(R) 2296 | type(array), intent(in) :: A 2297 | double precision, intent(in) :: B 2298 | type(array) :: R 2299 | call init_eq(R, A) 2300 | call af_arr_scpow(R%ptr, A%ptr, B, err) 2301 | end function array_pow_d 2302 | 2303 | !> Element wise power with scalar exponent 2304 | function array_pow_s(A, B) result(R) 2305 | type(array), intent(in) :: A 2306 | real, intent(in) :: B 2307 | type(array) :: R 2308 | R = A ** dble(B) 2309 | end function array_pow_s 2310 | 2311 | !> Element wise power with scalar exponent 2312 | function array_pow_i(A, B) result(R) 2313 | type(array), intent(in) :: A 2314 | integer, intent(in) :: B 2315 | type(array) :: R 2316 | R = A ** dble(B) 2317 | end function array_pow_i 2318 | 2319 | function array_gt(A, B) result(R) 2320 | type(array), intent(in) :: A 2321 | type(array), intent(in) :: B 2322 | type(array) :: R 2323 | call init_eq(R, A) 2324 | call af_arr_elgt(R%ptr, A%ptr, B%ptr, err) 2325 | end function array_gt 2326 | 2327 | function array_ge(A, B) result(R) 2328 | type(array), intent(in) :: A 2329 | type(array), intent(in) :: B 2330 | type(array) :: R 2331 | call init_eq(R, A) 2332 | call af_arr_elge(R%ptr, A%ptr, B%ptr, err) 2333 | end function array_ge 2334 | 2335 | function array_lt(A, B) result(R) 2336 | type(array), intent(in) :: A 2337 | type(array), intent(in) :: B 2338 | type(array) :: R 2339 | call init_eq(R, A) 2340 | call af_arr_ellt(R%ptr, A%ptr, B%ptr, err) 2341 | end function array_lt 2342 | 2343 | function array_le(A, B) result(R) 2344 | type(array), intent(in) :: A 2345 | type(array), intent(in) :: B 2346 | type(array) :: R 2347 | call init_eq(R, A) 2348 | call af_arr_elle(R%ptr, A%ptr, B%ptr, err) 2349 | end function array_le 2350 | 2351 | function array_eq(A, B) result(R) 2352 | type(array), intent(in) :: A 2353 | type(array), intent(in) :: B 2354 | type(array) :: R 2355 | call init_eq(R, A) 2356 | call af_arr_eleq(R%ptr, A%ptr, B%ptr, err) 2357 | end function array_eq 2358 | 2359 | function array_ne(A, B) result(R) 2360 | type(array), intent(in) :: A 2361 | type(array), intent(in) :: B 2362 | type(array) :: R 2363 | call init_eq(R, A) 2364 | call af_arr_elne(R%ptr, A%ptr, B%ptr, err) 2365 | end function array_ne 2366 | 2367 | function array_gt_d(A, B) result(R) 2368 | type(array), intent(in) :: A 2369 | double precision, intent(in) :: B 2370 | type(array) :: R 2371 | call init_eq(R, A) 2372 | call af_arr_scgt(R%ptr, A%ptr, B, err) 2373 | end function array_gt_d 2374 | 2375 | function array_lgt_d(B, A) result(R) 2376 | type(array), intent(in) :: A 2377 | double precision, intent(in) :: B 2378 | type(array) :: R 2379 | R = A < B 2380 | end function array_lgt_d 2381 | 2382 | function array_gt_s(A, B) result(R) 2383 | type(array), intent(in) :: A 2384 | real, intent(in) :: B 2385 | type(array) :: R 2386 | call af_arr_scgt(R%ptr, A%ptr, dble(B), err) 2387 | end function array_gt_s 2388 | 2389 | function array_lgt_s(B, A) result(R) 2390 | type(array), intent(in) :: A 2391 | real, intent(in) :: B 2392 | type(array) :: R 2393 | R = A < dble(B) 2394 | end function array_lgt_s 2395 | 2396 | function array_gt_i(A, B) result(R) 2397 | type(array), intent(in) :: A 2398 | integer, intent(in) :: B 2399 | type(array) :: R 2400 | call af_arr_scgt(R%ptr, A%ptr, dble(B), err) 2401 | end function array_gt_i 2402 | 2403 | function array_lgt_i(B, A) result(R) 2404 | type(array), intent(in) :: A 2405 | integer, intent(in) :: B 2406 | type(array) :: R 2407 | R = A < dble(B) 2408 | end function array_lgt_i 2409 | 2410 | function array_lt_d(A, B) result(R) 2411 | type(array), intent(in) :: A 2412 | double precision, intent(in) :: B 2413 | type(array) :: R 2414 | call init_eq(R, A) 2415 | call af_arr_sclt(R%ptr, A%ptr, B, err) 2416 | end function array_lt_d 2417 | 2418 | function array_llt_d(B, A) result(R) 2419 | type(array), intent(in) :: A 2420 | double precision, intent(in) :: B 2421 | type(array) :: R 2422 | R = A > B 2423 | end function array_llt_d 2424 | 2425 | function array_lt_s(A, B) result(R) 2426 | type(array), intent(in) :: A 2427 | real, intent(in) :: B 2428 | type(array) :: R 2429 | call af_arr_sclt(R%ptr, A%ptr, dble(B), err) 2430 | end function array_lt_s 2431 | 2432 | function array_llt_s(B, A) result(R) 2433 | type(array), intent(in) :: A 2434 | real, intent(in) :: B 2435 | type(array) :: R 2436 | R = A > dble(B) 2437 | end function array_llt_s 2438 | 2439 | function array_lt_i(A, B) result(R) 2440 | type(array), intent(in) :: A 2441 | integer, intent(in) :: B 2442 | type(array) :: R 2443 | call af_arr_sclt(R%ptr, A%ptr, dble(B), err) 2444 | end function array_lt_i 2445 | 2446 | function array_llt_i(B, A) result(R) 2447 | type(array), intent(in) :: A 2448 | integer, intent(in) :: B 2449 | type(array) :: R 2450 | R = A > dble(B) 2451 | end function array_llt_i 2452 | 2453 | function array_ge_d(A, B) result(R) 2454 | type(array), intent(in) :: A 2455 | double precision, intent(in) :: B 2456 | type(array) :: R 2457 | call init_eq(R, A) 2458 | call af_arr_scge(R%ptr, A%ptr, B, err) 2459 | end function array_ge_d 2460 | 2461 | function array_lge_d(B, A) result(R) 2462 | type(array), intent(in) :: A 2463 | double precision, intent(in) :: B 2464 | type(array) :: R 2465 | R = A <= B 2466 | end function array_lge_d 2467 | 2468 | function array_ge_s(A, B) result(R) 2469 | type(array), intent(in) :: A 2470 | real, intent(in) :: B 2471 | type(array) :: R 2472 | call af_arr_scge(R%ptr, A%ptr, dble(B), err) 2473 | end function array_ge_s 2474 | 2475 | function array_lge_s(B, A) result(R) 2476 | type(array), intent(in) :: A 2477 | real, intent(in) :: B 2478 | type(array) :: R 2479 | R = A <= dble(B) 2480 | end function array_lge_s 2481 | 2482 | function array_ge_i(A, B) result(R) 2483 | type(array), intent(in) :: A 2484 | integer, intent(in) :: B 2485 | type(array) :: R 2486 | call af_arr_scge(R%ptr, A%ptr, dble(B), err) 2487 | end function array_ge_i 2488 | 2489 | function array_lge_i(B, A) result(R) 2490 | type(array), intent(in) :: A 2491 | integer, intent(in) :: B 2492 | type(array) :: R 2493 | R = A <= dble(B) 2494 | end function array_lge_i 2495 | 2496 | function array_le_d(A, B) result(R) 2497 | type(array), intent(in) :: A 2498 | double precision, intent(in) :: B 2499 | type(array) :: R 2500 | call init_eq(R, A) 2501 | call af_arr_scle(R%ptr, A%ptr, B, err) 2502 | end function array_le_d 2503 | 2504 | function array_lle_d(B, A) result(R) 2505 | type(array), intent(in) :: A 2506 | double precision, intent(in) :: B 2507 | type(array) :: R 2508 | R = A >= B 2509 | end function array_lle_d 2510 | 2511 | function array_le_s(A, B) result(R) 2512 | type(array), intent(in) :: A 2513 | real, intent(in) :: B 2514 | type(array) :: R 2515 | call af_arr_scle(R%ptr, A%ptr, dble(B), err) 2516 | end function array_le_s 2517 | 2518 | function array_lle_s(B, A) result(R) 2519 | type(array), intent(in) :: A 2520 | real, intent(in) :: B 2521 | type(array) :: R 2522 | R = A >= dble(B) 2523 | end function array_lle_s 2524 | 2525 | function array_le_i(A, B) result(R) 2526 | type(array), intent(in) :: A 2527 | integer, intent(in) :: B 2528 | type(array) :: R 2529 | call af_arr_scle(R%ptr, A%ptr, dble(B), err) 2530 | end function array_le_i 2531 | 2532 | function array_lle_i(B, A) result(R) 2533 | type(array), intent(in) :: A 2534 | integer, intent(in) :: B 2535 | type(array) :: R 2536 | R = A >= dble(B) 2537 | end function array_lle_i 2538 | 2539 | function array_eq_d(A, B) result(R) 2540 | type(array), intent(in) :: A 2541 | double precision, intent(in) :: B 2542 | type(array) :: R 2543 | call init_eq(R, A) 2544 | call af_arr_sceq(R%ptr, A%ptr, B, err) 2545 | end function array_eq_d 2546 | 2547 | function array_leq_d(B, A) result(R) 2548 | type(array), intent(in) :: A 2549 | double precision, intent(in) :: B 2550 | type(array) :: R 2551 | R = A == B 2552 | end function array_leq_d 2553 | 2554 | function array_eq_s(A, B) result(R) 2555 | type(array), intent(in) :: A 2556 | real, intent(in) :: B 2557 | type(array) :: R 2558 | call af_arr_sceq(R%ptr, A%ptr, dble(B), err) 2559 | end function array_eq_s 2560 | 2561 | function array_leq_s(B, A) result(R) 2562 | type(array), intent(in) :: A 2563 | real, intent(in) :: B 2564 | type(array) :: R 2565 | R = A == dble(B) 2566 | end function array_leq_s 2567 | 2568 | function array_eq_i(A, B) result(R) 2569 | type(array), intent(in) :: A 2570 | integer, intent(in) :: B 2571 | type(array) :: R 2572 | call af_arr_sceq(R%ptr, A%ptr, dble(B), err) 2573 | end function array_eq_i 2574 | 2575 | function array_leq_i(B, A) result(R) 2576 | type(array), intent(in) :: A 2577 | integer, intent(in) :: B 2578 | type(array) :: R 2579 | R = A == dble(B) 2580 | end function array_leq_i 2581 | 2582 | function array_ne_d(A, B) result(R) 2583 | type(array), intent(in) :: A 2584 | double precision, intent(in) :: B 2585 | type(array) :: R 2586 | call init_eq(R, A) 2587 | call af_arr_scne(R%ptr, A%ptr, B, err) 2588 | end function array_ne_d 2589 | 2590 | function array_lne_d(B, A) result(R) 2591 | type(array), intent(in) :: A 2592 | double precision, intent(in) :: B 2593 | type(array) :: R 2594 | R = A /= B 2595 | end function array_lne_d 2596 | 2597 | function array_ne_s(A, B) result(R) 2598 | type(array), intent(in) :: A 2599 | real, intent(in) :: B 2600 | type(array) :: R 2601 | call af_arr_scne(R%ptr, A%ptr, dble(B), err) 2602 | end function array_ne_s 2603 | 2604 | function array_lne_s(B, A) result(R) 2605 | type(array), intent(in) :: A 2606 | real, intent(in) :: B 2607 | type(array) :: R 2608 | R = A /= dble(B) 2609 | end function array_lne_s 2610 | 2611 | function array_ne_i(A, B) result(R) 2612 | type(array), intent(in) :: A 2613 | integer, intent(in) :: B 2614 | type(array) :: R 2615 | call af_arr_scne(R%ptr, A%ptr, dble(B), err) 2616 | end function array_ne_i 2617 | 2618 | function array_lne_i(B, A) result(R) 2619 | type(array), intent(in) :: A 2620 | integer, intent(in) :: B 2621 | type(array) :: R 2622 | R = A /= dble(B) 2623 | end function array_lne_i 2624 | 2625 | !> and on two array matrices 2626 | function array_and(A, B) result(R) 2627 | type(array), intent(in) :: A 2628 | type(array), intent(in) :: B 2629 | type(array) :: R 2630 | call init_eq(R, A) 2631 | call af_arr_eland(R%ptr, A%ptr, B%ptr, err) 2632 | end function array_and 2633 | 2634 | !> or on two array matrices 2635 | function array_or(A, B) result(R) 2636 | type(array), intent(in) :: A 2637 | type(array), intent(in) :: B 2638 | type(array) :: R 2639 | call init_eq(R, A) 2640 | call af_arr_elor(R%ptr, A%ptr, B%ptr, err) 2641 | end function array_or 2642 | 2643 | !> Not an array 2644 | function array_not(A) result(R) 2645 | type(array), intent(in) :: A 2646 | type(array) :: R 2647 | call init_eq(R, A) 2648 | call af_arr_not(R%ptr, A%ptr, err) 2649 | end function array_not 2650 | 2651 | !> sin of array 2652 | function array_sin(A) result(R) 2653 | type(array), intent(in) :: A 2654 | type(array) :: R 2655 | call init_eq(R, A) 2656 | call af_arr_sin(R%ptr, A%ptr, err) 2657 | end function array_sin 2658 | 2659 | !> cos of array 2660 | function array_cos(A) result(R) 2661 | type(array), intent(in) :: A 2662 | type(array) :: R 2663 | call init_eq(R, A) 2664 | call af_arr_cos(R%ptr, A%ptr, err) 2665 | end function array_cos 2666 | 2667 | !> tan of array 2668 | function array_tan(A) result(R) 2669 | type(array), intent(in) :: A 2670 | type(array) :: R 2671 | call init_eq(R, A) 2672 | call af_arr_tan(R%ptr, A%ptr, err) 2673 | end function array_tan 2674 | 2675 | !> log of array 2676 | function array_log(A) result(R) 2677 | type(array), intent(in) :: A 2678 | type(array) :: R 2679 | call init_eq(R, A) 2680 | call af_arr_log(R%ptr, A%ptr, err) 2681 | end function array_log 2682 | 2683 | !> absolute of array 2684 | function array_abs(A) result(R) 2685 | type(array), intent(in) :: A 2686 | type(array) :: R 2687 | call init_eq(R, A) 2688 | call af_arr_abs(R%ptr, A%ptr, err) 2689 | end function array_abs 2690 | 2691 | !> exponential of array 2692 | function array_exp(A) result(R) 2693 | type(array), intent(in) :: A 2694 | type(array) :: R 2695 | call init_eq(R, A) 2696 | call af_arr_exp(R%ptr, A%ptr, err) 2697 | end function array_exp 2698 | 2699 | !> Multiply two array matrices 2700 | function array_matmul(A, B) result(R) 2701 | type(array), intent(in) :: A 2702 | type(array), intent(in) :: B 2703 | type(array) :: R 2704 | R%shape(1) = A%shape(1) 2705 | R%shape(2) = B%shape(2) 2706 | R%shape(3) = B%shape(1) 2707 | R%shape(4) = B%shape(1) 2708 | R%rank = 2 2709 | call af_arr_matmul(R%ptr, A%ptr, B%ptr, err) 2710 | end function array_matmul 2711 | 2712 | !> Transpose an array 2713 | function array_transpose(A) result(R) 2714 | type(array), intent(in) :: A 2715 | type(array) :: R 2716 | R%shape(1) = A%shape(2) 2717 | R%shape(2) = A%shape(1) 2718 | R%shape(3) = A%shape(3) 2719 | R%shape(4) = A%shape(4) 2720 | R%rank = 2 2721 | call af_arr_t(R%ptr, A%ptr, err) 2722 | end function array_transpose 2723 | 2724 | !> Htranspose an array 2725 | function array_htranspose(A) result(R) 2726 | type(array), intent(in) :: A 2727 | type(array) :: R 2728 | R%shape(1) = A%shape(2) 2729 | R%shape(2) = A%shape(1) 2730 | R%shape(3) = A%shape(3) 2731 | R%shape(4) = A%shape(4) 2732 | R%rank = 2 2733 | call af_arr_h(R%ptr, A%ptr, err) 2734 | end function array_htranspose 2735 | 2736 | !> Reorder an array 2737 | function array_reorder(A, d1, d2, d3, d4) result(R) 2738 | type(array), intent(in) :: A 2739 | integer, optional, intent(in) :: d1, d2, d3, d4 2740 | type(array) :: R 2741 | 2742 | call init_eq(R, A) 2743 | if (present(d1)) R%shape(1) = d1 2744 | if (present(d2)) R%shape(2) = d2 2745 | if (present(d3)) R%shape(3) = d3 2746 | if (present(d4)) R%shape(4) = d4 2747 | 2748 | call af_arr_t(R%ptr, A%ptr, R%shape, err) 2749 | end function array_reorder 2750 | 2751 | !> Sort an array 2752 | function array_sort(A) result(R) 2753 | type(array), intent(in) :: A 2754 | type(array) :: R 2755 | call init_eq(R, A) 2756 | call af_arr_sort(R%ptr, A%ptr, err) 2757 | end function array_sort 2758 | 2759 | !> Lower triangular matrix of a matrix 2760 | function array_lower(A) result(R) 2761 | type(array), intent(in) :: A 2762 | type(array) :: R 2763 | call init_eq(R, A) 2764 | call af_arr_lower(R%ptr, A%ptr, err) 2765 | end function array_lower 2766 | 2767 | !> Upper triangular matrix of a matrix 2768 | function array_upper(A) result(R) 2769 | type(array), intent(in) :: A 2770 | type(array) :: R 2771 | call init_eq(R, A) 2772 | call af_arr_upper(R%ptr, A%ptr, err) 2773 | end function array_upper 2774 | 2775 | !> Diag triangular matrix of a matrix 2776 | function array_diag(A) result(R) 2777 | type(array), intent(in) :: A 2778 | type(array) :: R 2779 | call init_eq(R, A) 2780 | call af_arr_diag(R%ptr, A%ptr, err) 2781 | end function array_diag 2782 | 2783 | !> Real triangular matrix of a matrix 2784 | function array_real(A) result(R) 2785 | type(array), intent(in) :: A 2786 | type(array) :: R 2787 | call init_eq(R, A) 2788 | call af_arr_real(R%ptr, A%ptr, err) 2789 | end function array_real 2790 | 2791 | !> Imag triangular matrix of a matrix 2792 | function array_imag(A) result(R) 2793 | type(array), intent(in) :: A 2794 | type(array) :: R 2795 | call init_eq(R, A) 2796 | call af_arr_imag(R%ptr, A%ptr, err) 2797 | end function array_imag 2798 | 2799 | !> Create complex matrix from input matrix 2800 | function array_complex(A) result(R) 2801 | type(array), intent(in) :: A 2802 | type(array) :: R 2803 | call init_eq(R, A) 2804 | call af_arr_complex(R%ptr, A%ptr, err) 2805 | end function array_complex 2806 | 2807 | !> Create complex matrix from two (real, imaginary) matrices 2808 | function array_complex2(Re, Im) result(Cplx) 2809 | type(array), intent(in) :: Re, Im 2810 | type(array) :: Cplx 2811 | call init_eq(Cplx, Re) 2812 | call af_arr_complex2(Cplx%ptr, Re%ptr, Im%ptr, err) 2813 | end function array_complex2 2814 | 2815 | !> Create conjugate matrix from input matrix 2816 | function array_conjg(A) result(R) 2817 | type(array), intent(in) :: A 2818 | type(array) :: R 2819 | call init_eq(R, A) 2820 | call af_arr_conjg(R%ptr, A%ptr, err) 2821 | end function array_conjg 2822 | 2823 | !> Norm of an array 2824 | function array_norm(A) result(R) 2825 | type(array), intent(in) :: A 2826 | double precision :: R 2827 | call af_arr_norm(R, A%ptr, err) 2828 | end function array_norm 2829 | 2830 | !> Norm of an array 2831 | function array_pnorm(A, p) result(R) 2832 | type(array), intent(in) :: A 2833 | real, intent(in) :: p 2834 | double precision :: R 2835 | call af_arr_pnorm(R, A%ptr, p, err) 2836 | end function array_pnorm 2837 | 2838 | !> LU decomposition of array 2839 | subroutine array_lu(L, U, p, A) 2840 | type(array), intent(in) :: A 2841 | type(array), intent(inout) :: L 2842 | type(array), intent(inout) :: U 2843 | type(array), intent(inout) :: p 2844 | call init_eq(L, A) 2845 | call init_eq(U, A) 2846 | call init_eq(p, A) 2847 | L%shape(2) = min(A%shape(1), A%shape(2)) 2848 | U%shape(1) = L%shape(2) 2849 | p%shape(1) = 1 2850 | p%shape(2) = A%shape(1) 2851 | call af_arr_lu(L%ptr, U%ptr, p%ptr, A%ptr, err) 2852 | end subroutine array_lu 2853 | 2854 | !> LU decomposition of array 2855 | subroutine array_lu_inplace(A) 2856 | type(array), intent(inout) :: A 2857 | call af_arr_lu_inplace(A%ptr, err) 2858 | end subroutine array_lu_inplace 2859 | 2860 | !> QR decomposition of array 2861 | subroutine array_qr(Q, R, A) 2862 | type(array), intent(in) :: A 2863 | type(array), intent(inout) :: Q 2864 | type(array), intent(inout) :: R 2865 | call init_eq(Q, A) 2866 | call init_eq(R, A) 2867 | Q%shape(2) = A%shape(1) 2868 | call af_arr_qr(Q%ptr, R%ptr, A%ptr, err) 2869 | end subroutine array_qr 2870 | 2871 | !> Singular value decomposition of array 2872 | subroutine array_singular(S, U, V, A) 2873 | type(array), intent(in) :: A 2874 | type(array), intent(inout) :: S, U, V 2875 | call init_eq(S, A) 2876 | call init_eq(U, A) 2877 | call init_eq(V, A) 2878 | U%shape(2) = U%shape(1) 2879 | V%shape(1) = V%shape(2) 2880 | call af_arr_singular(S%ptr, U%ptr, V%ptr, A%ptr, err) 2881 | end subroutine array_singular 2882 | 2883 | !> cholesky decomposition of array 2884 | subroutine array_cholesky(R, A) 2885 | type(array), intent(in) :: A 2886 | type(array), intent(inout) :: R 2887 | call init_eq(R, A) 2888 | call af_arr_cholesky(R%ptr, A%ptr, err) 2889 | end subroutine array_cholesky 2890 | 2891 | !> cholesky decomposition of array 2892 | subroutine array_cholesky_inplace(A) 2893 | type(array), intent(inout) :: A 2894 | call af_arr_cholesky_inplace(A%ptr, err) 2895 | end subroutine array_cholesky_inplace 2896 | 2897 | !> Solve a system of equations 2898 | function array_solve(A, B) result(X) 2899 | type(array), intent(in) :: A, B 2900 | type(array) :: X 2901 | call init_eq(X, B) 2902 | X%shape(1) = A%shape(2) 2903 | call af_arr_solve(X%ptr, A%ptr, B%ptr, err) 2904 | end function array_solve 2905 | 2906 | !> Inverse an array 2907 | function array_inverse(A) result(R) 2908 | type(array), intent(in) :: A 2909 | type(array) :: R 2910 | call init_eq(R, A) 2911 | call af_arr_inverse(R%ptr, A%ptr, err) 2912 | end function array_inverse 2913 | 2914 | !> Summation of elements in a matrix 2915 | function array_sum (A, d) result(R) 2916 | type(array), intent(in) :: A 2917 | integer, optional, intent(in) :: d 2918 | type(array) :: R 2919 | integer :: dim = 1 2920 | if (present(d)) dim = d 2921 | call init_eq(R, A) 2922 | R%shape(1) = 1 2923 | call af_arr_sum(R%ptr, A%ptr, dim, err) 2924 | end function array_sum 2925 | 2926 | !> Product of elements in a matrix 2927 | function array_product (A, d) result(R) 2928 | type(array), intent(in) :: A 2929 | integer, optional, intent(in) :: d 2930 | type(array) :: R 2931 | integer :: dim = 1 2932 | if (present(d)) dim = d 2933 | call init_eq(R, A) 2934 | R%shape(1) = 1 2935 | call af_arr_product(R%ptr, A%ptr, dim, err) 2936 | end function array_product 2937 | 2938 | !> Minimum of elements in a matrix 2939 | function array_min (A, d) result(R) 2940 | type(array), intent(in) :: A 2941 | integer, optional, intent(in) :: d 2942 | type(array) :: R 2943 | integer :: dim = 1 2944 | if (present(d)) dim = d 2945 | call init_eq(R, A) 2946 | R%shape(1) = 1 2947 | call af_arr_min(R%ptr, A%ptr, dim, err) 2948 | end function array_min 2949 | 2950 | !> Maximum of elements in a matrix 2951 | function array_max (A, d) result(R) 2952 | type(array), intent(in) :: A 2953 | integer, optional, intent(in) :: d 2954 | type(array) :: R 2955 | integer :: dim = 1 2956 | if (present(d)) dim = d 2957 | call init_eq(R, A) 2958 | R%shape(1) = 1 2959 | call af_arr_max(R%ptr, A%ptr, dim, err) 2960 | end function array_max 2961 | 2962 | !> Any of elements in a matrix 2963 | function array_anytrue (A, d) result(R) 2964 | type(array), intent(in) :: A 2965 | integer, optional, intent(in) :: d 2966 | type(array) :: R 2967 | integer :: dim = 1 2968 | if (present(d)) dim = d 2969 | call init_eq(R, A) 2970 | R%shape(1) = 1 2971 | call af_arr_anytrue(R%ptr, A%ptr, dim, err) 2972 | end function array_anytrue 2973 | 2974 | !> All of elements in a matrix 2975 | function array_alltrue(A, d) result(R) 2976 | type(array), intent(in) :: A 2977 | integer, optional, intent(in) :: d 2978 | type(array) :: R 2979 | integer :: dim = 1 2980 | if (present(d)) dim = d 2981 | call init_eq(R, A) 2982 | R%shape(1) = 1 2983 | call af_arr_alltrue(R%ptr, A%ptr, dim, err) 2984 | end function array_alltrue 2985 | 2986 | !> Mean of elements in a matrix 2987 | function array_mean (A, d) result(R) 2988 | type(array), intent(in) :: A 2989 | integer, optional, intent(in) :: d 2990 | type(array) :: R 2991 | integer :: dim = 1 2992 | if (present(d)) dim = d 2993 | call init_eq(R, A) 2994 | R%shape(1) = 1 2995 | call af_arr_mean(R%ptr, A%ptr, dim, err) 2996 | end function array_mean 2997 | 2998 | !> Standard deviation of elements in a matrix 2999 | function array_std (A, d) result(R) 3000 | type(array), intent(in) :: A 3001 | integer, optional, intent(in) :: d 3002 | type(array) :: R 3003 | integer :: dim = 1 3004 | if (present(d)) dim = d 3005 | call init_eq(R, A) 3006 | R%shape(1) = 1 3007 | call af_arr_stdev(R%ptr, A%ptr, dim, err) 3008 | end function array_std 3009 | 3010 | !> Variance of elements in a matrix 3011 | function array_var (A, d) result(R) 3012 | type(array), intent(in) :: A 3013 | integer, optional, intent(in) :: d 3014 | type(array) :: R 3015 | integer :: dim = 1 3016 | if (present(d)) dim = d 3017 | call init_eq(R, A) 3018 | R%shape(1) = 1 3019 | call af_arr_var(R%ptr, A%ptr, dim, err) 3020 | end function array_var 3021 | 3022 | !> Show device info 3023 | subroutine device_info_() 3024 | call af_device_info() 3025 | end subroutine device_info_ 3026 | 3027 | !> Evaluate an expression on device 3028 | subroutine device_eval_(A) 3029 | type(array), intent(in) :: A 3030 | call af_device_eval(A%ptr) 3031 | end subroutine device_eval_ 3032 | 3033 | !> Synchronize on the device 3034 | subroutine device_sync_() 3035 | call af_device_sync() 3036 | end subroutine device_sync_ 3037 | 3038 | !> Get the device number 3039 | function device_get_() result(R) 3040 | integer :: R 3041 | call af_device_get(R) 3042 | end function device_get_ 3043 | 3044 | !> Set a particular device 3045 | subroutine device_set_(R) 3046 | integer :: R 3047 | call af_device_set(R) 3048 | end subroutine device_set_ 3049 | 3050 | !> Show device count 3051 | function device_count_() result(R) 3052 | integer :: R 3053 | call af_device_count(R) 3054 | end function device_count_ 3055 | 3056 | !> Show device start 3057 | subroutine timer_start_() 3058 | call af_timer_start() 3059 | end subroutine timer_start_ 3060 | 3061 | !> Show device stop 3062 | function timer_stop_() result(elapsed) 3063 | double precision :: elapsed 3064 | call af_timer_stop(elapsed) 3065 | end function timer_stop_ 3066 | 3067 | end module arrayfire 3068 | --------------------------------------------------------------------------------