Commit 384e548c authored by Pavel Kus's avatar Pavel Kus Committed by Lorenz Huedepohl

functions included rather than copied

parent 75a3bcfd
......@@ -58,59 +58,8 @@ module test_analytic
contains
!Processor col for global col number
pure function pcol(global_col, nblk, np_cols) result(local_col)
implicit none
integer(kind=c_int), intent(in) :: global_col, nblk, np_cols
integer(kind=c_int) :: local_col
local_col = MOD((global_col-1)/nblk,np_cols)
end function
!Processor row for global row number
pure function prow(global_row, nblk, np_rows) result(local_row)
implicit none
integer(kind=c_int), intent(in) :: global_row, nblk, np_rows
integer(kind=c_int) :: local_row
local_row = MOD((global_row-1)/nblk,np_rows)
end function
function map_global_array_index_to_local_index(iGLobal, jGlobal, iLocal, jLocal , nblk, np_rows, np_cols, my_prow, my_pcol) &
result(possible)
implicit none
integer(kind=c_int) :: pi, pj, li, lj, xi, xj
integer(kind=c_int), intent(in) :: iGlobal, jGlobal, nblk, np_rows, np_cols, my_prow, my_pcol
integer(kind=c_int), intent(out) :: iLocal, jLocal
logical :: possible
possible = .true.
iLocal = 0
jLocal = 0
pi = prow(iGlobal, nblk, np_rows)
if (my_prow .ne. pi) then
possible = .false.
return
endif
pj = pcol(jGlobal, nblk, np_cols)
if (my_pcol .ne. pj) then
possible = .false.
return
endif
li = (iGlobal-1)/(np_rows*nblk) ! block number for rows
lj = (jGlobal-1)/(np_cols*nblk) ! block number for columns
xi = mod( (iGlobal-1),nblk)+1 ! offset in block li
xj = mod( (jGlobal-1),nblk)+1 ! offset in block lj
iLocal = li * nblk + xi
jLocal = lj * nblk + xj
end function
#include "../../src/general/prow_pcol.X90"
#include "../../src/general/map_global_to_local.X90"
subroutine prepare_matrix_analytic_real_double (na, a, nblk, myid, np_rows, &
np_cols, my_prow, my_pcol)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment