ectrans_blas_mod.F90 Source File


Files dependent on this one

sourcefile~~ectrans_blas_mod.f90~~AfferentGraph sourcefile~ectrans_blas_mod.f90 ectrans_blas_mod.F90 sourcefile~butterfly_alg_mod.f90 butterfly_alg_mod.F90 sourcefile~butterfly_alg_mod.f90->sourcefile~ectrans_blas_mod.f90 sourcefile~ledir_mod.f90 ledir_mod.F90 sourcefile~ledir_mod.f90->sourcefile~ectrans_blas_mod.f90 sourcefile~ledir_mod.f90->sourcefile~butterfly_alg_mod.f90 sourcefile~tpm_flt.f90 tpm_flt.F90 sourcefile~ledir_mod.f90->sourcefile~tpm_flt.f90 sourcefile~ledirad_mod.f90 ledirad_mod.F90 sourcefile~ledirad_mod.f90->sourcefile~ectrans_blas_mod.f90 sourcefile~ledirad_mod.f90->sourcefile~butterfly_alg_mod.f90 sourcefile~ledirad_mod.f90->sourcefile~tpm_flt.f90 sourcefile~leinv_mod.f90 leinv_mod.F90 sourcefile~leinv_mod.f90->sourcefile~ectrans_blas_mod.f90 sourcefile~leinv_mod.f90->sourcefile~butterfly_alg_mod.f90 sourcefile~leinv_mod.f90->sourcefile~tpm_flt.f90 sourcefile~leinvad_mod.f90 leinvad_mod.F90 sourcefile~leinvad_mod.f90->sourcefile~ectrans_blas_mod.f90 sourcefile~leinvad_mod.f90->sourcefile~butterfly_alg_mod.f90 sourcefile~leinvad_mod.f90->sourcefile~tpm_flt.f90 sourcefile~ltdir_mod.f90 ltdir_mod.F90 sourcefile~ltdir_mod.f90->sourcefile~ledir_mod.f90 sourcefile~ltdir_mod.f90->sourcefile~tpm_flt.f90 sourcefile~cdmap_mod.f90 cdmap_mod.F90 sourcefile~ltdir_mod.f90->sourcefile~cdmap_mod.f90 sourcefile~ltdir_mod.f90~2 ltdir_mod.F90 sourcefile~ltdir_mod.f90~2->sourcefile~ledir_mod.f90 sourcefile~ltdirad_mod.f90 ltdirad_mod.F90 sourcefile~ltdirad_mod.f90->sourcefile~ledirad_mod.f90 sourcefile~ltdirad_mod.f90~2 ltdirad_mod.F90 sourcefile~ltdirad_mod.f90~2->sourcefile~ledir_mod.f90 sourcefile~ltdirad_mod.f90~2->sourcefile~leinv_mod.f90 sourcefile~ltinv_mod.f90 ltinv_mod.F90 sourcefile~ltinv_mod.f90->sourcefile~leinv_mod.f90 sourcefile~ltinv_mod.f90->sourcefile~tpm_flt.f90 sourcefile~ltinv_mod.f90->sourcefile~cdmap_mod.f90 sourcefile~ltinv_mod.f90~2 ltinv_mod.F90 sourcefile~ltinv_mod.f90~2->sourcefile~leinv_mod.f90 sourcefile~ltinvad_mod.f90 ltinvad_mod.F90 sourcefile~ltinvad_mod.f90->sourcefile~leinvad_mod.f90 sourcefile~ltinvad_mod.f90~2 ltinvad_mod.F90 sourcefile~ltinvad_mod.f90~2->sourcefile~ledir_mod.f90 sourcefile~ltinvad_mod.f90~2->sourcefile~leinv_mod.f90 sourcefile~read_legpol_mod.f90 read_legpol_mod.F90 sourcefile~read_legpol_mod.f90->sourcefile~butterfly_alg_mod.f90 sourcefile~read_legpol_mod.f90->sourcefile~tpm_flt.f90 sourcefile~suleg_mod.f90 suleg_mod.F90 sourcefile~suleg_mod.f90->sourcefile~butterfly_alg_mod.f90 sourcefile~suleg_mod.f90->sourcefile~read_legpol_mod.f90 sourcefile~suleg_mod.f90->sourcefile~tpm_flt.f90 sourcefile~write_legpol_mod.f90 write_legpol_mod.F90 sourcefile~suleg_mod.f90->sourcefile~write_legpol_mod.f90 sourcefile~tpm_flt.f90->sourcefile~butterfly_alg_mod.f90 sourcefile~trltom_pack_unpack.f90 trltom_pack_unpack.F90 sourcefile~trltom_pack_unpack.f90->sourcefile~ledir_mod.f90 sourcefile~trltomad_pack_unpack.f90 trltomad_pack_unpack.F90 sourcefile~trltomad_pack_unpack.f90->sourcefile~ledir_mod.f90 sourcefile~trmtol_pack_unpack.f90 trmtol_pack_unpack.F90 sourcefile~trmtol_pack_unpack.f90->sourcefile~leinv_mod.f90 sourcefile~trmtolad_pack_unpack.f90 trmtolad_pack_unpack.F90 sourcefile~trmtolad_pack_unpack.f90->sourcefile~leinv_mod.f90 sourcefile~write_legpol_mod.f90->sourcefile~butterfly_alg_mod.f90 sourcefile~write_legpol_mod.f90->sourcefile~tpm_flt.f90 sourcefile~cdmap_mod.f90->sourcefile~tpm_flt.f90 sourcefile~cdmap_mod.f90~2 cdmap_mod.F90 sourcefile~cdmap_mod.f90~2->sourcefile~tpm_flt.f90 sourcefile~dealloc_resol_mod.f90 dealloc_resol_mod.F90 sourcefile~dealloc_resol_mod.f90->sourcefile~tpm_flt.f90 sourcefile~set_resol_mod.f90 set_resol_mod.F90 sourcefile~dealloc_resol_mod.f90->sourcefile~set_resol_mod.f90 sourcefile~dealloc_resol_mod.f90~2 dealloc_resol_mod.F90 sourcefile~dealloc_resol_mod.f90~2->sourcefile~tpm_flt.f90 sourcefile~dealloc_resol_mod.f90~2->sourcefile~set_resol_mod.f90 sourcefile~dir_trans.f90 dir_trans.F90 sourcefile~dir_trans.f90->sourcefile~tpm_flt.f90 sourcefile~dir_trans.f90->sourcefile~set_resol_mod.f90 sourcefile~dir_trans_ctl_mod.f90 dir_trans_ctl_mod.F90 sourcefile~dir_trans.f90->sourcefile~dir_trans_ctl_mod.f90 sourcefile~dir_trans_ctl_mod.f90~2 dir_trans_ctl_mod.F90 sourcefile~dir_trans_ctl_mod.f90~2->sourcefile~ltdir_mod.f90 sourcefile~dir_trans_ctl_mod.f90~2->sourcefile~trltom_pack_unpack.f90 sourcefile~dir_trans_ctlad_mod.f90~2 dir_trans_ctlad_mod.F90 sourcefile~dir_trans_ctlad_mod.f90~2->sourcefile~ltdirad_mod.f90 sourcefile~dir_trans_ctlad_mod.f90~2->sourcefile~trltomad_pack_unpack.f90 sourcefile~dir_transad.f90~2 dir_transad.F90 sourcefile~dir_transad.f90~2->sourcefile~tpm_flt.f90 sourcefile~dir_transad.f90~2->sourcefile~set_resol_mod.f90 sourcefile~dir_trans_ctlad_mod.f90 dir_trans_ctlad_mod.F90 sourcefile~dir_transad.f90~2->sourcefile~dir_trans_ctlad_mod.f90 sourcefile~edealloc_resol_mod.f90 edealloc_resol_mod.F90 sourcefile~edealloc_resol_mod.f90->sourcefile~tpm_flt.f90 sourcefile~esetup_trans.f90 esetup_trans.F90 sourcefile~esetup_trans.f90->sourcefile~tpm_flt.f90 sourcefile~etrans_end.f90 etrans_end.F90 sourcefile~etrans_end.f90->sourcefile~tpm_flt.f90 sourcefile~etrans_end.f90->sourcefile~edealloc_resol_mod.f90 sourcefile~fsc_mod.f90 fsc_mod.F90 sourcefile~fsc_mod.f90->sourcefile~tpm_flt.f90 sourcefile~ftinv_ctl_mod.f90 ftinv_ctl_mod.F90 sourcefile~ftinv_ctl_mod.f90->sourcefile~tpm_flt.f90 sourcefile~ftinv_ctl_mod.f90->sourcefile~fsc_mod.f90 sourcefile~inv_trans.f90 inv_trans.F90 sourcefile~inv_trans.f90->sourcefile~tpm_flt.f90 sourcefile~inv_trans.f90->sourcefile~set_resol_mod.f90 sourcefile~inv_trans_ctl_mod.f90 inv_trans_ctl_mod.F90 sourcefile~inv_trans.f90->sourcefile~inv_trans_ctl_mod.f90 sourcefile~inv_trans_ctl_mod.f90~2 inv_trans_ctl_mod.F90 sourcefile~inv_trans_ctl_mod.f90~2->sourcefile~ltinv_mod.f90 sourcefile~inv_trans_ctl_mod.f90~2->sourcefile~trmtol_pack_unpack.f90 sourcefile~inv_trans_ctl_mod.f90~2->sourcefile~fsc_mod.f90 sourcefile~inv_trans_ctlad_mod.f90 inv_trans_ctlad_mod.F90 sourcefile~inv_trans_ctlad_mod.f90->sourcefile~ltinvad_mod.f90 sourcefile~inv_trans_ctlad_mod.f90->sourcefile~trmtolad_pack_unpack.f90 sourcefile~inv_transad.f90~2 inv_transad.F90 sourcefile~inv_transad.f90~2->sourcefile~tpm_flt.f90 sourcefile~inv_transad.f90~2->sourcefile~inv_trans_ctlad_mod.f90 sourcefile~inv_transad.f90~2->sourcefile~set_resol_mod.f90 sourcefile~ltdir_ctl_mod.f90 ltdir_ctl_mod.F90 sourcefile~ltdir_ctl_mod.f90->sourcefile~ltdir_mod.f90 sourcefile~ltdir_ctlad_mod.f90 ltdir_ctlad_mod.F90 sourcefile~ltdir_ctlad_mod.f90->sourcefile~ltdirad_mod.f90 sourcefile~ltinv_ctl_mod.f90 ltinv_ctl_mod.F90 sourcefile~ltinv_ctl_mod.f90->sourcefile~ltinv_mod.f90 sourcefile~ltinv_ctl_mod.f90->sourcefile~tpm_flt.f90 sourcefile~ltinv_ctlad_mod.f90 ltinv_ctlad_mod.F90 sourcefile~ltinv_ctlad_mod.f90->sourcefile~ltinvad_mod.f90 sourcefile~read_legpol_mod.f90~2 read_legpol_mod.F90 sourcefile~read_legpol_mod.f90~2->sourcefile~tpm_flt.f90 sourcefile~set_resol_mod.f90->sourcefile~tpm_flt.f90 sourcefile~set_resol_mod.f90~2 set_resol_mod.F90 sourcefile~set_resol_mod.f90~2->sourcefile~tpm_flt.f90 sourcefile~setup_trans.f90 setup_trans.F90 sourcefile~setup_trans.f90->sourcefile~suleg_mod.f90 sourcefile~setup_trans.f90->sourcefile~tpm_flt.f90 sourcefile~setup_trans.f90->sourcefile~set_resol_mod.f90 sourcefile~setup_trans.f90~2 setup_trans.F90 sourcefile~setup_trans.f90~2->sourcefile~suleg_mod.f90 sourcefile~setup_trans.f90~2->sourcefile~tpm_flt.f90 sourcefile~setup_trans.f90~2->sourcefile~set_resol_mod.f90 sourcefile~suleg_mod.f90~2 suleg_mod.F90 sourcefile~suleg_mod.f90~2->sourcefile~read_legpol_mod.f90 sourcefile~suleg_mod.f90~2->sourcefile~tpm_flt.f90 sourcefile~suleg_mod.f90~2->sourcefile~write_legpol_mod.f90 sourcefile~trans_end.f90 trans_end.F90 sourcefile~trans_end.f90->sourcefile~tpm_flt.f90 sourcefile~trans_end.f90->sourcefile~dealloc_resol_mod.f90 sourcefile~trans_end.f90->sourcefile~set_resol_mod.f90 sourcefile~trans_end.f90~2 trans_end.F90 sourcefile~trans_end.f90~2->sourcefile~tpm_flt.f90 sourcefile~trans_end.f90~2->sourcefile~dealloc_resol_mod.f90 sourcefile~trans_end.f90~2->sourcefile~set_resol_mod.f90 sourcefile~trans_inq.f90 trans_inq.F90 sourcefile~trans_inq.f90->sourcefile~tpm_flt.f90 sourcefile~trans_inq.f90->sourcefile~set_resol_mod.f90 sourcefile~trans_inq.f90~2 trans_inq.F90 sourcefile~trans_inq.f90~2->sourcefile~tpm_flt.f90 sourcefile~trans_inq.f90~2->sourcefile~set_resol_mod.f90 sourcefile~trans_pnm.f90 trans_pnm.F90 sourcefile~trans_pnm.f90->sourcefile~tpm_flt.f90 sourcefile~trans_pnm.f90->sourcefile~set_resol_mod.f90 sourcefile~trans_pnm.f90~2 trans_pnm.F90 sourcefile~trans_pnm.f90~2->sourcefile~tpm_flt.f90 sourcefile~trans_pnm.f90~2->sourcefile~set_resol_mod.f90 sourcefile~write_legpol_mod.f90~2 write_legpol_mod.F90 sourcefile~write_legpol_mod.f90~2->sourcefile~tpm_flt.f90 sourcefile~dir_trans.f90~2 dir_trans.F90 sourcefile~dir_trans.f90~2->sourcefile~set_resol_mod.f90 sourcefile~dir_trans.f90~2->sourcefile~dir_trans_ctl_mod.f90 sourcefile~dir_trans_ctl_mod.f90->sourcefile~ltdir_ctl_mod.f90 sourcefile~dir_trans_ctlad_mod.f90->sourcefile~ltdir_ctlad_mod.f90 sourcefile~dir_transad.f90 dir_transad.F90 sourcefile~dir_transad.f90->sourcefile~set_resol_mod.f90 sourcefile~dir_transad.f90->sourcefile~dir_trans_ctlad_mod.f90 sourcefile~dist_grid.f90 dist_grid.F90 sourcefile~dist_grid.f90->sourcefile~set_resol_mod.f90 sourcefile~dist_grid.f90~2 dist_grid.F90 sourcefile~dist_grid.f90~2->sourcefile~set_resol_mod.f90 sourcefile~dist_grid_32.f90 dist_grid_32.F90 sourcefile~dist_grid_32.f90->sourcefile~set_resol_mod.f90 sourcefile~dist_grid_32.f90~2 dist_grid_32.F90 sourcefile~dist_grid_32.f90~2->sourcefile~set_resol_mod.f90 sourcefile~dist_spec.f90 dist_spec.F90 sourcefile~dist_spec.f90->sourcefile~set_resol_mod.f90 sourcefile~dist_spec.f90~2 dist_spec.F90 sourcefile~dist_spec.f90~2->sourcefile~set_resol_mod.f90 sourcefile~etrans_release.f90 etrans_release.F90 sourcefile~etrans_release.f90->sourcefile~edealloc_resol_mod.f90 sourcefile~gath_grid.f90 gath_grid.F90 sourcefile~gath_grid.f90->sourcefile~set_resol_mod.f90 sourcefile~gath_grid.f90~2 gath_grid.F90 sourcefile~gath_grid.f90~2->sourcefile~set_resol_mod.f90 sourcefile~gath_grid_32.f90 gath_grid_32.F90 sourcefile~gath_grid_32.f90->sourcefile~set_resol_mod.f90 sourcefile~gath_grid_32.f90~2 gath_grid_32.F90 sourcefile~gath_grid_32.f90~2->sourcefile~set_resol_mod.f90 sourcefile~gath_spec.f90 gath_spec.F90 sourcefile~gath_spec.f90->sourcefile~set_resol_mod.f90 sourcefile~gath_spec.f90~2 gath_spec.F90 sourcefile~gath_spec.f90~2->sourcefile~set_resol_mod.f90 sourcefile~gpnorm_trans.f90 gpnorm_trans.F90 sourcefile~gpnorm_trans.f90->sourcefile~set_resol_mod.f90 sourcefile~gpnorm_trans.f90~2 gpnorm_trans.F90 sourcefile~gpnorm_trans.f90~2->sourcefile~set_resol_mod.f90 sourcefile~gpnorm_trans_gpu.f90 gpnorm_trans_gpu.F90 sourcefile~gpnorm_trans_gpu.f90->sourcefile~set_resol_mod.f90 sourcefile~gpnorm_transad.f90 gpnorm_transad.F90 sourcefile~gpnorm_transad.f90->sourcefile~set_resol_mod.f90 sourcefile~gpnorm_transtl.f90~2 gpnorm_transtl.F90 sourcefile~gpnorm_transtl.f90~2->sourcefile~set_resol_mod.f90 sourcefile~inv_trans.f90~2 inv_trans.F90 sourcefile~inv_trans.f90~2->sourcefile~set_resol_mod.f90 sourcefile~inv_trans.f90~2->sourcefile~inv_trans_ctl_mod.f90 sourcefile~inv_trans_ctl_mod.f90->sourcefile~ftinv_ctl_mod.f90 sourcefile~inv_trans_ctl_mod.f90->sourcefile~ltinv_ctl_mod.f90 sourcefile~inv_trans_ctlad_mod.f90~2 inv_trans_ctlad_mod.F90 sourcefile~inv_trans_ctlad_mod.f90~2->sourcefile~ltinv_ctlad_mod.f90 sourcefile~inv_transad.f90 inv_transad.F90 sourcefile~inv_transad.f90->sourcefile~inv_trans_ctlad_mod.f90 sourcefile~inv_transad.f90->sourcefile~set_resol_mod.f90 sourcefile~specnorm.f90 specnorm.F90 sourcefile~specnorm.f90->sourcefile~set_resol_mod.f90 sourcefile~specnorm.f90~2 specnorm.F90 sourcefile~specnorm.f90~2->sourcefile~set_resol_mod.f90 sourcefile~trans_release.f90 trans_release.F90 sourcefile~trans_release.f90->sourcefile~dealloc_resol_mod.f90 sourcefile~trans_release.f90~2 trans_release.F90 sourcefile~trans_release.f90~2->sourcefile~dealloc_resol_mod.f90 sourcefile~vordiv_to_uv.f90 vordiv_to_uv.F90 sourcefile~vordiv_to_uv.f90->sourcefile~set_resol_mod.f90 sourcefile~vordiv_to_uv.f90~2 vordiv_to_uv.F90 sourcefile~vordiv_to_uv.f90~2->sourcefile~set_resol_mod.f90

