!
! Copyright (C) 2022, MaX CoE
! Distributed under the MIT License 
! (license terms are at http://opensource.org/licenses/MIT).
!
!--
!
!
! Utility functions to perform device-host memcpy
! using CUDA-Fortran, OpenACC or OpenMP Offload
!
!==================================================================
!==================================================================
! *DO NOT EDIT*: automatically generated from device_memcpy_d2h.jf90
!==================================================================
!==================================================================
!
#include<devxlib_macros.h>
#include<devxlib_defs.h>
!
!=======================================
!
! Note about dimensions:
! The lower bound of the assumed shape array passed to the subroutine is 1
! lbound and range instead refer to the indexing in the parent caller.
!
submodule (devxlib_memcpy) devxlib_memcpy_d2h

   implicit none

   contains

{%- for t in types %}
{%- for p in kinds[t] %}
{%- for d in range(1,dimensions+1) %}
      module subroutine {{p.name}}_devxlib_memcpy_d2h_{{t[0]|lower}}{{d}}d(array_out, array_in, &
                                             {% for dd in range(d) -%} 
                                             {{ "range%s"|format(dd+1) }}, {{ "lbound%s"|format(dd+1) }} {% if not loop.last %}, &
                                             {% endif %}{% endfor %} )
         implicit none
         !
         {{t}}({{p.val}}), intent(inout) :: array_out({% for dd in range(d) %}:{% if not loop.last %}, {%- endif %}{% endfor %})
         {{t}}({{p.val}}) DEV_ATTR, intent(in)    :: array_in({% for dd in range(d) %}:{% if not loop.last %}, {%- endif %}{% endfor %})
         integer, optional, intent(in) :: {% for dd in range(d) %} {{ "range%s(2)"|format(dd+1) }}{% if not loop.last %}, {%- endif %}{% endfor %}
         integer, optional, intent(in) :: {% for dd in range(d) %} {{ "lbound%s"|format(dd+1) }}{% if not loop.last %}, {%- endif %}{% endfor %}
         integer :: ierr = 0
{%- for dd in range(d) %}
         integer :: d{{dd+1}}_start, d{{dd+1}}_end, d{{dd+1}}_size, d{{dd+1}}_ld
         integer :: lbound{{dd+1}}_, range{{dd+1}}_(2)
{%- endfor %}
         !
{%- for dd in range(d) %}
         lbound{{dd+1}}_=1
         if (present(lbound{{dd+1}})) lbound{{dd+1}}_=lbound{{dd+1}} 
         range{{dd+1}}_=(/1,size(array_out, {{dd+1}})/)
         if (present(range{{dd+1}})) range{{dd+1}}_=range{{dd+1}} 
         !
         d{{dd+1}}_start = range{{dd+1}}_(1) -lbound{{dd+1}}_ +1
         d{{dd+1}}_end   = range{{dd+1}}_(2) -lbound{{dd+1}}_ +1
         d{{dd+1}}_size  = range{{dd+1}}_(2) -range{{dd+1}}_(1) + 1
         d{{dd+1}}_ld    = size(array_out, {{dd+1}})
{%- endfor %}
         !
#if defined __DXL_CUDAF
{%- if d==1 %}
         ierr = cudaMemcpy( array_out(d1_start), array_in(d1_start), d1_size, cudaMemcpyDeviceToHost )
{%- elif d==2 %}
         ierr = cudaMemcpy2D( array_out(d1_start, d2_start) , d1_ld, array_in(d1_start, d2_start), d1_ld, d1_size, d2_size )
{%- elif d>=3 %}
         array_out({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%}) = &
                   array_in({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%})
{%- endif %}
         if ( ierr /= 0) call devxlib_error("{{p.name}}_memcpy_d2h_{{t[0]|lower}}{{d}}d",cudaGetErrorString(ierr),ierr)
#elif defined __DXL_OPENACC || defined __DXL_OPENMP_GPU
         !DEV_ACC update host(array_in)
         !DEV_OMPGPU target update from(array_in)
         array_out({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%}) = &
                   array_in({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%})
#else
         array_out({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%}) = &
                   array_in({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%})
#endif
         !
      end subroutine {{p.name}}_devxlib_memcpy_d2h_{{t[0]|lower}}{{d}}d
!
{%- endfor %}
{%- endfor %}
{%- endfor %}

{%- for t in types %}
{%- for p in kinds[t] %}
{%- for d in range(1,dimensions+1) %}
      module subroutine {{p.name}}_devxlib_memcpy_d2h_async_{{t[0]|lower}}{{d}}d(array_out, array_in, async_id, &
                                             {% for dd in range(d) -%} 
                                             {{ "range%s"|format(dd+1) }}, {{ "lbound%s"|format(dd+1) }} {% if not loop.last %}, &
                                             {% endif %}{% endfor %} )
         implicit none
         !
         {{t}}({{p.val}}), target, intent(inout)       :: array_out({% for dd in range(d) %}:{% if not loop.last %}, {%- endif %}{% endfor %})
         {{t}}({{p.val}}), target, intent(inout) DEV_ATTR :: array_in({% for dd in range(d) %}:{% if not loop.last %}, {%- endif %}{% endfor %})
         integer(kind=dxl_async_kind), intent(in) :: async_id
         integer, optional, intent(in) :: {% for dd in range(d) %} {{ "range%s(2)"|format(dd+1) }}{% if not loop.last %}, {%- endif %}{% endfor %}
         integer, optional, intent(in) :: {% for dd in range(d) %} {{ "lbound%s"|format(dd+1) }}{% if not loop.last %}, {%- endif %}{% endfor %}
         type(c_ptr) :: ptr1,ptr2
         integer :: ierr = 0
{%- for dd in range(d) %}
         integer :: d{{dd+1}}_start, d{{dd+1}}_end, d{{dd+1}}_size, d{{dd+1}}_ld
         integer :: lbound{{dd+1}}_, range{{dd+1}}_(2)
{%- endfor %}
         !
{%- for dd in range(d) %}
         lbound{{dd+1}}_=1
         if (present(lbound{{dd+1}})) lbound{{dd+1}}_=lbound{{dd+1}} 
         range{{dd+1}}_=(/1,size(array_out, {{dd+1}})/)
         if (present(range{{dd+1}})) range{{dd+1}}_=range{{dd+1}} 
         !
         d{{dd+1}}_start = range{{dd+1}}_(1) -lbound{{dd+1}}_ +1
         d{{dd+1}}_end   = range{{dd+1}}_(2) -lbound{{dd+1}}_ +1
         d{{dd+1}}_size  = range{{dd+1}}_(2) -range{{dd+1}}_(1) + 1
         d{{dd+1}}_ld    = size(array_out, {{dd+1}})
{%- endfor %}
#if defined __DXL_CUDAF
         ierr = CudaMemcpyAsync(array_out, array_in, &
                                count={% for dd in range(d)%}d{{dd+1}}_size{% if not loop.last %}*{%- endif %}{%endfor%},&
                                kdir=cudaMemcpyHostToDevice,stream=async_id)
         if ( ierr /= 0) call devxlib_error("{{p.name}}_memcpy_d2h_async_{{t[0]|lower}}{{d}}d",cudaGetErrorString(ierr),ierr)
#elif defined __DXL_OPENACC || defined __DXL_OPENMP_GPU
         !DEV_ACC update host(array_in) async(async_id)
         !DEV_OMPGPU target update from(array_in)
         !
         ptr1=c_loc(array_out({% for dd in range(d)%}d{{dd+1}}_start{% if not loop.last %},{%- endif %}{%endfor%}))
         ptr2=c_loc( array_in({% for dd in range(d)%}d{{dd+1}}_start{% if not loop.last %},{%- endif %}{%endfor%}))
         !
         if ( .not. c_associated(ptr1,ptr2)) then
           !DEV_ACC wait(async_id)
           array_out({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%}) = &
                   array_in({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%})
         endif
#else
         array_out({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%}) = &
                 array_in({% for dd in range(d)%}d{{dd+1}}_start:d{{dd+1}}_end{% if not loop.last %},{%- endif %}{%endfor%})
#endif
         !
      end subroutine {{p.name}}_devxlib_memcpy_d2h_async_{{t[0]|lower}}{{d}}d
!
{%- endfor %}
{%- endfor %}
{%- endfor %}

{%- for t in types %}
{%- for p in kinds[t] %}
{%- for d in range(1,dimensions+1) %}
      module subroutine {{p.name}}_devxlib_memcpy_d2h_{{t[0]|lower}}{{d}}d_p(&
#if defined __DXL_OPENMP_GPU
                                             array_out, array_in, device_id)
#else
                                             array_out, array_in)
