Skip to content

Commit

Permalink
Create BLAS interfaces for GEMM and GEMV
Browse files Browse the repository at this point in the history
  • Loading branch information
@wdeconinck
wdeconinck committed Mar 1, 2024
1 parent dd47b5f commit 15baed7
Show file tree
Hide file tree
Showing 7 changed files with 375 additions and 227 deletions.
2 changes: 2 additions & 0 deletions src/trans/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,7 @@ endif()

## Sources which are precision independent can go into a common library
list( APPEND ectrans_common_src
algor/ectrans_blas_mod.F90
sharedmem/sharedmem_mod.F90
sharedmem/sharedmem.c
internal/abort_trans_mod.F90
Expand Down Expand Up @@ -76,6 +77,7 @@ ecbuild_add_library(
LINKER_LANGUAGE Fortran
SOURCES ${ectrans_common_src}
PUBLIC_LIBS fiat
PRIVATE_LIBS ${LAPACK_LIBRARIES}
)
ectrans_target_fortran_module_directory(
TARGET ectrans_common
Expand Down
167 changes: 38 additions & 129 deletions src/trans/algor/butterfly_alg_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,7 @@ MODULE BUTTERFLY_ALG_MOD
USE PARKIND1, ONLY : JPRD, JPRM, JPIM, JPRB, JPIB
USE INTERPOL_DECOMP_MOD, ONLY : COMPUTE_ID
USE SHAREDMEM_MOD, ONLY : SHAREDMEM, SHAREDMEM_ASSOCIATE

use, intrinsic :: ieee_exceptions
USE ECTRANS_BLAS_MOD, ONLY : GEMM, GEMV

IMPLICIT NONE

Expand Down Expand Up @@ -64,12 +63,6 @@ MODULE BUTTERFLY_ALG_MOD
REAL(KIND=JPRB) , ALLOCATABLE :: COMMSBUF(:) ! for communicating packed bufferfly_structs
END TYPE CLONE ! between MPI tasks

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

LOGICAL, PARAMETER :: LLDOUBLE = (JPRB == JPRD)

CONTAINS
Expand Down Expand Up @@ -610,15 +603,9 @@ SUBROUTINE MULT_BUTV(CDTRANS,YD_STRUCT,PVECIN,PVECOUT)
IFR = YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IFROW
ILR = YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%ILROW
IROWS=YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IROWS
IF (LLDOUBLE) THEN
CALL DGEMV('T',IROWS,YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IRANK,&
& 1.0_JPRD,YNODE%B,IROWS,PVECIN(IFR:ILR),1,&
& 0.0_JPRD,ZBETA(IBTST:IBTEN,IBETALV),1)
ELSE
CALL SGEMV('T',IROWS,YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IRANK,&
& 1.0_JPRM,YNODE%B,IROWS,PVECIN(IFR:ILR),1,&
& 0.0_JPRM,ZBETA(IBTST:IBTEN,IBETALV),1)
ENDIF
CALL GEMV('T',IROWS,YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IRANK,&
& 1.0_JPRB,YNODE%B,IROWS,PVECIN(IFR:ILR),1,&
& 0.0_JPRB,ZBETA(IBTST:IBTEN,IBETALV),1)
ENDIF
ILM1 = JL-1
IBETALVM1=MOD(ILM1,2)
Expand Down Expand Up @@ -689,15 +676,9 @@ SUBROUTINE MULT_BUTV(CDTRANS,YD_STRUCT,PVECIN,PVECOUT)
IFR = YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IFROW
ILR = YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%ILROW
IROWS = YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IROWS
IF (LLDOUBLE) THEN
CALL DGEMV('N',IROWS,YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IRANK,&
& 1.0_JPRD,YNODE%B,IROWS,ZBETA(IBTST:IBTEN,IBETALV),1,&
& 0.0_JPRD,PVECOUT(IFR:ILR),1)
ELSE
CALL SGEMV('N',IROWS,YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IRANK,&
& 1.0_JPRM,YNODE%B,IROWS,ZBETA(IBTST:IBTEN,IBETALV),1,&
& 0.0_JPRM,PVECOUT(IFR:ILR),1)
ENDIF
CALL GEMV('N',IROWS,YD_STRUCT%SLEV(ILEVS)%NODE(JJ,JK)%IRANK,&
& 1.0_JPRB,YNODE%B,IROWS,ZBETA(IBTST:IBTEN,IBETALV),1,&
& 0.0_JPRB,PVECOUT(IFR:ILR),1)
ENDIF
ENDDO
ENDDO
Expand All @@ -724,7 +705,6 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV)
REAL(KIND=JPRB) :: ZVECIN(YD_STRUCT%N_ORDER,KF),ZVECOUT(YD_STRUCT%N_ORDER,KF)
REAL(KIND=JPRB),ALLOCATABLE :: ZBETA(:,:,:)
LOGICAL :: LLTRANSPOSE
LOGICAL :: LL_HALT_INVALID

! IKWV==0 only, LLTRANSPOSE = true only
REAL(KIND=JPRD),ALLOCATABLE :: ZPNONIM_D(:,:)
Expand Down Expand Up @@ -770,7 +750,7 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV)
IF( IM <=0 ) CALL ABOR1('mult_butm: IM<=0 not allowed')
IF(IN>0) THEN
IF (LLDOUBLE.OR.(IKWV == 0)) THEN
IF(.not.LLDOUBLE) THEN
IF(.NOT.LLDOUBLE) THEN
ALLOCATE(ZPNONIM_D(IM,IN))
II=0
DO JN=1,IN
Expand All @@ -780,25 +760,20 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV)
ENDDO
ENDDO
ZBETA_D(1:IM,1:KF)=REAL(ZBETA(IBTST:IBTST+IM-1,1:KF,IBETALV),JPRD)
CALL DGEMM('T','N',IN,KF,IM,1.0_JPRD,&
& ZPNONIM_D,IM,ZBETA_D,ILBETA,0.0_JPRD,&
& ZOUT_D,YD_STRUCT%N_ORDER)
CALL GEMM('T','N',IN,KF,IM,1.0_JPRD,&
& ZPNONIM_D(1,1),IM,ZBETA_D(1,1),ILBETA,0.0_JPRD,&
& ZOUT_D(1,1),YD_STRUCT%N_ORDER)
ZVECOUT(YNODE%IRANK+1:YNODE%IRANK+IN,1:KF) = REAL(ZOUT_D(1:IN,1:KF),JPRM)
DEALLOCATE(ZPNONIM_D)
ELSE
CALL DGEMM('T','N',IN,KF,IM,1.0_JPRD,&
CALL GEMM('T','N',IN,KF,IM,1.0_JPRD,&
& YNODE%PNONIM(1),IM,ZBETA(IBTST,1,IBETALV),ILBETA,0.0_JPRD,&
& ZVECOUT(YNODE%IRANK+1,1),YD_STRUCT%N_ORDER)
ENDIF
ELSE
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('T','N',IN,KF,IM,1.0_JPRM,&
CALL GEMM('T','N',IN,KF,IM,1.0_JPRM,&
& YNODE%PNONIM(1),IM,ZBETA(IBTST,1,IBETALV),ILBETA,0.0_JPRM,&
& ZVECOUT(YNODE%IRANK+1,1),YD_STRUCT%N_ORDER)
if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.)
ENDIF
ENDIF
DO JF=1,KF
Expand All @@ -818,32 +793,27 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV)
IROWS =YNODE%IROWS
IRANK = YNODE%IRANK
IF (LLDOUBLE.OR.(IKWV == 0)) THEN
IF(.not.LLDOUBLE) THEN
IF(.NOT.LLDOUBLE) THEN
ALLOCATE(ZB_D(IROWS,IRANK))
ZB_D(1:IROWS,1:IRANK) = REAL(YNODE%B(1:IROWS,1:IRANK),JPRD)
ZIN_D(1:ILR-IFR+1,1:KF) = REAL(PVECIN(IFR:ILR,1:KF),JPRD)