Source Code

! (C) Copyright 2024- ECMWF.
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!

!====================================================================
MODULE ECTRANS_BLAS_MOD
!====================================================================
! Author: Willem Deconinck (ECMWF)
!
! This module provides interfaces for BLAS  routines such as
! DGEMM/SGEMM and DGEMV/SGEMV
! The correct overload is used depending on the precision of the arguments
!====================================================================


USE EC_PARKIND, ONLY : JPRD, JPRM, JPIM

IMPLICIT NONE

PRIVATE

PUBLIC :: GEMM, GEMV

!---------------------------------------------------------------------

INTERFACE GEMM
! GEMM  performs one of the matrix-matrix operations
!
!    C := alpha*op( A )*op( B ) + beta*C,
!
! where  op( X ) is one of
!
!    op( X ) = X   or   op( X ) = X**T,
!
! alpha and beta are scalars, and A, B and C are matrices, with op( A )
! an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.

  ! SGEMM
  MODULE PROCEDURE GEMM_SP         ! Matrix arguments as array, (alpha,beta) in SP
  MODULE PROCEDURE GEMM_SP_DP      ! Matrix arguments as array, (alpha,beta) in DP
  MODULE PROCEDURE GEMM_SCAL_SP    ! Matrix arguments as scalar (address), (alpha,beta) in SP
  MODULE PROCEDURE GEMM_SCAL_SP_DP ! Matrix arguments as scalar (address), (alpha,beta) in DP

  ! DGEMM
  MODULE PROCEDURE GEMM_DP         ! Matrix arguments as array, (alpha,beta) in DP
  MODULE PROCEDURE GEMM_DP_SP      ! Matrix arguments as array, (alpha,beta) in SP
  MODULE PROCEDURE GEMM_SCAL_DP    ! Matrix arguments as scalar (address), (alpha,beta) in DP
  MODULE PROCEDURE GEMM_SCAL_DP_SP ! Matrix arguments as scalar (address), (alpha,beta) in SP
