LCOV - code coverage report
Current view: top level - src/offload - offload_api.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:f515968) Lines: 40 55 72.7 %
Date: 2022-07-03 19:52:34 Functions: 7 12 58.3 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2022 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: BSD-3-Clause                                                          !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief Fortran API for the offload package, which is written in C.
      10             : !> \author Ole Schuett
      11             : ! **************************************************************************************************
      12             : MODULE offload_api
      13             :    USE ISO_C_BINDING,                   ONLY: C_ASSOCIATED,&
      14             :                                               C_CHAR,&
      15             :                                               C_F_POINTER,&
      16             :                                               C_INT,&
      17             :                                               C_NULL_CHAR,&
      18             :                                               C_NULL_PTR,&
      19             :                                               C_PTR,&
      20             :                                               C_SIZE_T
      21             :    USE kinds,                           ONLY: dp,&
      22             :                                               int_8
      23             : #include "../base/base_uses.f90"
      24             : 
      25             :    IMPLICIT NONE
      26             : 
      27             :    PRIVATE
      28             : 
      29             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'offload_api'
      30             : 
      31             :    PUBLIC :: offload_get_device_count
      32             :    PUBLIC :: offload_set_chosen_device, offload_get_chosen_device, offload_activate_chosen_device
      33             :    PUBLIC :: offload_timeset, offload_timestop, offload_mem_info
      34             :    PUBLIC :: offload_buffer_type, offload_create_buffer, offload_free_buffer
      35             :    PUBLIC :: offload_malloc_pinned_mem, offload_free_pinned_mem
      36             : 
      37             :    TYPE offload_buffer_type
      38             :       REAL(KIND=dp), DIMENSION(:), POINTER :: host_buffer => Null()
      39             :       TYPE(C_PTR)                          :: c_ptr = C_NULL_PTR
      40             :    END TYPE offload_buffer_type
      41             : 
      42             : CONTAINS
      43             : 
      44             : ! **************************************************************************************************
      45             : !> \brief allocate pinned memory.
      46             : !> \param buffer address of the buffer
      47             : !> \param length length of the buffer
      48             : !> \return 0
      49             : ! **************************************************************************************************
      50           0 :    FUNCTION offload_malloc_pinned_mem(buffer, length) RESULT(res)
      51             :       TYPE(C_PTR)                                        :: buffer
      52             :       INTEGER(C_SIZE_T), VALUE                           :: length
      53             :       INTEGER                                            :: res
      54             : 
      55             :       INTERFACE
      56             :          FUNCTION offload_malloc_pinned_mem_c(buffer, length) &
      57             :             BIND(C, name="offload_host_malloc")
      58             :             IMPORT C_SIZE_T, C_PTR, C_INT
      59             :             TYPE(C_PTR)              :: buffer
      60             :             INTEGER(C_SIZE_T), VALUE :: length
      61             :             INTEGER(KIND=C_INT)                :: offload_malloc_pinned_mem_c
      62             :          END FUNCTION offload_malloc_pinned_mem_c
      63             :       END INTERFACE
      64             : 
      65           0 :       res = offload_malloc_pinned_mem_c(buffer, length)
      66           0 :    END FUNCTION offload_malloc_pinned_mem
      67             : 
      68             : ! **************************************************************************************************
      69             : !> \brief free pinned memory
      70             : !> \param buffer address of the buffer
      71             : !> \return 0
      72             : ! **************************************************************************************************
      73           0 :    FUNCTION offload_free_pinned_mem(buffer) RESULT(res)
      74             :       TYPE(C_PTR), VALUE                                 :: buffer
      75             :       INTEGER                                            :: res
      76             : 
      77             :       INTERFACE
      78             :          FUNCTION offload_free_pinned_mem_c(buffer) &
      79             :             BIND(C, name="offload_host_free")
      80             :             IMPORT C_PTR, C_INT
      81             :             INTEGER(KIND=C_INT)                :: offload_free_pinned_mem_c
      82             :             TYPE(C_PTR), VALUE            :: buffer
      83             :          END FUNCTION offload_free_pinned_mem_c
      84             :       END INTERFACE
      85             : 
      86           0 :       res = offload_free_pinned_mem_c(buffer)
      87           0 :    END FUNCTION offload_free_pinned_mem
      88             : 
      89             : ! **************************************************************************************************
      90             : !> \brief Returns the number of available devices.
      91             : !> \return ...
      92             : !> \author Ole Schuett
      93             : ! **************************************************************************************************
      94        7610 :    FUNCTION offload_get_device_count() RESULT(count)
      95             :       INTEGER                                            :: count
      96             : 
      97             :       INTERFACE
      98             :          FUNCTION offload_get_device_count_c() &
      99             :             BIND(C, name="offload_get_device_count")
     100             :             IMPORT :: C_INT
     101             :             INTEGER(KIND=C_INT)                :: offload_get_device_count_c
     102             :          END FUNCTION offload_get_device_count_c
     103             :       END INTERFACE
     104             : 
     105        7610 :       count = offload_get_device_count_c()
     106             : 
     107        7610 :    END FUNCTION offload_get_device_count
     108             : 
     109             : ! **************************************************************************************************
     110             : !> \brief Selects the chosen device to be used.
     111             : !> \param device_id ...
     112             : !> \author Ole Schuett
     113             : ! **************************************************************************************************
     114           0 :    SUBROUTINE offload_set_chosen_device(device_id)
     115             :       INTEGER, INTENT(IN)                                :: device_id
     116             : 
     117             :       INTERFACE
     118             :          SUBROUTINE offload_set_chosen_device_c(device_id) &
     119             :             BIND(C, name="offload_set_chosen_device")
     120             :             IMPORT :: C_INT
     121             :             INTEGER(KIND=C_INT), VALUE                :: device_id
     122             :          END SUBROUTINE offload_set_chosen_device_c
     123             :       END INTERFACE
     124             : 
     125           0 :       CALL offload_set_chosen_device_c(device_id=device_id)
     126             : 
     127           0 :    END SUBROUTINE offload_set_chosen_device
     128             : 
     129             : ! **************************************************************************************************
     130             : !> \brief Returns the chosen device.
     131             : !> \return ...
     132             : !> \author Ole Schuett
     133             : ! **************************************************************************************************
     134           0 :    FUNCTION offload_get_chosen_device() RESULT(device_id)
     135             :       INTEGER                                            :: device_id
     136             : 
     137             :       INTERFACE
     138             :          FUNCTION offload_get_chosen_device_c() &
     139             :             BIND(C, name="offload_get_chosen_device")
     140             :             IMPORT :: C_INT
     141             :             INTEGER(KIND=C_INT)                :: offload_get_chosen_device_c
     142             :          END FUNCTION offload_get_chosen_device_c
     143             :       END INTERFACE
     144             : 
     145           0 :       device_id = offload_get_chosen_device_c()
     146             : 
     147           0 :       IF (device_id < 0) &
     148           0 :          CPABORT("No offload device has been chosen.")
     149             : 
     150           0 :    END FUNCTION offload_get_chosen_device
     151             : 
     152             : ! **************************************************************************************************
     153             : !> \brief Activates the device selected via offload_set_chosen_device()
     154             : !> \author Ole Schuett
     155             : ! **************************************************************************************************
     156      993458 :    SUBROUTINE offload_activate_chosen_device()
     157             : 
     158             :       INTERFACE
     159             :          SUBROUTINE offload_activate_chosen_device_c() &
     160             :             BIND(C, name="offload_activate_chosen_device")
     161             :          END SUBROUTINE offload_activate_chosen_device_c
     162             :       END INTERFACE
     163             : 
     164      993458 :       CALL offload_activate_chosen_device_c()
     165             : 
     166      993458 :    END SUBROUTINE offload_activate_chosen_device
     167             : 
     168             : ! **************************************************************************************************
     169             : !> \brief Starts a timing range.
     170             : !> \param routineN ...
     171             : !> \author Ole Schuett
     172             : ! **************************************************************************************************
     173  1336531011 :    SUBROUTINE offload_timeset(routineN)
     174             :       CHARACTER(LEN=*), INTENT(IN)                       :: routineN
     175             : 
     176             :       INTERFACE
     177             :          SUBROUTINE offload_timeset_c(message) BIND(C, name="offload_timeset")
     178             :             IMPORT :: C_CHAR
     179             :             CHARACTER(kind=C_CHAR), DIMENSION(*), INTENT(IN) :: message
     180             :          END SUBROUTINE offload_timeset_c
     181             :       END INTERFACE
     182             : 
     183  1336531011 :       CALL offload_timeset_c(TRIM(routineN)//C_NULL_CHAR)
     184             : 
     185  1336531011 :    END SUBROUTINE offload_timeset
     186             : 
     187             : ! **************************************************************************************************
     188             : !> \brief  Ends a timing range.
     189             : !> \author Ole Schuett
     190             : ! **************************************************************************************************
     191  1336531011 :    SUBROUTINE offload_timestop()
     192             : 
     193             :       INTERFACE
     194             :          SUBROUTINE offload_timestop_c() BIND(C, name="offload_timestop")
     195             :          END SUBROUTINE offload_timestop_c
     196             :       END INTERFACE
     197             : 
     198  1336531011 :       CALL offload_timestop_c()
     199             : 
     200  1336531011 :    END SUBROUTINE offload_timestop
     201             : 
     202             : ! **************************************************************************************************
     203             : !> \brief Gets free and total device memory.
     204             : !> \param free ...
     205             : !> \param total ...
     206             : !> \author Ole Schuett
     207             : ! **************************************************************************************************
     208      197833 :    SUBROUTINE offload_mem_info(free, total)
     209             :       INTEGER(KIND=int_8), INTENT(OUT)                   :: free, total
     210             : 
     211             :       INTEGER(KIND=C_SIZE_T)                             :: my_free, my_total
     212             :       INTERFACE
     213             :          SUBROUTINE offload_mem_info_c(free, total) BIND(C, name="offload_mem_info")
     214             :             IMPORT :: C_SIZE_T
     215             :             INTEGER(KIND=C_SIZE_T)                   :: free, total
     216             :          END SUBROUTINE offload_mem_info_c
     217             :       END INTERFACE
     218             : 
     219      197833 :       CALL offload_mem_info_c(my_free, my_total)
     220             : 
     221             :       ! On 32-bit architectures this converts from int_4 to int_8.
     222      197833 :       free = my_free
     223      197833 :       total = my_total
     224             : 
     225      197833 :    END SUBROUTINE offload_mem_info
     226             : 
     227             : ! **************************************************************************************************
     228             : !> \brief Allocates a buffer of given length, ie. number of elements.
     229             : !> \param length ...
     230             : !> \param buffer ...
     231             : !> \author Ole Schuett
     232             : ! **************************************************************************************************
     233      241194 :    SUBROUTINE offload_create_buffer(length, buffer)
     234             :       INTEGER, INTENT(IN)                                :: length
     235             :       TYPE(offload_buffer_type), INTENT(INOUT)           :: buffer
     236             : 
     237             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_create_buffer'
     238             : 
     239             :       INTEGER                                            :: handle
     240             :       TYPE(C_PTR)                                        :: host_buffer_c
     241             :       INTERFACE
     242             :          SUBROUTINE offload_create_buffer_c(length, buffer) &
     243             :             BIND(C, name="offload_create_buffer")
     244             :             IMPORT :: C_PTR, C_INT
     245             :             INTEGER(KIND=C_INT), VALUE                :: length
     246             :             TYPE(C_PTR)                               :: buffer
     247             :          END SUBROUTINE offload_create_buffer_c
     248             :       END INTERFACE
     249             :       INTERFACE
     250             : 
     251             :          FUNCTION offload_get_buffer_host_pointer_c(buffer) &
     252             :             BIND(C, name="offload_get_buffer_host_pointer")
     253             :             IMPORT :: C_PTR
     254             :             TYPE(C_PTR), VALUE                        :: buffer
     255             :             TYPE(C_PTR)                               :: offload_get_buffer_host_pointer_c
     256             :          END FUNCTION offload_get_buffer_host_pointer_c
     257             :       END INTERFACE
     258             : 
     259      241194 :       CALL timeset(routineN, handle)
     260             : 
     261      241194 :       IF (ASSOCIATED(buffer%host_buffer)) THEN
     262        9500 :          IF (SIZE(buffer%host_buffer) == 0) DEALLOCATE (buffer%host_buffer)
     263             :       END IF
     264             : 
     265      241194 :       CALL offload_create_buffer_c(length=length, buffer=buffer%c_ptr)
     266      241194 :       CPASSERT(C_ASSOCIATED(buffer%c_ptr))
     267             : 
     268      241194 :       IF (length == 0) THEN
     269             :          ! While C_F_POINTER usually accepts a NULL pointer it's not standard compliant.
     270         438 :          ALLOCATE (buffer%host_buffer(0))
     271             :       ELSE
     272      240756 :          host_buffer_c = offload_get_buffer_host_pointer_c(buffer%c_ptr)
     273      240756 :          CPASSERT(C_ASSOCIATED(host_buffer_c))
     274      481512 :          CALL C_F_POINTER(host_buffer_c, buffer%host_buffer, shape=(/length/))
     275             :       END IF
     276             : 
     277      241194 :       CALL timestop(handle)
     278      241194 :    END SUBROUTINE offload_create_buffer
     279             : 
     280             : ! **************************************************************************************************
     281             : !> \brief Deallocates given buffer.
     282             : !> \param buffer ...
     283             : !> \author Ole Schuett
     284             : ! **************************************************************************************************
     285      231694 :    SUBROUTINE offload_free_buffer(buffer)
     286             :       TYPE(offload_buffer_type), INTENT(INOUT)           :: buffer
     287             : 
     288             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'offload_free_buffer'
     289             : 
     290             :       INTEGER                                            :: handle
     291             :       INTERFACE
     292             :          SUBROUTINE offload_free_buffer_c(buffer) &
     293             :             BIND(C, name="offload_free_buffer")
     294             :             IMPORT :: C_PTR
     295             :             TYPE(C_PTR), VALUE                        :: buffer
     296             :          END SUBROUTINE offload_free_buffer_c
     297             :       END INTERFACE
     298             : 
     299      231694 :       CALL timeset(routineN, handle)
     300             : 
     301      231694 :       CPASSERT(C_ASSOCIATED(buffer%c_ptr))
     302             : 
     303      231694 :       CALL offload_free_buffer_c(buffer%c_ptr)
     304             : 
     305      231694 :       buffer%c_ptr = C_NULL_PTR
     306             : 
     307      231694 :       IF (SIZE(buffer%host_buffer) == 0) THEN
     308         332 :          DEALLOCATE (buffer%host_buffer)
     309             :       ELSE
     310      231362 :          NULLIFY (buffer%host_buffer)
     311             :       END IF
     312             : 
     313      231694 :       CALL timestop(handle)
     314      231694 :    END SUBROUTINE offload_free_buffer
     315           0 : END MODULE offload_api

Generated by: LCOV version 1.15