!*****************
! File Description:  
!   Interface to CUDA runtime APIs
! Creator: Hoang-Trong Minh Tuan 
! 
! Rev: 0.1 
! Update: 
!    x.x: 
!*******************/

MODULE cuda_interop
  USE precisioninfo
  USE iso_c_binding
  USE opengl_kinds
  USE cudafor
  USE error_codes
#include "macro.h"  
  !  INCLUDE "/opt/pgi/linux86-64/10.9/src/cudafor_driver_types.h"
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !interface to CUDA runtime APIs
  INTERFACE
    FUNCTION cudaGLSetGLDevice (device)  &
          BIND(C, name="cudaGLSetGLDevice") RESULT(res)
      USE iso_c_binding
      USE cudafor
      INTEGER(c_int), VALUE :: device
      INTEGER(KIND(cudaSuccess)) :: res
    END FUNCTION cudaGLSetGLDevice

  END INTERFACE
  
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !libmycudart
  INTERFACE
    FUNCTION cutGetMaxGflopsDeviceId() BIND(C, name="cutGetMaxGflopsDeviceId") RESULT(res)
      USE iso_c_binding
      INTEGER(c_int) :: res
    END FUNCTION cutGetMaxGflopsDeviceId
  END INTERFACE
  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  !libreduction
  INTERFACE
    TYPE(c_ptr) FUNCTION initreduction_double() &
          BIND(c, name="init_double_tesla")
      use iso_c_binding
    END FUNCTION initreduction_double
    SUBROUTINE finalizereduction_double_tesla(d_idata) &
          BIND(C, name="finalize_double_tesla")
      USE iso_c_binding
      TYPE(c_ptr) :: d_idata
    END SUBROUTINE finalizereduction_double_tesla

    REAL(c_double) FUNCTION sum_reduce_double_2host(p_arr, n, d_odata) &
          BIND(c, name="sum_reduce_double_2host_tesla_test")
      USE iso_c_binding
      REAL(c_double), DIMENSION(*), device  :: p_arr
      INTEGER(c_int), VALUE :: n
      TYPE(c_ptr), value  :: d_odata
    END FUNCTION sum_reduce_double_2host
    !!REAL(c_double) FUNCTION sum_reduce_double_2host(p_arr, n, d_odata) BIND(c, name="sum_reduce_double_2host_tesla") - this function doesn't work
    
    REAL(c_double) FUNCTION min_reduce_double_2host(d_idata, size, d_odata) &
          BIND(c, name=" min_double_2host_tesla")
      USE iso_c_binding
      REAL(c_double), DIMENSION(*), device :: d_idata
      INTEGER(c_int), VALUE :: size
      TYPE(c_ptr), value  :: d_odata
    END FUNCTION min_reduce_double_2host

    REAL(c_double) FUNCTION reduceCPU_double(DATA, size) BIND(C, name="reduceCPU_double")
      USE iso_c_binding
      REAL(c_double), DIMENSION(*) :: DATA
      INTEGER(c_int), VALUE :: size
    END FUNCTION reduceCPU_double        
  END INTERFACE


  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  ! OpenGL interface