END INTERFACE

!---------------------------------------------------------------------

INTERFACE GEMV
! GEMV  performs one of the matrix-vector operations
!
!    y := alpha*A*x + beta*y,   or   y := alpha*A**T*x + beta*y,
!
! where alpha and beta are scalars, x and y are vectors and A is an
! m by n matrix.

  ! SGEMV
  MODULE PROCEDURE GEMV_SP         ! Matrix/Vector arguments as array, (alpha,beta) in SP
  MODULE PROCEDURE GEMV_SP_DP      ! Matrix/Vector arguments as array, (alpha,beta) in DP
  MODULE PROCEDURE GEMV_SCAL_SP    ! Matrix/Vector arguments as scalar (address), (alpha,beta) in SP
  MODULE PROCEDURE GEMV_SCAL_SP_DP ! Matrix/Vector arguments as scalar (address), (alpha,beta) in DP

  ! DGEMV
  MODULE PROCEDURE GEMV_DP         ! Matrix/Vector arguments as array, (alpha,beta) in DP
  MODULE PROCEDURE GEMV_DP_SP      ! Matrix/Vector arguments as array, (alpha,beta) in SP
  MODULE PROCEDURE GEMV_SCAL_DP    ! Matrix/Vector arguments as scalar (address), (alpha,beta) in DP
  MODULE PROCEDURE GEMV_SCAL_DP_SP ! Matrix/Vector arguments as scalar (address), (alpha,beta) in SP