CALL DGEMM('T','N',IRANK,KF,IROWS,1.0_JPRD,&
CALL GEMM('T','N',IRANK,KF,IROWS,1.0_JPRD,&
& ZB_D,IROWS,ZIN_D,IRIN,0.0_JPRD,&
& ZBETA_D,ILBETA)

ZBETA(IBTST:IBTST+IRANK-1,1:KF,IBETALV)=REAL(ZBETA_D(1:IRANK,1:KF),JPRM)
DEALLOCATE(ZB_D)

ELSE
CALL DGEMM('T','N',IRANK,KF,IROWS,1.0_JPRD,&
& YNODE%B,IROWS,PVECIN(IFR,1),IRIN,0.0_JPRD,&
CALL GEMM('T','N',IRANK,KF,IROWS,1.0_JPRD,&
& YNODE%B(1,1),IROWS,PVECIN(IFR,1),IRIN,0.0_JPRD,&
& ZBETA(IBTST,1,IBETALV),ILBETA)
END IF
ELSE
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('T','N',IRANK,KF,IROWS,1.0_JPRM,&
& YNODE%B,IROWS,PVECIN(IFR,1),IRIN,0.0_JPRM,&
CALL GEMM('T','N',IRANK,KF,IROWS,1.0_JPRM,&
& YNODE%B(1,1),IROWS,PVECIN(IFR,1),IRIN,0.0_JPRM,&
& ZBETA(IBTST,1,IBETALV),ILBETA)
if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.)
ENDIF
ENDIF
ILM1 = JL-1
Expand All @@ -867,7 +837,7 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV)
IF( IM <=0 ) CALL ABOR1('mult_butm: IM<=0 not allowed')
IF(IN>0) THEN
IF (LLDOUBLE.OR.(IKWV == 0)) THEN
IF(.not.LLDOUBLE) THEN
IF(.NOT.LLDOUBLE) THEN
ALLOCATE(ZPNONIM_D(IM,IN))
II=0
DO JN=1,IN
Expand All @@ -878,26 +848,21 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV)
ENDDO
ZBETA_D(1:IM,1:KF)=REAL(ZBETA(IBTST:IBTST+IM-1,1:KF,IBETALV),JPRD)

