diff --git a/src/ZSOLVER/tensorproductmultigrid_Source/mode_openacc_set_device.f90 b/src/ZSOLVER/tensorproductmultigrid_Source/mode_openacc_set_device.f90 new file mode 100644 index 0000000000000000000000000000000000000000..55029c1d0de3b2ecf0416209fd710c3d7bd1d3c8 --- /dev/null +++ b/src/ZSOLVER/tensorproductmultigrid_Source/mode_openacc_set_device.f90 @@ -0,0 +1,98 @@ +!define NO_SWAP_DEVICE +#ifdef NO_SWAP_DEVICE +#define SWAP_DEVICE_RETURN return +#else +#define SWAP_DEVICE_RETURN +#endif +MODULE MODE_OPENACC_SET_DEVICE + + USE openacc , ONLY : acc_device_kind + + IMPLICIT NONE + + INTEGER(kind=acc_device_kind),dimension(1000) :: mnh_idevice_type_at_init = -1000 + INTEGER :: nlevel_mnh_idevice_type = 1 + +CONTAINS + + SUBROUTINE MNH_OPENACC_GET_DEVICE_AT_INIT() + + USE& + openacc , ONLY : acc_get_device_type,acc_device_kind + + IMPLICIT NONE + + INTEGER(kind=acc_device_kind) :: idevice_type + + SWAP_DEVICE_RETURN + + if ( mnh_idevice_type_at_init(1) .EQ. -1000 ) then + mnh_idevice_type_at_init(1) = acc_get_device_type() + print*,'mnh_idevice_type_at_init=',mnh_idevice_type_at_init(1) + end if + + END SUBROUTINE MNH_OPENACC_GET_DEVICE_AT_INIT + + SUBROUTINE MNH_OPENACC_GET_DEVICE() + + USE& + openacc , ONLY : acc_get_device_type,acc_device_kind + + IMPLICIT NONE + + INTEGER(kind=acc_device_kind) :: idevice_type + + SWAP_DEVICE_RETURN + + idevice_type = acc_get_device_type() + print*,'idevice_type=',idevice_type + + END SUBROUTINE MNH_OPENACC_GET_DEVICE + + SUBROUTINE MNH_OPENACC_SET_DEVICE_HOST() + + USE& + openacc , ONLY : acc_set_device_type,acc_device_host,acc_get_device_type + + IMPLICIT NONE + + SWAP_DEVICE_RETURN + + nlevel_mnh_idevice_type = nlevel_mnh_idevice_type + 1 + mnh_idevice_type_at_init(nlevel_mnh_idevice_type) = acc_get_device_type() + call acc_set_device_type(acc_device_host) + + END SUBROUTINE MNH_OPENACC_SET_DEVICE_HOST + + SUBROUTINE MNH_OPENACC_SET_DEVICE_NVIDIA() + + USE& + openacc , ONLY : acc_set_device_type,acc_device_nvidia + + IMPLICIT NONE + + SWAP_DEVICE_RETURN + + call acc_set_device_type(acc_device_nvidia) + + END SUBROUTINE MNH_OPENACC_SET_DEVICE_NVIDIA + + SUBROUTINE MNH_OPENACC_SET_DEVICE_DEFAULT() + + USE& + openacc , ONLY : acc_set_device_type,acc_device_nvidia + + IMPLICIT NONE + + SWAP_DEVICE_RETURN + + IF ( nlevel_mnh_idevice_type == 1 ) THEN + print*,' MNH_OPENACC_SET_DEVICE_DEFAULT :: WARNING ALLREADY AT FIRST LEVEL !!! ' + ELSE + nlevel_mnh_idevice_type = nlevel_mnh_idevice_type - 1 + END IF + call acc_set_device_type(mnh_idevice_type_at_init(nlevel_mnh_idevice_type)) + + END SUBROUTINE MNH_OPENACC_SET_DEVICE_DEFAULT + +END MODULE MODE_OPENACC_SET_DEVICE