#endif
         implicit none
         !
         {{t}}({{p.val}}), pointer, intent(inout) DEV_ATTR :: array_in({% for dd in range(d) %}:{% if not loop.last %}, {%- endif %}{% endfor %})
         {{t}}({{p.val}}),  target, intent(inout) :: array_out({% for dd in range(d) %}:{% if not loop.last %}, {%- endif %}{% endfor %})
#if defined __DXL_OPENMP_GPU
         integer,         optional, intent(in)    :: device_id
#endif
         !
#if defined __DXL_CUDAF || defined __DXL_OPENMP_GPU
         integer :: ierr = 0
#endif
         !
#if defined __DXL_CUDAF
         ierr = cudaMemcpy_f(c_loc(array_out), c_loc(array_in), int(storage_size(array_in,kind=int64) * &
                             size(array_in,kind=int64) / 8_int64,c_size_t), cudaMemcpyDeviceToHost)
#elif defined __DXL_OPENACC
         call acc_memcpy_from_device_f(c_loc(array_out), c_loc(array_in), int(storage_size(array_in,kind=int64) * &
                                       size(array_in,kind=int64) / 8_int64, c_size_t))
#elif defined __DXL_OPENMP_GPU
         if (present(device_id)) then
            ierr = int(omp_target_memcpy(c_loc(array_out), c_loc(array_in), int(storage_size(array_out,kind=int64) * &
                       size(array_out,kind=int64) / 8_int64, c_size_t), int(0,c_size_t), int(0,c_size_t), omp_get_initial_device(), device_id), kind=int32)
         else
            ierr = int(omp_target_memcpy(c_loc(array_out), c_loc(array_in), int(storage_size(array_out,kind=int64) * &
                       size(array_out,kind=int64) / 8_int64, c_size_t), int(0,c_size_t), int(0,c_size_t), omp_get_initial_device(), omp_get_default_device()), kind=int32)
         endif
#else
         ! host2host fall-back
         array_out=array_in
#endif
         !
      end subroutine {{p.name}}_devxlib_memcpy_d2h_{{t[0]|lower}}{{d}}d_p
!
{%- endfor %}
{%- endfor %}
{%- endfor %}
endsubmodule devxlib_memcpy_d2h