CALL DGEMM('T','N',IN,KF,IM,1.0_JPRD,&
CALL GEMM('T','N',IN,KF,IM,1.0_JPRD,&
& ZPNONIM_D,IM,ZBETA_D,ILBETA,0.0_JPRD,&
& ZOUT_D,YD_STRUCT%N_ORDER)

ZVECOUT(YNODE%IRANK+1:YNODE%IRANK+IN,1:KF) = REAL(ZOUT_D(1:IN,1:KF),JPRM)
DEALLOCATE(ZPNONIM_D)
ELSE
CALL DGEMM('T','N',IN,KF,IM,1.0_JPRD,&
CALL GEMM('T','N',IN,KF,IM,1.0_JPRD,&
& YNODE%PNONIM(1),IM,ZBETA(IBTST,1,IBETALV),ILBETA,0.0_JPRD,&
& ZVECOUT(YNODE%IRANK+1,1),YD_STRUCT%N_ORDER)
ENDIF
ELSE
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('T','N',IN,KF,IM,1.0_JPRM,&
CALL GEMM('T','N',IN,KF,IM,1.0_JPRM,&
& YNODE%PNONIM(1),IM,ZBETA(IBTST,1,IBETALV),ILBETA,0.0_JPRM,&
& ZVECOUT(YNODE%IRANK+1,1),YD_STRUCT%N_ORDER)
if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.)
ENDIF
ENDIF
DO JF=1,KF
Expand Down Expand Up @@ -963,20 +928,9 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV)
ENDDO
IF( IRANK <=0 ) CALL ABOR1('mult_butm: IRANK<=0 not allowed')
IF(YNODE%ICOLS > IRANK) THEN
IF (LLDOUBLE) THEN
CALL DGEMM('N','N',IRANK,KF,IN,1.0_JPRD,&
& YNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YD_STRUCT%N_ORDER,1.0_JPRD,&
CALL GEMM('N','N',IRANK,KF,IN,1.0_JPRB,&
& YNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YD_STRUCT%N_ORDER,1.0_JPRB,&
& ZBETA(IBTST,1,IBETALV),ILBETA)
ELSE
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('N','N',IRANK,KF,IN,1.0_JPRM,&
& YNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YD_STRUCT%N_ORDER,1.0_JPRM,&
& ZBETA(IBTST,1,IBETALV),ILBETA)
if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.)
ENDIF
ENDIF
ELSE
ILM1 = JL-1
Expand Down Expand Up @@ -1011,41 +965,19 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV)
ENDDO
IF( IRANK <=0 ) CALL ABOR1('mult_butm: IRANK<=0 not allowed')
IF(YNODE%ICOLS > IRANK) THEN
IF (LLDOUBLE) THEN
CALL DGEMM('N','N',IRANK,KF,IN,1.0_JPRD,&
& YNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YD_STRUCT%N_ORDER,1.0_JPRD,&
CALL GEMM('N','N',IRANK,KF,IN,1.0_JPRB,&
& YNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YD_STRUCT%N_ORDER,1.0_JPRB,&
& ZBETA(IBTST,1,IBETALV),ILBETA)
ELSE
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('N','N',IRANK,KF,IN,1.0_JPRM,&
& YNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YD_STRUCT%N_ORDER,1.0_JPRM,&
& ZBETA(IBTST,1,IBETALV),ILBETA)
if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.)
ENDIF
ENDIF
ENDIF
IF( IRANK <=0 ) CALL ABOR1('mult_butm: IRANK<=0 not allowed')
IF(JL == ILEVS) THEN
IFR = YNODE%IFROW
ILR = YNODE%ILROW
IROWS = YNODE%IROWS
IF (LLDOUBLE) THEN
CALL DGEMM('N','N',IROWS,KF,YNODE%IRANK,1.0_JPRD,&
& YNODE%B,IROWS,ZBETA(IBTST,1,IBETALV),YD_STRUCT%IBETALEN_MAX,0.0_JPRD,&
CALL GEMM('N','N',IROWS,KF,YNODE%IRANK,1.0_JPRB,&
& YNODE%B(1,1),IROWS,ZBETA(IBTST,1,IBETALV),YD_STRUCT%IBETALEN_MAX,0.0_JPRB,&
& PVECOUT(IFR,1),IROUT)
ELSE
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('N','N',IROWS,KF,YNODE%IRANK,1.0_JPRM,&
& YNODE%B,IROWS,ZBETA(IBTST,1,IBETALV),YD_STRUCT%IBETALEN_MAX,0.0_JPRM,&
& PVECOUT(IFR,1),IROUT)
if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.)
ENDIF
ENDIF
ENDDO
ENDDO
Expand Down Expand Up @@ -1079,10 +1011,10 @@ SUBROUTINE MULT_P(YDNODE,PVECIN,PVECOUT)
IM = IRANK
IN = YDNODE%ICOLS-IRANK
IF (JPRB == JPRD) THEN
CALL DGEMV('N',IM,IN,1.0_JPRD,YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1),1,1.0_JPRD,ZVECOUT,1)
CALL GEMV('N',IM,IN,1.0_JPRD,YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1),1,1.0_JPRD,ZVECOUT(1),1)
PVECOUT(:)=ZVECOUT(:)
ELSE
CALL SGEMV('N',IM,IN,1.0_JPRM,YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1),1,1.0_JPRM,PVECOUT,1)
CALL GEMV('N',IM,IN,1.0_JPRM,YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1),1,1.0_JPRM,PVECOUT(1),1)
ENDIF
ENDIF