!!$  INTERFACE
!!$    SUBROUTINE glGenBuffers(n, buffers) BIND(C, name="glGenBuffers")
!!$      USE iso_c_binding
!!$      USE opengl_kinds
!!$      INTEGER(Glsizei), VALUE:: n
!!$      INTEGER(GLuint), DIMENSION(*) :: buffers
!!$    END SUBROUTINE glGenBuffers
!!$
!!$    SUBROUTINE glBindBuffer(n, buffer) BIND(C, name="glBindBuffer")
!!$      USE iso_c_binding
!!$      USE opengl_kinds
!!$      INTEGER(GLenum), VALUE:: n
!!$      INTEGER(GLuint), VALUE :: buffer
!!$    END SUBROUTINE glBindBuffer
!!$
!!$  END INTERFACE

    !! This interfaces define the function to call from SARU PRNG
  INTERFACE
     TYPE(c_ptr) FUNCTION init_saru(size,  global_seed) BIND(C, name="init_saru")
       USE iso_c_binding
       INTEGER(c_int), VALUE :: size, global_seed
     END FUNCTION init_saru

     SUBROUTINE gen_rand_saru_c2050(saruObj, d_idata, size, times) BIND(C, name="gen_rand_saru_c2050")
       USE iso_c_binding
       TYPE(c_ptr), value :: saruObj
       REAL(c_double), DIMENSION(*), device :: d_idata
       INTEGER(c_int), VALUE :: size
       INTEGER(c_int), VALUE :: times
     END SUBROUTINE gen_rand_saru_c2050
     SUBROUTINE gen_rand_saru_c1060(saruObj, d_idata, size, times) BIND(C, name="gen_rand_saru_c1060")
       USE iso_c_binding
       TYPE(c_ptr), value :: saruObj
       REAL(c_double), DIMENSION(*), device :: d_idata
       INTEGER(c_int), VALUE :: size
       INTEGER(c_int), VALUE :: times
     END SUBROUTINE gen_rand_saru_c1060

     SUBROUTINE  finalize_saru(saruObj) BIND(C, name="finalize_saru")
       USE iso_c_binding
       TYPE(c_ptr), value :: saruObj
     END SUBROUTINE finalize_saru
  END INTERFACE

  INTERFACE
     SUBROUTINE init_mt(d_status, d_texture) BIND(C, name="init_mt_fermi")
       USE iso_c_binding
       TYPE(c_ptr) :: d_status
       TYPE(c_ptr), DIMENSION(3) :: d_texture
     END SUBROUTINE init_mt
     TYPE(c_ptr) FUNCTION init_mt_status() BIND(C, name="init_mt_status_fermi")
       USE iso_c_binding
     END FUNCTION init_mt_status
     FUNCTION init_mt_texture(d_status) RESULT(res) BIND(C, name="init_mt_texture_fermi") 
       USE iso_c_binding
       TYPE(c_ptr), VALUE :: d_status
       TYPE(c_ptr) :: res
     END FUNCTION  init_mt_texture
     SUBROUTINE finalize_mt(d_status, d_texture) BIND(C, name="finalize_mt")
       USE iso_c_binding
       TYPE(c_ptr) :: d_status
       TYPE(c_ptr) :: d_texture
     END SUBROUTINE finalize_mt
     SUBROUTINE generate_mt_data(d_status, d_texture, num_data, d_data) BIND(C, name="generate_mt_data_fermi")
       USE iso_c_binding
       TYPE(c_ptr), VALUE :: d_status, d_texture
       INTEGER(c_int), VALUE :: num_data
       REAL(c_double), DIMENSION(*), device :: d_data
     END SUBROUTINE generate_mt_data
  END INTERFACE

CONTAINS
  !!>****f* data_global/init_GPU
  !! SYNOPSIS  
  !!   Select the GPU ID and init
  !! INPUTS 
  !! OUTPUTS 
  !! RETURN
  !!    0 = success
  !!    otherwise = error
  !! SIDE EFFECTS 
  !! HISTORY 
  !! BUGS 
  !!_****
  FUNCTION init_GPU(gpuID) RESULT(res)
    USE cudafor

    INTEGER :: res
    INTEGER, INTENT(INOUT) :: gpuID
    !local
    INTEGER :: numdev, ierr

    res = SUCCESS
    
    ierr = cudaGetDeviceCount(numdev)
    IF (ierr .NE. cudaSuccess) THEN
       WRITE(error_message,*) cudaGetErrorString(res)
       res = ERR_CUDA_INIT
       RETURN
    ELSE
       WRITE(log_string, *) "There are ", numdev, " devices"
       CALL write2log(log_string)
    END IF

    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! Set your device ID here   !
    IF (gpuID .EQ. -1) THEN
       gpuID = cutGetMaxGflopsDeviceId()
       !gpuID = 0
    END IF
    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!

#if  _USE_DISPLAY_ == _DISP_CUDA_OPENGL
    IF (cudaGLSetGLDevice( gpuID ) .NE. cudaSuccess) THEN
#else
    IF (cudaSetDevice( gpuID ) .NE. cudaSuccess) THEN
#endif    
       WRITE(log_string,*) "Cannot set GPU device: ", gpuID
       CALL write2log(log_string)
       WRITE(error_message,*) cudaGetErrorString(cudaSetDevice(gpuID))
       res = ERR_CUDA_INIT
       RETURN
    ELSE
       WRITE(log_string, *) "We use device ID ", gpuID
       CALL write2log(log_string)
    ENDIF
  END FUNCTION init_GPU

END MODULE cuda_interop
