1!! Copyright (C) 2011-2015 X. Andrade 2!! 3!! This program is free software; you can redistribute it and/or modify 4!! it under the terms of the GNU General Public License as published by 5!! the Free Software Foundation; either version 2, or (at your option) 6!! any later version. 7!! 8!! This program is distributed in the hope that it will be useful, 9!! but WITHOUT ANY WARRANTY; without even the implied warranty of 10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11!! GNU General Public License for more details. 12!! 13!! You should have received a copy of the GNU General Public License 14!! along with this program; if not, write to the Free Software 15!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 16!! 02110-1301, USA. 17!! 18 19 ! --------------------------------------------------------- 20 subroutine X(matrix_init_data)(this, dim1, dim2, data, mpi_grp) 21 type(matrix_t), intent(out) :: this 22 integer, intent(in) :: dim1 23 integer, intent(in) :: dim2 24 R_TYPE, intent(in) :: data(:, :) 25 type(mpi_grp_t), intent(in) :: mpi_grp !< the group of processors that shares this matrix 26 27 PUSH_SUB(X(matrix_init_data)) 28 29 ASSERT(all(ubound(data) == (/dim1, dim2/))) 30 31 this%dim(1:2) = (/dim1, dim2/) 32 33 this%type = R_TYPE_VAL 34 35 this%mpi_grp = mpi_grp 36 37 ASSERT(this%type == TYPE_FLOAT .or. this%type == TYPE_CMPLX) 38 39 SAFE_ALLOCATE(this%X(mat)(1:dim1, 1:dim2)) 40 41 this%X(mat)(1:dim1, 1:dim2) = data(1:dim1, 1:dim2) 42 43 POP_SUB(X(matrix_init_data)) 44 end subroutine X(matrix_init_data) 45 46 ! --------------------------------------------------------- 47 48 subroutine X(matrix_set_block)(this, min1, max1, min2, max2, data) 49 type(matrix_t), intent(inout) :: this 50 integer, intent(in) :: min1 51 integer, intent(in) :: max1 52 integer, intent(in) :: min2 53 integer, intent(in) :: max2 54 R_TYPE, intent(in) :: data(:, :) 55 56 PUSH_SUB(X(matrix_init_data)) 57 58 ! print*, min1, max1, this%dim(1) 59 ! print*, min2, max2, this%dim(2) 60 61 ASSERT(this%type == R_TYPE_VAL) 62 ASSERT(min1 <= max1) 63 ASSERT(min2 <= max2) 64 ASSERT(0 < min1 .and. min1 <= this%dim(1)) 65 ASSERT(0 < max1 .and. max1 <= this%dim(1)) 66 ASSERT(0 < min2 .and. min2 <= this%dim(2)) 67 ASSERT(0 < max2 .and. max2 <= this%dim(2)) 68 69 this%X(mat)(min1:max1, min2:max2) = data(1:max1 - min1 + 1, 1:max2 - min2 + 1) 70 71 POP_SUB(X(matrix_init_data)) 72 end subroutine X(matrix_set_block) 73 74 ! --------------------------------------------------------- 75 76 subroutine X(matrix_get_block)(this, min1, max1, min2, max2, data) 77 type(matrix_t), intent(in) :: this 78 integer, intent(in) :: min1 79 integer, intent(in) :: max1 80 integer, intent(in) :: min2 81 integer, intent(in) :: max2 82 R_TYPE, intent(inout) :: data(:, :) 83 84 PUSH_SUB(X(matrix_init_data)) 85 86 ! print*, min1, max1, this%dim(1) 87 ! print*, min2, max2, this%dim(2) 88 89 ASSERT(this%type == R_TYPE_VAL) 90 ASSERT(min1 <= max1) 91 ASSERT(min2 <= max2) 92 ASSERT(0 < min1 .and. min1 <= this%dim(1)) 93 ASSERT(0 < max1 .and. max1 <= this%dim(1)) 94 ASSERT(0 < min2 .and. min2 <= this%dim(2)) 95 ASSERT(0 < max2 .and. max2 <= this%dim(2)) 96 97 data(1:max1 - min1 + 1, 1:max2 - min2 + 1) = this%X(mat)(min1:max1, min2:max2) 98 99 POP_SUB(X(matrix_init_data)) 100 end subroutine X(matrix_get_block) 101 102!! Local Variables: 103!! mode: f90 104!! coding: utf-8 105!! End: 106