Expand All @@ -1100,7 +1032,6 @@ SUBROUTINE MULT_PM(YDNODE,KF,KLBETA,PVECIN,PVECOUT)
REAL(KIND=JPRB) :: ZVECIN(YDNODE%ICOLS,KF), ZVECOUT(SIZE(PVECOUT(:,1)),KF)
INTEGER(KIND=JPIM) :: JN,IDX,IRANK,IM,IN,JF

LOGICAL :: LL_HALT_INVALID
!---------------------------------------------------------

IRANK = YDNODE%IRANK
Expand All @@ -1117,20 +1048,9 @@ SUBROUTINE MULT_PM(YDNODE,KF,KLBETA,PVECIN,PVECOUT)
ENDDO
ENDDO
IF(YDNODE%ICOLS > IRANK) THEN
IF (JPRB == JPRD) THEN
CALL DGEMM('N','N',IRANK,KF,IN,1.0_JPRD,&
& YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YDNODE%ICOLS,1.0_JPRD,&
& PVECOUT,IRANK)
ELSE
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('N','N',IRANK,KF,IN,1.0_JPRM,&
& YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YDNODE%ICOLS,1.0_JPRM,&
& PVECOUT,IRANK)
if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.)
ENDIF
CALL GEMM('N','N',IRANK,KF,IN,1.0_JPRB,&
& YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YDNODE%ICOLS,1.0_JPRB,&
& PVECOUT(1,1),IRANK)
ENDIF
END SUBROUTINE MULT_PM
!==================================================================
Expand All @@ -1151,9 +1071,9 @@ SUBROUTINE MULT_P_TR(YDNODE,PVECIN,PVECOUT)
IM = IRANK
IF (JPRB == JPRD) THEN
ZVECIN(:) = PVECIN(:)
CALL DGEMV('T',IM,IN,1.0_JPRD,YDNODE%PNONIM,IRANK,ZVECIN,1,0.0_JPRD,ZVECOUT(IRANK+1),1)
CALL GEMV('T',IM,IN,1.0_JPRD,YDNODE%PNONIM(1),IRANK,ZVECIN(1),1,0.0_JPRD,ZVECOUT(IRANK+1),1)
ELSE
CALL SGEMV('T',IM,IN,1.0_JPRM,YDNODE%PNONIM,IRANK,PVECIN,1,0.0_JPRM,ZVECOUT(IRANK+1),1)
CALL GEMV('T',IM,IN,1.0_JPRM,YDNODE%PNONIM(1),IRANK,PVECIN(1),1,0.0_JPRM,ZVECOUT(IRANK+1),1)
ENDIF
ENDIF
DO JK=1,IRANK
Expand All @@ -1178,27 +1098,16 @@ SUBROUTINE MULT_P_TRM(YDNODE,KF,PVECIN,PVECOUT)
REAL(KIND=JPRB) :: ZVECOUT(YDNODE%ICOLS,KF), ZVECIN(SIZE(PVECIN(:,1)),KF)
INTEGER(KIND=JPIM) :: JK,JN,IDX,IM,IN,JF