END INTERFACE

!---------------------------------------------------------------------

!====================================================================
CONTAINS
!====================================================================

SUBROUTINE GEMM_SCAL_DP(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
  REAL(KIND=JPRD)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: K, LDA, LDB, LDC, M, N
  CHARACTER           ,INTENT(IN)    :: TRANSA, TRANSB
  REAL(KIND=JPRD)     ,INTENT(IN)    :: A, B
  REAL(KIND=JPRD)     ,INTENT(INOUT) :: C

  CALL DGEMM(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)

END SUBROUTINE GEMM_SCAL_DP

!---------------------------------------------------------------------

SUBROUTINE GEMM_SCAL_DP_SP(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
  REAL(KIND=JPRM)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: K, LDA, LDB, LDC, M, N
  CHARACTER           ,INTENT(IN)    :: TRANSA, TRANSB
  REAL(KIND=JPRD)     ,INTENT(IN)    :: A, B
  REAL(KIND=JPRD)     ,INTENT(INOUT) :: C

  CALL GEMM_SCAL_DP(TRANSA, TRANSB, M, N, K, REAL(ALPHA,JPRD), A, LDA, B, LDB, REAL(BETA,JPRD), C, LDC)

END SUBROUTINE GEMM_SCAL_DP_SP

!---------------------------------------------------------------------

SUBROUTINE GEMM_DP(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
  REAL(KIND=JPRD)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: K, LDA, LDB, LDC, M, N
  CHARACTER           ,INTENT(IN)    :: TRANSA, TRANSB
  REAL(KIND=JPRD)     ,INTENT(IN)    :: A(LDA,*), B(LDB,*)
  REAL(KIND=JPRD)     ,INTENT(INOUT) :: C(LDC,*)

  CALL GEMM_SCAL_DP(TRANSA, TRANSB, M, N, K, ALPHA, A(1,1), LDA, B(1,1), LDB, BETA, C(1,1), LDC)

END SUBROUTINE GEMM_DP

!---------------------------------------------------------------------

SUBROUTINE GEMM_DP_SP(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
  REAL(KIND=JPRM)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: K, LDA, LDB, LDC, M, N
  CHARACTER           ,INTENT(IN)    :: TRANSA, TRANSB
  REAL(KIND=JPRD)     ,INTENT(IN)    :: A(LDA,*), B(LDB,*)
  REAL(KIND=JPRD)     ,INTENT(INOUT) :: C(LDC,*)

  CALL GEMM_SCAL_DP(TRANSA, TRANSB, M, N, K, REAL(ALPHA,JPRD), A(1,1), LDA, B(1,1), LDB, REAL(BETA,JPRD), C(1,1), LDC)

END SUBROUTINE GEMM_DP_SP

!---------------------------------------------------------------------

SUBROUTINE GEMM_SCAL_SP(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
  USE, INTRINSIC :: IEEE_EXCEPTIONS, ONLY : IEEE_GET_HALTING_MODE, IEEE_SET_HALTING_MODE, IEEE_INVALID

  REAL(KIND=JPRM)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: K, LDA, LDB, LDC, M, N
  CHARACTER           ,INTENT(IN)    :: TRANSA, TRANSB
  REAL(KIND=JPRM)     ,INTENT(IN)    :: A, B
  REAL(KIND=JPRM)     ,INTENT(INOUT) :: C

#ifdef WITH_IEEE_HALT
  LOGICAL, PARAMETER :: LL_IEEE_HALT = .TRUE.
#else
  LOGICAL, PARAMETER :: LL_IEEE_HALT = .FALSE.
#endif
  LOGICAL :: LL_HALT_INVALID = .FALSE.

  IF (LL_IEEE_HALT) THEN
    CALL IEEE_GET_HALTING_MODE(IEEE_INVALID,LL_HALT_INVALID)
    IF (LL_HALT_INVALID) CALL IEEE_SET_HALTING_MODE(IEEE_INVALID, .FALSE.)
  ENDIF

  CALL SGEMM(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)

  IF (LL_IEEE_HALT .AND. LL_HALT_INVALID) CALL IEEE_SET_HALTING_MODE(IEEE_INVALID, .TRUE.)

END SUBROUTINE GEMM_SCAL_SP

!---------------------------------------------------------------------

SUBROUTINE GEMM_SCAL_SP_DP(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
  REAL(KIND=JPRD)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: K, LDA, LDB, LDC, M, N
  CHARACTER           ,INTENT(IN)    :: TRANSA, TRANSB
  REAL(KIND=JPRM)     ,INTENT(IN)    :: A, B
  REAL(KIND=JPRM)     ,INTENT(INOUT) :: C

  CALL GEMM_SCAL_SP(TRANSA, TRANSB, M, N, K, REAL(ALPHA,JPRM), A, LDA, B, LDB, REAL(BETA,JPRM), C, LDC)

END SUBROUTINE GEMM_SCAL_SP_DP

!---------------------------------------------------------------------

SUBROUTINE GEMM_SP(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
  REAL(KIND=JPRM)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: K, LDA, LDB, LDC, M, N
  CHARACTER           ,INTENT(IN)    :: TRANSA, TRANSB
  REAL(KIND=JPRM)     ,INTENT(IN)    :: A(LDA,*), B(LDB,*)
  REAL(KIND=JPRM)     ,INTENT(INOUT) :: C(LDC,*)

  CALL GEMM_SCAL_SP(TRANSA, TRANSB, M, N, K, ALPHA, A(1,1), LDA, B(1,1), LDB, BETA, C(1,1), LDC)

END SUBROUTINE GEMM_SP

!---------------------------------------------------------------------

SUBROUTINE GEMM_SP_DP(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
  REAL(KIND=JPRD)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: K, LDA, LDB, LDC, M, N
  CHARACTER           ,INTENT(IN)    :: TRANSA, TRANSB
  REAL(KIND=JPRM)     ,INTENT(IN)    :: A(LDA,*), B(LDB,*)
  REAL(KIND=JPRM)     ,INTENT(INOUT) :: C(LDC,*)

  CALL GEMM_SCAL_SP(TRANSA, TRANSB, M, N, K, REAL(ALPHA,JPRM), A(1,1), LDA, B(1,1), LDB, REAL(BETA,JPRM), C(1,1), LDC)

END SUBROUTINE GEMM_SP_DP

!---------------------------------------------------------------------

SUBROUTINE GEMV_SCAL_SP(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
  REAL(KIND=JPRM)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: LDA, INCX, INCY, M, N
  CHARACTER           ,INTENT(IN)    :: TRANS
  REAL(KIND=JPRM)     ,INTENT(IN)    :: A, X
  REAL(KIND=JPRM)     ,INTENT(INOUT) :: Y

  CALL SGEMV(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)

END SUBROUTINE GEMV_SCAL_SP

!---------------------------------------------------------------------

SUBROUTINE GEMV_SCAL_SP_DP(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
  REAL(KIND=JPRD)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: LDA, INCX, INCY, M, N
  CHARACTER           ,INTENT(IN)    :: TRANS
  REAL(KIND=JPRM)     ,INTENT(IN)    :: A, X
  REAL(KIND=JPRM)     ,INTENT(INOUT) :: Y

  CALL GEMV_SCAL_SP(TRANS, M, N, REAL(ALPHA,JPRM), A, LDA, X, INCX, REAL(BETA,JPRM), Y, INCY)

END SUBROUTINE GEMV_SCAL_SP_DP

!---------------------------------------------------------------------

SUBROUTINE GEMV_SP(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
  REAL(KIND=JPRM)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: LDA, INCX, INCY, M, N
  CHARACTER           ,INTENT(IN)    :: TRANS
  REAL(KIND=JPRM)     ,INTENT(IN)    :: A(:,:), X(:)
  REAL(KIND=JPRM)     ,INTENT(INOUT) :: Y(:)

  CALL GEMV_SCAL_SP(TRANS, M, N, ALPHA, A(1,1), LDA, X(1), INCX, BETA, Y(1), INCY)

END SUBROUTINE GEMV_SP

!---------------------------------------------------------------------

SUBROUTINE GEMV_SP_DP(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
  REAL(KIND=JPRD)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: LDA, INCX, INCY, M, N
  CHARACTER           ,INTENT(IN)    :: TRANS
  REAL(KIND=JPRM)     ,INTENT(IN)    :: A(:,:), X(:)
  REAL(KIND=JPRM)     ,INTENT(INOUT) :: Y(:)

  CALL GEMV_SCAL_SP(TRANS, M, N, REAL(ALPHA,JPRM), A(1,1), LDA, X(1), INCX, REAL(BETA,JPRM), Y(1), INCY)

END SUBROUTINE GEMV_SP_DP

!---------------------------------------------------------------------

SUBROUTINE GEMV_SCAL_DP(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
  REAL(KIND=JPRD)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: LDA, INCX, INCY, M, N
  CHARACTER           ,INTENT(IN)    :: TRANS
  REAL(KIND=JPRD)     ,INTENT(IN)    :: A, X
  REAL(KIND=JPRD)     ,INTENT(INOUT) :: Y

  CALL DGEMV(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)

END SUBROUTINE GEMV_SCAL_DP

!---------------------------------------------------------------------

SUBROUTINE GEMV_SCAL_DP_SP(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
  REAL(KIND=JPRM)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: LDA, INCX, INCY, M, N
  CHARACTER           ,INTENT(IN)    :: TRANS
  REAL(KIND=JPRD)     ,INTENT(IN)    :: A, X
  REAL(KIND=JPRD)     ,INTENT(INOUT) :: Y

  CALL GEMV_SCAL_DP(TRANS, M, N, REAL(ALPHA,JPRD), A, LDA, X, INCX, REAL(BETA,JPRD), Y, INCY)

END SUBROUTINE GEMV_SCAL_DP_SP

!---------------------------------------------------------------------

SUBROUTINE GEMV_DP(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
  REAL(KIND=JPRD)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: LDA, INCX, INCY, M, N
  CHARACTER           ,INTENT(IN)    :: TRANS
  REAL(KIND=JPRD)     ,INTENT(IN)    :: A(:,:), X(:)
  REAL(KIND=JPRD)     ,INTENT(INOUT) :: Y(:)

  CALL GEMV_SCAL_DP(TRANS, M, N, ALPHA, A(1,1), LDA, X(1), INCX, BETA, Y(1), INCY)

END SUBROUTINE GEMV_DP

!---------------------------------------------------------------------

SUBROUTINE GEMV_DP_SP(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
  REAL(KIND=JPRM)     ,INTENT(IN)    :: ALPHA, BETA
  INTEGER(KIND=JPIM)  ,INTENT(IN)    :: LDA, INCX, INCY, M, N
  CHARACTER           ,INTENT(IN)    :: TRANS
  REAL(KIND=JPRD)     ,INTENT(IN)    :: A(:,:), X(:)
  REAL(KIND=JPRD)     ,INTENT(INOUT) :: Y(:)

  CALL GEMV_SCAL_DP(TRANS, M, N, REAL(ALPHA,JPRD), A(1,1), LDA, X(1), INCX, REAL(BETA,JPRD), Y(1), INCY)

END SUBROUTINE GEMV_DP_SP

!====================================================================

END MODULE ECTRANS_BLAS_MOD