From d9fd985f5318d409705b1d8a7f80434187ea82ac Mon Sep 17 00:00:00 2001 From: Zbigniew Piotrowski Date: Fri, 17 Nov 2023 10:56:09 +0100 Subject: [PATCH 1/6] Constant numbers in BLAS calls are now JPRD for DP calls and JPRM for SP calls (instead of JPRB). Explicit type cast of JPRD to JPRB is added in gpnorm MIN/MAX calls to remove compilation warning of NVHPC --- src/trans/algor/butterfly_alg_mod.F90 | 46 ++++++++++----------- src/trans/internal/gpnorm_trans_ctl_mod.F90 | 12 +++--- src/trans/internal/ledir_mod.F90 | 16 +++---- src/trans/internal/ledirad_mod.F90 | 16 +++---- src/trans/internal/leinv_mod.F90 | 16 +++---- src/trans/internal/leinvad_mod.F90 | 16 +++---- 6 files changed, 61 insertions(+), 61 deletions(-) diff --git a/src/trans/algor/butterfly_alg_mod.F90 b/src/trans/algor/butterfly_alg_mod.F90 index 1cb785d0..f29525e8 100644 --- a/src/trans/algor/butterfly_alg_mod.F90 +++ b/src/trans/algor/butterfly_alg_mod.F90 @@ -621,8 +621,8 @@ SUBROUTINE MULT_BUTV(CDTRANS,YD_STRUCT,PVECIN,PVECOUT) & 0.0_JPRD,ZBETA(IBTST:IBTEN,IBETALV),1) ELSE CALL SGEMV('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) + & 1.0_JPRM,YNODE%B,IROWS,PVECIN(IFR:ILR),1,& + & 0.0_JPRM,ZBETA(IBTST:IBTEN,IBETALV),1) ENDIF ENDIF ILM1 = JL-1 @@ -700,8 +700,8 @@ SUBROUTINE MULT_BUTV(CDTRANS,YD_STRUCT,PVECIN,PVECOUT) & 0.0_JPRD,PVECOUT(IFR:ILR),1) ELSE CALL SGEMV('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) + & 1.0_JPRM,YNODE%B,IROWS,ZBETA(IBTST:IBTEN,IBETALV),1,& + & 0.0_JPRM,PVECOUT(IFR:ILR),1) ENDIF ENDIF ENDDO @@ -800,8 +800,8 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV) 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_JPRB,& - & YNODE%PNONIM(1),IM,ZBETA(IBTST,1,IBETALV),ILBETA,0.0_JPRB,& + CALL SGEMM('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 @@ -845,8 +845,8 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV) 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_JPRB,& - & YNODE%B,IROWS,PVECIN(IFR,1),IRIN,0.0_JPRB,& + CALL SGEMM('T','N',IRANK,KF,IROWS,1.0_JPRM,& + & YNODE%B,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 @@ -899,8 +899,8 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV) 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_JPRB,& - & YNODE%PNONIM(1),IM,ZBETA(IBTST,1,IBETALV),ILBETA,0.0_JPRB,& + CALL SGEMM('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 @@ -977,8 +977,8 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV) 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_JPRB,& - & YNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YD_STRUCT%N_ORDER,1.0_JPRB,& + 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 @@ -1025,8 +1025,8 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV) 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_JPRB,& - & YNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YD_STRUCT%N_ORDER,1.0_JPRB,& + 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 @@ -1046,8 +1046,8 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV) 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_JPRB,& - & YNODE%B,IROWS,ZBETA(IBTST,1,IBETALV),YD_STRUCT%IBETALEN_MAX,0.0_JPRB,& + 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 @@ -1084,10 +1084,10 @@ SUBROUTINE MULT_P(YDNODE,PVECIN,PVECOUT) IM = IRANK IN = YDNODE%ICOLS-IRANK IF (JPRB == JPRD) THEN - CALL DGEMV('N',IM,IN,1.0_JPRB,YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1),1,1.0_JPRB,ZVECOUT,1) + CALL DGEMV('N',IM,IN,1.0_JPRD,YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1),1,1.0_JPRD,ZVECOUT,1) PVECOUT(:)=ZVECOUT(:) ELSE - CALL SGEMV('N',IM,IN,1.0_JPRB,YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1),1,1.0_JPRB,PVECOUT,1) + CALL SGEMV('N',IM,IN,1.0_JPRM,YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1),1,1.0_JPRM,PVECOUT,1) ENDIF ENDIF @@ -1131,8 +1131,8 @@ SUBROUTINE MULT_PM(YDNODE,KF,KLBETA,PVECIN,PVECOUT) 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_JPRB,& - & YDNODE%PNONIM(1),IRANK,ZVECIN(IRANK+1,1),YDNODE%ICOLS,1.0_JPRB,& + 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 @@ -1158,7 +1158,7 @@ SUBROUTINE MULT_P_TR(YDNODE,PVECIN,PVECOUT) ZVECIN(:) = PVECIN(:) CALL DGEMV('T',IM,IN,1.0_JPRD,YDNODE%PNONIM,IRANK,ZVECIN,1,0.0_JPRD,ZVECOUT(IRANK+1),1) ELSE - CALL SGEMV('T',IM,IN,1.0_JPRB,YDNODE%PNONIM,IRANK,PVECIN,1,0.0_JPRB,ZVECOUT(IRANK+1),1) + CALL SGEMV('T',IM,IN,1.0_JPRM,YDNODE%PNONIM,IRANK,PVECIN,1,0.0_JPRM,ZVECOUT(IRANK+1),1) ENDIF ENDIF DO JK=1,IRANK @@ -1200,8 +1200,8 @@ SUBROUTINE MULT_P_TRM(YDNODE,KF,PVECIN,PVECOUT) 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_JPRB,& - & YDNODE%PNONIM(1),IM,PVECIN,IM,0.0_JPRB,& + 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.) ENDIF diff --git a/src/trans/internal/gpnorm_trans_ctl_mod.F90 b/src/trans/internal/gpnorm_trans_ctl_mod.F90 index 60a528f2..51226293 100644 --- a/src/trans/internal/gpnorm_trans_ctl_mod.F90 +++ b/src/trans/internal/gpnorm_trans_ctl_mod.F90 @@ -283,9 +283,9 @@ SUBROUTINE GPNORM_TRANS_CTL(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,PW) IF(LDAVE_ONLY)THEN DO JF=1,KFIELDS IND=IND+1 - ZMING(JF)=MIN(ZMING(JF),ZRCV(IND)) + ZMING(JF)=MIN(ZMING(JF),REAL(ZRCV(IND),KIND=JPRB)) IND=IND+1 - ZMAXG(JF)=MAX(ZMAXG(JF),ZRCV(IND)) + ZMAXG(JF)=MAX(ZMAXG(JF),REAL(ZRCV(IND),KIND=JPRB)) ENDDO ENDIF DEALLOCATE(ZRCV) @@ -363,17 +363,17 @@ SUBROUTINE GPNORM_TRANS_CTL(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,PW) ENDDO IF(.NOT.LDAVE_ONLY)THEN IND=IND+1 - ZMING(JF)=MIN(ZMING(JF),ZRCV(IND)) + ZMING(JF)=MIN(ZMING(JF),REAL(ZRCV(IND),KIND=JPRB)) IND=IND+1 - ZMAXG(JF)=MAX(ZMAXG(JF),ZRCV(IND)) + ZMAXG(JF)=MAX(ZMAXG(JF),REAL(ZRCV(IND),KIND=JPRB)) ENDIF ENDDO IF(LDAVE_ONLY)THEN DO JF=1,KFIELDS IND=IND+1 - ZMING(JF)=MIN(ZMING(JF),ZRCV(IND)) + ZMING(JF)=MIN(ZMING(JF),REAL(ZRCV(IND),KIND=JPRB)) IND=IND+1 - ZMAXG(JF)=MAX(ZMAXG(JF),ZRCV(IND)) + ZMAXG(JF)=MAX(ZMAXG(JF),REAL(ZRCV(IND),KIND=JPRB)) ENDDO ENDIF DEALLOCATE(ZRCV) diff --git a/src/trans/internal/ledir_mod.F90 b/src/trans/internal/ledir_mod.F90 index 9c2cfd99..cac0a86c 100644 --- a/src/trans/internal/ledir_mod.F90 +++ b/src/trans/internal/ledir_mod.F90 @@ -138,16 +138,16 @@ SUBROUTINE LEDIR(KM,KMLOC,KFC,KIFC,KSL,KDGLU,KLED2,PAIA,PSIA,POA1,PW) IF (LHOOK) CALL DR_HOOK('LEDIR_'//CLX//'GEMM_1',0,ZHOOK_HANDLE) IF (LLDOUBLE) THEN - CALL DGEMM('T','N',ILA,KIFC,KDGLU,1.0_JPRB,S%FA(KMLOC)%RPNMA,KDGLU,& - &ZB,KDGLU,0._JPRB,ZCA,ILA) + CALL DGEMM('T','N',ILA,KIFC,KDGLU,1.0_JPRD,S%FA(KMLOC)%RPNMA,KDGLU,& + &ZB,KDGLU,0._JPRD,ZCA,ILA) ELSE IF(KM>=1)THEN ! DGEM for the mean to improve mass conservation 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',ILA,KIFC,KDGLU,1.0_JPRB,S%FA(KMLOC)%RPNMA,KDGLU,& - &ZB,KDGLU,0._JPRB,ZCA,ILA) + CALL SGEMM('T','N',ILA,KIFC,KDGLU,1.0_JPRM,S%FA(KMLOC)%RPNMA,KDGLU,& + &ZB,KDGLU,0._JPRM,ZCA,ILA) if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.) ELSE I1 = size(S%FA(KMLOC)%RPNMA(:,1)) @@ -212,16 +212,16 @@ SUBROUTINE LEDIR(KM,KMLOC,KFC,KIFC,KSL,KDGLU,KLED2,PAIA,PSIA,POA1,PW) IF (LHOOK) CALL DR_HOOK('LEDIR_'//CLX//'GEMM_2',0,ZHOOK_HANDLE) IF (LLDOUBLE) THEN - CALL DGEMM('T','N',ILS,KIFC,KDGLU,1.0_JPRB,S%FA(KMLOC)%RPNMS,KDGLU,& - &ZB,KDGLU,0._JPRB,ZCS,ILS) + CALL DGEMM('T','N',ILS,KIFC,KDGLU,1.0_JPRD,S%FA(KMLOC)%RPNMS,KDGLU,& + &ZB,KDGLU,0._JPRD,ZCS,ILS) ELSE IF(KM>=1)THEN ! DGEM for the mean to improve mass conservation 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',ILS,KIFC,KDGLU,1.0_JPRB,S%FA(KMLOC)%RPNMS,KDGLU,& - &ZB,KDGLU,0._JPRB,ZCS,ILS) + CALL SGEMM('T','N',ILS,KIFC,KDGLU,1.0_JPRM,S%FA(KMLOC)%RPNMS,KDGLU,& + &ZB,KDGLU,0._JPRM,ZCS,ILS) if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.) ELSE I1 = size(S%FA(KMLOC)%RPNMS(:,1)) diff --git a/src/trans/internal/ledirad_mod.F90 b/src/trans/internal/ledirad_mod.F90 index dca3026c..9c9633e4 100644 --- a/src/trans/internal/ledirad_mod.F90 +++ b/src/trans/internal/ledirad_mod.F90 @@ -138,11 +138,11 @@ SUBROUTINE LEDIRAD(KM,KMLOC,KFC,KIFC,KDGLU,KLED2,PAIA,PSIA,POA1) IF(ILA <= ITHRESHOLD .OR. .NOT.S%LUSEFLT) THEN IF (LHOOK) CALL DR_HOOK('LE_'//CLX//'GEMM_1',0,ZHOOK_HANDLE) IF(LLDOUBLE)THEN - CALL DGEMM('N','N',KDGLU,KIFC,ILA,1.0_JPRB,S%FA(KMLOC)%RPNMA,KDGLU,& - &ZCA,ILA,0._JPRB,ZB,KDGLU) + CALL DGEMM('N','N',KDGLU,KIFC,ILA,1.0_JPRD,S%FA(KMLOC)%RPNMA,KDGLU,& + &ZCA,ILA,0._JPRD,ZB,KDGLU) ELSE - CALL SGEMM('N','N',KDGLU,KIFC,ILA,1.0_JPRB,S%FA(KMLOC)%RPNMA,KDGLU,& - &ZCA,ILA,0._JPRB,ZB,KDGLU) + CALL SGEMM('N','N',KDGLU,KIFC,ILA,1.0_JPRM,S%FA(KMLOC)%RPNMA,KDGLU,& + &ZCA,ILA,0._JPRM,ZB,KDGLU) END IF IF (LHOOK) CALL DR_HOOK('LE_'//CLX//'GEMM_1',1,ZHOOK_HANDLE) @@ -176,11 +176,11 @@ SUBROUTINE LEDIRAD(KM,KMLOC,KFC,KIFC,KDGLU,KLED2,PAIA,PSIA,POA1) IF (LHOOK) CALL DR_HOOK('LE_'//CLX//'GEMM_2',0,ZHOOK_HANDLE) IF(LLDOUBLE)THEN - CALL DGEMM('N','N',KDGLU,KIFC,ILS,1.0_JPRB,S%FA(KMLOC)%RPNMS,KDGLU,& - &ZCS,ILS,0._JPRB,ZB,KDGLU) + CALL DGEMM('N','N',KDGLU,KIFC,ILS,1.0_JPRD,S%FA(KMLOC)%RPNMS,KDGLU,& + &ZCS,ILS,0._JPRD,ZB,KDGLU) ELSE - CALL SGEMM('N','N',KDGLU,KIFC,ILS,1.0_JPRB,S%FA(KMLOC)%RPNMS,KDGLU,& - &ZCS,ILS,0._JPRB,ZB,KDGLU) + CALL SGEMM('N','N',KDGLU,KIFC,ILS,1.0_JPRM,S%FA(KMLOC)%RPNMS,KDGLU,& + &ZCS,ILS,0._JPRM,ZB,KDGLU) END IF IF (LHOOK) CALL DR_HOOK('LE_'//CLX//'GEMM_2',1,ZHOOK_HANDLE) diff --git a/src/trans/internal/leinv_mod.F90 b/src/trans/internal/leinv_mod.F90 index 5611d57c..2eceb53b 100644 --- a/src/trans/internal/leinv_mod.F90 +++ b/src/trans/internal/leinv_mod.F90 @@ -140,15 +140,15 @@ SUBROUTINE LEINV(KM,KMLOC,KFC,KIFC,KF_OUT_LT,KSL,KDGLU,PIA,PAOA1,PSOA1) IF (LHOOK) CALL DR_HOOK('LEINV_'//CLX//'GEMM_1',0,ZHOOK_HANDLE) IF (LLDOUBLE) THEN - CALL DGEMM('N','N',KDGLU,KIFC,ILA,1.0_JPRB,S%FA(KMLOC)%RPNMA,KDGLU,& - &ZBA,ILA,0._JPRB,ZC,KDGLU) + CALL DGEMM('N','N',KDGLU,KIFC,ILA,1.0_JPRD,S%FA(KMLOC)%RPNMA,KDGLU,& + &ZBA,ILA,0._JPRD,ZC,KDGLU) 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',KDGLU,KIFC,ILA,1.0_JPRB,S%FA(KMLOC)%RPNMA,KDGLU,& - &ZBA,ILA,0._JPRB,ZC,KDGLU) + CALL SGEMM('N','N',KDGLU,KIFC,ILA,1.0_JPRM,S%FA(KMLOC)%RPNMA,KDGLU,& + &ZBA,ILA,0._JPRM,ZC,KDGLU) if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.) ENDIF IF (LHOOK) CALL DR_HOOK('LEINV_'//CLX//'GEMM_1',1,ZHOOK_HANDLE) @@ -184,15 +184,15 @@ SUBROUTINE LEINV(KM,KMLOC,KFC,KIFC,KF_OUT_LT,KSL,KDGLU,PIA,PAOA1,PSOA1) IF (LHOOK) CALL DR_HOOK('LEINV_'//CLX//'GEMM_2',0,ZHOOK_HANDLE) IF (LLDOUBLE) THEN - CALL DGEMM('N','N',KDGLU,KIFC,ILS,1.0_JPRB,S%FA(KMLOC)%RPNMS,KDGLU,& - &ZBS,ILS,0._JPRB,ZC,KDGLU) + CALL DGEMM('N','N',KDGLU,KIFC,ILS,1.0_JPRD,S%FA(KMLOC)%RPNMS,KDGLU,& + &ZBS,ILS,0._JPRD,ZC,KDGLU) 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',KDGLU,KIFC,ILS,1.0_JPRB,S%FA(KMLOC)%RPNMS,KDGLU,& - &ZBS,ILS,0._JPRB,ZC,KDGLU) + CALL SGEMM('N','N',KDGLU,KIFC,ILS,1.0_JPRM,S%FA(KMLOC)%RPNMS,KDGLU,& + &ZBS,ILS,0._JPRM,ZC,KDGLU) if (LL_IEEE_HALT .and. LL_HALT_INVALID) call ieee_set_halting_mode(ieee_invalid,.true.) ENDIF IF (LHOOK) CALL DR_HOOK('LEINV_'//CLX//'GEMM_2',1,ZHOOK_HANDLE) diff --git a/src/trans/internal/leinvad_mod.F90 b/src/trans/internal/leinvad_mod.F90 index d23d856e..c39217e5 100644 --- a/src/trans/internal/leinvad_mod.F90 +++ b/src/trans/internal/leinvad_mod.F90 @@ -128,11 +128,11 @@ SUBROUTINE LEINVAD(KM,KMLOC,KFC,KIFC,KF_OUT_LT,KDGLU,PIA,PAOA1,PSOA1) IF(ILA <= ITHRESHOLD .OR. .NOT.S%LUSEFLT) THEN IF (LHOOK) CALL DR_HOOK('LE_'//CLX//'GEMM_1',0,ZHOOK_HANDLE) IF(LLDOUBLE)THEN - CALL DGEMM('T','N',ILA,KIFC,KDGLU,1.0_JPRB,S%FA(KMLOC)%RPNMA,KDGLU,& - &ZC,KDGLU,0._JPRB,ZBA,ILA) + CALL DGEMM('T','N',ILA,KIFC,KDGLU,1.0_JPRD,S%FA(KMLOC)%RPNMA,KDGLU,& + &ZC,KDGLU,0._JPRD,ZBA,ILA) ELSE - CALL SGEMM('T','N',ILA,KIFC,KDGLU,1.0_JPRB,S%FA(KMLOC)%RPNMA,KDGLU,& - &ZC,KDGLU,0._JPRB,ZBA,ILA) + CALL SGEMM('T','N',ILA,KIFC,KDGLU,1.0_JPRM,S%FA(KMLOC)%RPNMA,KDGLU,& + &ZC,KDGLU,0._JPRM,ZBA,ILA) END IF IF (LHOOK) CALL DR_HOOK('LE_'//CLX//'GEMM_1',1,ZHOOK_HANDLE) @@ -165,11 +165,11 @@ SUBROUTINE LEINVAD(KM,KMLOC,KFC,KIFC,KF_OUT_LT,KDGLU,PIA,PAOA1,PSOA1) IF (LHOOK) CALL DR_HOOK('LE_'//CLX//'GEMM_2',0,ZHOOK_HANDLE) IF(LLDOUBLE)THEN - CALL DGEMM('T','N',ILS,KIFC,KDGLU,1.0_JPRB,S%FA(KMLOC)%RPNMS,KDGLU,& - &ZC,KDGLU,0._JPRB,ZBS,ILS) + CALL DGEMM('T','N',ILS,KIFC,KDGLU,1.0_JPRD,S%FA(KMLOC)%RPNMS,KDGLU,& + &ZC,KDGLU,0._JPRD,ZBS,ILS) ELSE - CALL SGEMM('T','N',ILS,KIFC,KDGLU,1.0_JPRB,S%FA(KMLOC)%RPNMS,KDGLU,& - &ZC,KDGLU,0._JPRB,ZBS,ILS) + CALL SGEMM('T','N',ILS,KIFC,KDGLU,1.0_JPRM,S%FA(KMLOC)%RPNMS,KDGLU,& + &ZC,KDGLU,0._JPRM,ZBS,ILS) END IF IF (LHOOK) CALL DR_HOOK('LE_'//CLX//'GEMM_2',1,ZHOOK_HANDLE) From 0114cff0e86d2136666c0c3d7ffda0bcfe51aa73 Mon Sep 17 00:00:00 2001 From: Zbigniew Piotrowski Date: Fri, 17 Nov 2023 11:05:31 +0100 Subject: [PATCH 2/6] Add missing JPRM imports --- src/trans/algor/butterfly_alg_mod.F90 | 2 +- src/trans/internal/ledir_mod.F90 | 2 +- src/trans/internal/ledirad_mod.F90 | 2 +- src/trans/internal/leinv_mod.F90 | 2 +- src/trans/internal/leinvad_mod.F90 | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/trans/algor/butterfly_alg_mod.F90 b/src/trans/algor/butterfly_alg_mod.F90 index f29525e8..80941543 100644 --- a/src/trans/algor/butterfly_alg_mod.F90 +++ b/src/trans/algor/butterfly_alg_mod.F90 @@ -9,7 +9,7 @@ ! MODULE BUTTERFLY_ALG_MOD -USE PARKIND1, ONLY : JPRD, JPIM, JPRB, JPIB +USE PARKIND1, ONLY : JPRD, JPRM, JPIM, JPRB, JPIB USE INTERPOL_DECOMP_MOD USE SHAREDMEM_MOD diff --git a/src/trans/internal/ledir_mod.F90 b/src/trans/internal/ledir_mod.F90 index cac0a86c..34ea24ed 100644 --- a/src/trans/internal/ledir_mod.F90 +++ b/src/trans/internal/ledir_mod.F90 @@ -55,7 +55,7 @@ SUBROUTINE LEDIR(KM,KMLOC,KFC,KIFC,KSL,KDGLU,KLED2,PAIA,PSIA,POA1,PW) ! P. Dueben : Dec 2019 Improvements for mass conservation in single precision ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPRD, JPIM, JPRB +USE PARKIND1 ,ONLY : JPRD, JPRM, JPIM, JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_DIM ,ONLY : R diff --git a/src/trans/internal/ledirad_mod.F90 b/src/trans/internal/ledirad_mod.F90 index 9c9633e4..d36d44eb 100644 --- a/src/trans/internal/ledirad_mod.F90 +++ b/src/trans/internal/ledirad_mod.F90 @@ -59,7 +59,7 @@ SUBROUTINE LEDIRAD(KM,KMLOC,KFC,KIFC,KDGLU,KLED2,PAIA,PSIA,POA1) ! Modified ! 16/10/12 J.Hague : DR_HOOK round calls to DGEMM: ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPRD +USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPRD, JPRM USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_DIM ,ONLY : R diff --git a/src/trans/internal/leinv_mod.F90 b/src/trans/internal/leinv_mod.F90 index 2eceb53b..f75b02eb 100644 --- a/src/trans/internal/leinv_mod.F90 +++ b/src/trans/internal/leinv_mod.F90 @@ -54,7 +54,7 @@ SUBROUTINE LEINV(KM,KMLOC,KFC,KIFC,KF_OUT_LT,KSL,KDGLU,PIA,PAOA1,PSOA1) ! F. Vana 05-Mar-2015 Support for single precision ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPRD, JPIM ,JPRB +USE PARKIND1 ,ONLY : JPRD, JPRM, JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_DIM ,ONLY : R diff --git a/src/trans/internal/leinvad_mod.F90 b/src/trans/internal/leinvad_mod.F90 index c39217e5..e661fb06 100644 --- a/src/trans/internal/leinvad_mod.F90 +++ b/src/trans/internal/leinvad_mod.F90 @@ -54,7 +54,7 @@ SUBROUTINE LEINVAD(KM,KMLOC,KFC,KIFC,KF_OUT_LT,KDGLU,PIA,PAOA1,PSOA1) ! Modified ! 16/10/12 J.Hague : DR_HOOK round calls to DGEMM: ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPRD +USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPRD, JPRM USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_DIM ,ONLY : R From 48f153794aa7bdb50f166f8371af09eb449cab6b Mon Sep 17 00:00:00 2001 From: Zbigniew Piotrowski Date: Fri, 17 Nov 2023 11:11:33 +0100 Subject: [PATCH 3/6] Remove Intel compiler warnings: W=>D+7. Unused statement function in tpm_pol commented out. --- src/programs/ectrans-benchmark.F90 | 4 ++-- src/trans/internal/sugaw_mod.F90 | 4 ++-- src/trans/internal/tpm_pol.F90 | 8 ++++---- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/programs/ectrans-benchmark.F90 b/src/programs/ectrans-benchmark.F90 index 8a2fb698..d0fd4627 100644 --- a/src/programs/ectrans-benchmark.F90 +++ b/src/programs/ectrans-benchmark.F90 @@ -810,8 +810,8 @@ program transform_test if (zmaxerrg > real(ncheck, jprb) * epsilon(1.0_jprb)) then write(nout, '(a)') '*******************************' write(nout, '(a)') 'Correctness test failed' - write(nout, '(a,1e7.2)') 'Maximum spectral norm error = ', zmaxerrg - write(nout, '(a,1e7.2)') 'Error tolerance = ', real(ncheck, jprb) * epsilon(1.0_jprb) + write(nout, '(a,1e9.2)') 'Maximum spectral norm error = ', zmaxerrg + write(nout, '(a,1e9.2)') 'Error tolerance = ', real(ncheck, jprb) * epsilon(1.0_jprb) write(nout, '(a)') '*******************************' ierr = 1 endif diff --git a/src/trans/internal/sugaw_mod.F90 b/src/trans/internal/sugaw_mod.F90 index 410fca7b..f073f1cd 100644 --- a/src/trans/internal/sugaw_mod.F90 +++ b/src/trans/internal/sugaw_mod.F90 @@ -394,10 +394,10 @@ SUBROUTINE SUGAW(KDGL,KM,KN,PL,PW,PANM,PFN) IF(LLP2)THEN WRITE(UNIT=NOUT,FMT=& &'('' M ='',I4,'' ROW ='',I4,'' ITERATIONS='',I4,'' ROOT='',F30.20,& - &'' WEIGHT='',F30.20,'' MODIF :'',E8.2)')KM,JGL,ITER(JGL),PL(JGL)& + &'' WEIGHT='',F30.20,'' MODIF :'',E9.2)')KM,JGL,ITER(JGL),PL(JGL)& &,PW(JGL),PL(JGL)-ZLI(JGL) WRITE(UNIT=NOUT,FMT=& - &'(10X,'' LAST INC. : '',E8.2,'' MODIF IN M : '',F10.3,& + &'(10X,'' LAST INC. : '',E9.2,'' MODIF IN M : '',F10.3,& &'' FROM THE REGULAR GRID : '',F10.3,'' COLAT '',F10.3)')& &ZMOD(JGL),ZM(JGL),ZRR(JGL),ZT(JGL) ENDIF diff --git a/src/trans/internal/tpm_pol.F90 b/src/trans/internal/tpm_pol.F90 index 27eaa823..3d05cafc 100644 --- a/src/trans/internal/tpm_pol.F90 +++ b/src/trans/internal/tpm_pol.F90 @@ -33,7 +33,7 @@ SUBROUTINE INI_POL(KNSMAX,LDFAST) INTEGER(KIND=JPIM), INTENT(IN) :: KNSMAX LOGICAL, INTENT(IN), OPTIONAL :: LDFAST -REAL(KIND=JPRD) :: DA,DC,DD,DE +REAL(KIND=JPRD) :: DC,DD,DE !,DA INTEGER(KIND=JPIM) :: KKN, KKM INTEGER(KIND=JPIM) :: JN, JM @@ -49,9 +49,9 @@ SUBROUTINE INI_POL(KNSMAX,LDFAST) &*REAL(KKN+KKM-2,JPRD)) ) DE(KKN,KKM)=SQRT( (REAL(2*KKN+1,JPRD)*REAL(KKN-KKM,JPRD))& &/ (REAL(2*KKN-1,JPRD)*REAL(KKN+KKM,JPRD)) ) -DA(KKN,KKM)=SQRT( (REAL(2*KKN+1,JPRD)*REAL(KKN-KKM,JPRD)& - &*REAL(KKN+KKM,JPRD))& - &/ REAL(2*KKN-1,JPRD) ) +!DA(KKN,KKM)=SQRT( (REAL(2*KKN+1,JPRD)*REAL(KKN-KKM,JPRD)& +! &*REAL(KKN+KKM,JPRD))& +! &/ REAL(2*KKN-1,JPRD) ) IF (PRESENT(LDFAST)) THEN LLFAST=LDFAST From ced11aa0f3b286e289dcf8bb8932dbfc86ae8bed Mon Sep 17 00:00:00 2001 From: Zbigniew Piotrowski Date: Fri, 24 Nov 2023 15:41:28 +0100 Subject: [PATCH 4/6] Delete unused statement function --- src/trans/internal/tpm_pol.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/trans/internal/tpm_pol.F90 b/src/trans/internal/tpm_pol.F90 index 3d05cafc..448a0f9f 100644 --- a/src/trans/internal/tpm_pol.F90 +++ b/src/trans/internal/tpm_pol.F90 @@ -33,7 +33,7 @@ SUBROUTINE INI_POL(KNSMAX,LDFAST) INTEGER(KIND=JPIM), INTENT(IN) :: KNSMAX LOGICAL, INTENT(IN), OPTIONAL :: LDFAST -REAL(KIND=JPRD) :: DC,DD,DE !,DA +REAL(KIND=JPRD) :: DC,DD,DE INTEGER(KIND=JPIM) :: KKN, KKM INTEGER(KIND=JPIM) :: JN, JM @@ -49,9 +49,6 @@ SUBROUTINE INI_POL(KNSMAX,LDFAST) &*REAL(KKN+KKM-2,JPRD)) ) DE(KKN,KKM)=SQRT( (REAL(2*KKN+1,JPRD)*REAL(KKN-KKM,JPRD))& &/ (REAL(2*KKN-1,JPRD)*REAL(KKN+KKM,JPRD)) ) -!DA(KKN,KKM)=SQRT( (REAL(2*KKN+1,JPRD)*REAL(KKN-KKM,JPRD)& -! &*REAL(KKN+KKM,JPRD))& -! &/ REAL(2*KKN-1,JPRD) ) IF (PRESENT(LDFAST)) THEN LLFAST=LDFAST From eacae7c579df55039b79d915267c20e891e3771f Mon Sep 17 00:00:00 2001 From: Zbigniew Piotrowski Date: Fri, 24 Nov 2023 15:58:00 +0100 Subject: [PATCH 5/6] Fix NINT to use JPIM instead of JPRB in butterfly. --- src/trans/algor/butterfly_alg_mod.F90 | 42 +++++++++++++-------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/trans/algor/butterfly_alg_mod.F90 b/src/trans/algor/butterfly_alg_mod.F90 index 80941543..e837270d 100644 --- a/src/trans/algor/butterfly_alg_mod.F90 +++ b/src/trans/algor/butterfly_alg_mod.F90 @@ -392,11 +392,11 @@ SUBROUTINE UNPACK_BUTTERFLY_STRUCT(YD_STRUCT,YD_CLONE,YDMEMBUF) ELSE ZBUF => YD_CLONE%COMMSBUF(I+1:I+5) ENDIF -YD_STRUCT%M_ORDER = NINT(ZBUF(1),JPRB) -YD_STRUCT%N_ORDER = NINT(ZBUF(2),JPRB) -YD_STRUCT%N_CMAX = NINT(ZBUF(3),JPRB) -YD_STRUCT%N_LEVELS = NINT(ZBUF(4),JPRB) -YD_STRUCT%IBETALEN_MAX = NINT(ZBUF(5),JPRB) +YD_STRUCT%M_ORDER = NINT(ZBUF(1),JPIM) +YD_STRUCT%N_ORDER = NINT(ZBUF(2),JPIM) +YD_STRUCT%N_CMAX = NINT(ZBUF(3),JPIM) +YD_STRUCT%N_LEVELS = NINT(ZBUF(4),JPIM) +YD_STRUCT%IBETALEN_MAX = NINT(ZBUF(5),JPIM) I=I+5 ALLOCATE(YD_STRUCT%SLEV(0:YD_STRUCT%N_LEVELS)) @@ -406,9 +406,9 @@ SUBROUTINE UNPACK_BUTTERFLY_STRUCT(YD_STRUCT,YD_CLONE,YDMEMBUF) ELSE ZBUF => YD_CLONE%COMMSBUF(I+1:I+3) ENDIF - YD_STRUCT%SLEV(JL)%IJ =NINT(ZBUF(1),JPRB) - YD_STRUCT%SLEV(JL)%IK =NINT(ZBUF(2),JPRB) - YD_STRUCT%SLEV(JL)%IBETALEN=NINT(ZBUF(3),JPRB) + YD_STRUCT%SLEV(JL)%IJ =NINT(ZBUF(1),JPIM) + YD_STRUCT%SLEV(JL)%IK =NINT(ZBUF(2),JPIM) + YD_STRUCT%SLEV(JL)%IBETALEN=NINT(ZBUF(3),JPIM) I=I+3 ALLOCATE(YD_STRUCT%SLEV(JL)%NODE(YD_STRUCT%SLEV(JL)%IJ,YD_STRUCT%SLEV(JL)%IK)) DO JIK=1,YD_STRUCT%SLEV(JL)%IK @@ -418,15 +418,15 @@ SUBROUTINE UNPACK_BUTTERFLY_STRUCT(YD_STRUCT,YD_CLONE,YDMEMBUF) ELSE ZBUF => YD_CLONE%COMMSBUF(I+1:I+10) ENDIF - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ILEV = NINT(ZBUF(1),JPRB) - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IFCOL = NINT(ZBUF(2),JPRB) - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ILCOL = NINT(ZBUF(3),JPRB) - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IFROW = NINT(ZBUF(4),JPRB) - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ILROW = NINT(ZBUF(5),JPRB) - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ICOLS = NINT(ZBUF(6),JPRB) - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IROWS = NINT(ZBUF(7),JPRB) - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IRANK = NINT(ZBUF(8),JPRB) - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IOFFBETA= NINT(ZBUF(9),JPRB) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ILEV = NINT(ZBUF(1),JPIM) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IFCOL = NINT(ZBUF(2),JPIM) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ILCOL = NINT(ZBUF(3),JPIM) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IFROW = NINT(ZBUF(4),JPIM) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ILROW = NINT(ZBUF(5),JPIM) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ICOLS = NINT(ZBUF(6),JPIM) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IROWS = NINT(ZBUF(7),JPIM) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IRANK = NINT(ZBUF(8),JPIM) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%IOFFBETA= NINT(ZBUF(9),JPIM) J = NINT(ZBUF(10)) I=I+10 ALLOCATE(YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ICLIST(J)) @@ -437,7 +437,7 @@ SUBROUTINE UNPACK_BUTTERFLY_STRUCT(YD_STRUCT,YD_CLONE,YDMEMBUF) ZBUF => YD_CLONE%COMMSBUF(I+1:I+J) ENDIF DO II=1,J - YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ICLIST(II)=NINT(ZBUF(II),JPRB) + YD_STRUCT%SLEV(JL)%NODE(JIJ,JIK)%ICLIST(II)=NINT(ZBUF(II),JPIM) END DO I=I+J ENDIF @@ -446,7 +446,7 @@ SUBROUTINE UNPACK_BUTTERFLY_STRUCT(YD_STRUCT,YD_CLONE,YDMEMBUF) ELSE ZBUF => YD_CLONE%COMMSBUF(I+1:I+1) ENDIF - J=NINT(ZBUF(1),JPRB) + J=NINT(ZBUF(1),JPIM) I=I+1 IF( J > 0 )THEN IF(LLMEMBUF) THEN @@ -462,8 +462,8 @@ SUBROUTINE UNPACK_BUTTERFLY_STRUCT(YD_STRUCT,YD_CLONE,YDMEMBUF) ELSE ZBUF => YD_CLONE%COMMSBUF(I+1:I+2) ENDIF - J1=NINT(ZBUF(1),JPRB) - J2=NINT(ZBUF(2),JPRB) + J1=NINT(ZBUF(1),JPIM) + J2=NINT(ZBUF(2),JPIM) I=I+2 IF( J1 > 0 .AND. J2 > 0 )THEN IF(LLMEMBUF) THEN From 17e876f6522da4b1cf3e424f573fada97e2f1f65 Mon Sep 17 00:00:00 2001 From: Zbigniew Piotrowski Date: Fri, 24 Nov 2023 16:10:53 +0100 Subject: [PATCH 6/6] Fix real cast from JPRB to JPRM when we know thanks to LLDOUBLE that JPRB=JPRM --- src/trans/algor/butterfly_alg_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/trans/algor/butterfly_alg_mod.F90 b/src/trans/algor/butterfly_alg_mod.F90 index e837270d..dd3cf7a2 100644 --- a/src/trans/algor/butterfly_alg_mod.F90 +++ b/src/trans/algor/butterfly_alg_mod.F90 @@ -788,7 +788,7 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV) 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) - ZVECOUT(YNODE%IRANK+1:YNODE%IRANK+IN,1:KF) = REAL(ZOUT_D(1:IN,1:KF),JPRB) + 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,& @@ -832,7 +832,7 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV) & 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),JPRB) + ZBETA(IBTST:IBTST+IRANK-1,1:KF,IBETALV)=REAL(ZBETA_D(1:IRANK,1:KF),JPRM) DEALLOCATE(ZB_D) ELSE @@ -887,7 +887,7 @@ SUBROUTINE MULT_BUTM(CDTRANS,YD_STRUCT,KF,PVECIN,PVECOUT,KWV) & 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),JPRB) + 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,&