LOGICAL :: LL_HALT_INVALID

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

IN = YDNODE%ICOLS-YDNODE%IRANK
IM = YDNODE%IRANK
IF(IN>0) THEN
IF (JPRB == JPRD) THEN
ZVECIN(:,:) = PVECIN(:,:)
CALL DGEMM('T','N',IN,KF,IM,1.0_JPRD,&
& YDNODE%PNONIM(1),IM,ZVECIN,IM,0.0_JPRD,&
& ZVECOUT(YDNODE%IRANK+1,1),YDNODE%ICOLS)
CALL GEMM('T','N',IN,KF,IM,1.0_JPRD,YDNODE%PNONIM(1),IM,ZVECIN(1,1),IM,0.0_JPRD,ZVECOUT(YDNODE%IRANK+1,1),YDNODE%ICOLS)
ELSE
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('T','N',IN,KF,IM,1.0_JPRM,&
& YDNODE%PNONIM(1),IM,PVECIN,IM,0.0_JPRM,&
& ZVECOUT(YDNODE%IRANK+1,1),YDNODE%ICOLS)
if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.)
CALL GEMM('T','N',IN,KF,IM,1.0_JPRM,YDNODE%PNONIM(1),IM,PVECIN(1,1),IM,0.0_JPRM,ZVECOUT(YDNODE%IRANK+1,1),YDNODE%ICOLS)
ENDIF
ENDIF
DO JF=1,KF
Expand Down
Loading

0 comments on commit 15baed7

Please sign in to comment.