dbcsr_blas_operations.F Source File

# 1 "/__w/dbcsr/dbcsr/src/utils/dbcsr_blas_operations.F" 1
!--------------------------------------------------------------------------------------------------!
! Copyright (C) by the DBCSR developers group - All rights reserved                                !
! This file is part of the DBCSR library.                                                          !
!                                                                                                  !
! For information on the license, see the LICENSE file.                                            !
! For further information please visit https://dbcsr.cp2k.org                                      !
! SPDX-License-Identifier: GPL-2.0+                                                                !
!--------------------------------------------------------------------------------------------------!

MODULE dbcsr_blas_operations
   !! Wrappers to BLAS calls.
   USE dbcsr_kinds, ONLY: int_8
   USE dbcsr_types, ONLY: dbcsr_data_obj, &
                          dbcsr_type_complex_4, &
                          dbcsr_type_complex_8, &
                          dbcsr_type_real_4, &
                          dbcsr_type_real_8
#include "base/dbcsr_base_uses.f90"

   IMPLICIT NONE
   PRIVATE

   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbcsr_blas_operations'

   PUBLIC :: dbcsr_lapack_larnv, set_larnv_seed

CONTAINS

   SUBROUTINE set_larnv_seed(irow, nrow, icol, ncol, ival, iseed)
      !! generate a seed respecting the lapack constraints,
      !! - values between 0..4095 (2**12-1)
      !! - iseed(4) odd
      !! also try to avoid iseed that are zero.
      !! Have but with a unique 2D mapping (irow,icol), and a 'mini-seed' ival

      INTEGER, INTENT(IN)                                :: irow, nrow, icol, ncol, ival
         !! 1..nrow
         !! nrow
         !! 1..ncol
         !! ncol
         !! mini-seed
      INTEGER, INTENT(OUT)                               :: iseed(4)
         !! a lapack compatible seed

      INTEGER(KIND=int_8)                                :: map

      map = ((irow - 1 + icol*INT(nrow, int_8))*(1 + MODULO(ival, 2**16)))*2 + 1 + 0*ncol ! ncol used
      iseed(4) = INT(MODULO(map, 2_int_8**12)); map = map/2_int_8**12; ! keep odd
      iseed(3) = INT(MODULO(IEOR(map, 3541_int_8), 2_int_8**12)); map = map/2_int_8**12
      iseed(2) = INT(MODULO(IEOR(map, 1153_int_8), 2_int_8**12)); map = map/2_int_8**12
      iseed(1) = INT(MODULO(IEOR(map, 2029_int_8), 2_int_8**12)); map = map/2_int_8**12
   END SUBROUTINE set_larnv_seed

   SUBROUTINE dbcsr_lapack_larnv(idist, iseed, n, x)
      !! fills an array with random numbers

      INTEGER, INTENT(IN)                                :: idist
         !! type of distribution (1..3, see lapack docs)
      INTEGER, DIMENSION(:), INTENT(INOUT)               :: iseed
         !! requires each int to be in the range 0..2**12, and the iseed(4) odd
      INTEGER, INTENT(IN)                                :: n
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: x

      SELECT CASE (x%d%data_type)
      CASE (dbcsr_type_real_4)
         CALL slarnv(idist, iseed, n, x%d%r_sp)
      CASE (dbcsr_type_real_8)
         CALL dlarnv(idist, iseed, n, x%d%r_dp)
      CASE (dbcsr_type_complex_4)
         CALL clarnv(idist, iseed, n, x%d%c_sp)
      CASE (dbcsr_type_complex_8)
         CALL zlarnv(idist, iseed, n, x%d%c_dp)
      CASE default
         DBCSR_ABORT("Invalid data type")
      END SELECT
   END SUBROUTINE dbcsr_lapack_larnv

END MODULE dbcsr_blas_operations