From eeff9f565a586d255a57546c9c02741ba5872616 Mon Sep 17 00:00:00 2001
From: Juan Escobar <escj@aero.obs-mip.fr>
Date: Thu, 5 Apr 2018 10:02:41 +0200
Subject: [PATCH] Juan 05/04/2018: some correction for real*4 compilation
---
src/MNH/lima_warm_nucl.f90 | 6 +-
src/SURFEX/dgam.F90 | 5 +-
src/SURFEX/gather_and_write_mpi.F90 | 392 +++++++++++++++++++++++--
src/SURFEX/gather_and_write_mpi_k4.F90 | 15 +-
src/SURFEX/mode_geo_gauss.F90 | 22 +-
src/SURFEX/pgd_cover.F90 | 7 +-
src/SURFEX/read_and_send_mpi.F90 | 17 +-
7 files changed, 405 insertions(+), 59 deletions(-)
diff --git a/src/MNH/lima_warm_nucl.f90 b/src/MNH/lima_warm_nucl.f90
index 3d36703c3..7a502c621 100644
--- a/src/MNH/lima_warm_nucl.f90
+++ b/src/MNH/lima_warm_nucl.f90
@@ -316,7 +316,7 @@ IF( INUCT >= 1 ) THEN
! Remark : in LIMA's nucleation parameterization, Smax=0.01 for a supersaturation of 1% !
!
!
- ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NAHEN)-0.00001, &
+ ZVEC1(:) = MAX( ( 1.0 + 10.0 * XMNH_EPSILON ), MIN( FLOAT(NAHEN)*( 1.0 - 10.0 * XMNH_EPSILON ), &
XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
IVEC1(:) = INT( ZVEC1(:) )
ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
@@ -402,7 +402,7 @@ IF( INUCT >= 1 ) THEN
! Modified values for Beta and C (see in init_aerosol_properties) account for that
!
WHERE (ZZW5(:) > 0. .AND. ZSMAX(:) > 0.)
- ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NHYP)-0.00001, &
+ ZVEC1(:) = MAX( ( 1.0 + 10.0 * XMNH_EPSILON ), MIN( FLOAT(NHYP)*( 1.0 - 10.0 * XMNH_EPSILON ), &
XHYPINTP1*LOG(ZSMAX(:))+XHYPINTP2 ) )
IVEC1(:) = INT( ZVEC1(:) )
ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
@@ -801,7 +801,7 @@ REAL :: PZVEC1
INTEGER :: PIVEC1
!
PSINGL_FUNCSMAX = 0.
-PZVEC1 = MAX( 1.00001,MIN( FLOAT(NHYP)-0.00001, &
+PZVEC1 = MAX( ( 1.0 + 10.0 * XMNH_EPSILON ),MIN( FLOAT(NHYP)*( 1.0 - 10.0 * XMNH_EPSILON ), &
XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
PIVEC1 = INT( PZVEC1 )
PZVEC1 = PZVEC1 - FLOAT( PIVEC1 )
diff --git a/src/SURFEX/dgam.F90 b/src/SURFEX/dgam.F90
index 6b8d46b14..2a0690870 100644
--- a/src/SURFEX/dgam.F90
+++ b/src/SURFEX/dgam.F90
@@ -125,6 +125,7 @@
!! MODIFICATIONS
!! -------------
!!J.Escobar10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
+!!J.Escobar 5/04/2018: for real*4 compilation, replace DEXP => EXP
!----------------------------------------------------
!################################################################
!
@@ -497,7 +498,7 @@ IF ( PA<=ZALPHA ) THEN
!
! 110 deb
ZTEMP = DLGA(PA*1.)
- ZU = DEXP(ZTEMP) - (PX**PA)/PA
+ ZU = EXP(ZTEMP) - (PX**PA)/PA
! 110 end
!
ENDIF
@@ -548,7 +549,7 @@ IF ( PA<=ZALPHA ) THEN
!
ZT = EXP(PX) * PX**(-PA)
PG = ZT * PG
- PGSTAR = 1. - PA * PG * DEXP(-ZALGP1) / ZT
+ PGSTAR = 1. - PA * PG * EXP(-ZALGP1) / ZT
!
ELSEIF (PA==0.) THEN
!
diff --git a/src/SURFEX/gather_and_write_mpi.F90 b/src/SURFEX/gather_and_write_mpi.F90
index 2670cc85b..8a775025e 100644
--- a/src/SURFEX/gather_and_write_mpi.F90
+++ b/src/SURFEX/gather_and_write_mpi.F90
@@ -8,6 +8,7 @@ MODULE MODI_GATHER_AND_WRITE_MPI
!! -------------
!! Original
!! J.Escobar 10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
+!! J.Escobar 05/04/2018: for real*4 compilation, differenced real(kind=8) & real(kind=4) routine version
!----------------------------------------------------
!
INTERFACE GATHER_AND_WRITE_MPI
@@ -356,7 +357,7 @@ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
INTEGER, DIMENSION(NSIZE,SIZE(KWORK2,2),SIZE(KWORK2,3)) :: IINTER
INTEGER, DIMENSION(NSIZE,SIZE(KWORK,2),SIZE(KWORK,3)) :: IWORK
!
-DOUBLE PRECISION :: XTIME0
+REAL :: XTIME0
!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
@@ -453,27 +454,117 @@ END SUBROUTINE GATHER_AND_WRITE_MPI_N3D
!
SUBROUTINE GATHER_AND_WRITE_MPI_X1D(PWORK,PWORK2,KMASK)
!
-USE MODI_GATHER_AND_WRITE_MPI_K4
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
+ XTIME_COMM_WRITE, XTIME_CALC_WRITE, &
+ IDX_W, WLOG_MPI
!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODI_UNPACK_SAME_RANK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
REAL, DIMENSION(:), INTENT(IN) :: PWORK
-REAL(KIND=KIND(PWORK)), DIMENSION(:), INTENT(OUT) :: PWORK2
+REAL(KIND=8), DIMENSION(:), INTENT(OUT) :: PWORK2
+!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, DIMENSION(NSIZE) :: ZINTER
+REAL, DIMENSION(NSIZE) :: ZWORK
+REAL :: XTIME0
+!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+INTEGER :: ICPT
+INTEGER :: I,J, IP1, IS1
+INTEGER :: INFOMPI
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1D',0,ZHOOK_HANDLE)
!
-IF (PRESENT(KMASK)) THEN
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2,KMASK)
+ZWORK(:) = XUNDEF
+!
+#ifdef SFX_MPI
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (SIZE(PWORK)>0) THEN
+ IF (PRESENT(KMASK)) THEN
+ CALL UNPACK_SAME_RANK(KMASK,PWORK,ZWORK(:))
+ ELSE
+ ZWORK(1:SIZE(PWORK)) = PWORK(:)
+ ENDIF
+ENDIF
+!
+#ifdef SFX_MPI
+XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+!
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (NRANK/=NPIO) THEN
+ !
+ IDX_W = IDX_W + 1
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+ CALL MPI_SEND(ZWORK,SIZE(ZWORK)*KIND(ZWORK)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
ELSE
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2)
+ !
+ PWORK2(:) = 0.
+ !
+ IDX_W = IDX_W + 1
+ !
+ DO I=0,NPROC-1
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ IF (I/=NPIO) THEN
+#ifdef SFX_MPI
+ CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
+#endif
+ ELSE
+ ZINTER(:) = ZWORK(:)
+ ENDIF
+ !
+#ifdef SFX_MPI
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+ !
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ ICPT = 0
+ !
+ DO J=1,SIZE(NINDEX)
+ !
+ IF ( NINDEX(J)==I ) THEN
+ ICPT = ICPT + 1
+ PWORK2(J) = ZINTER(ICPT)
+ ENDIF
+ !
+ ENDDO
+ !
+#ifdef SFX_MPI
+ XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+ ENDDO
+ !
ENDIF
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1D',1,ZHOOK_HANDLE)
@@ -484,27 +575,122 @@ END SUBROUTINE GATHER_AND_WRITE_MPI_X1D
!
SUBROUTINE GATHER_AND_WRITE_MPI_X2D(PWORK,PWORK2,KMASK)
!
-USE MODI_GATHER_AND_WRITE_MPI_K4
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
+ XTIME_COMM_WRITE, &
+ XTIME_CALC_WRITE, IDX_W, WLOG_MPI
+!
+USE MODI_UNPACK_SAME_RANK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
-REAL(KIND=KIND(PWORK)), DIMENSION(:,:), INTENT(OUT) :: PWORK2
+REAL(KIND=8), DIMENSION(:,:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, DIMENSION(NSIZE,SIZE(PWORK2,2)) :: ZINTER
+REAL, DIMENSION(NSIZE,SIZE(PWORK,2)) :: ZWORK
+REAL:: XTIME0
+!
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+INTEGER :: ICPT, IX2, IS1, IS2, IP1, IP2
+INTEGER :: I,J
+INTEGER :: INFOMPI
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2D',0,ZHOOK_HANDLE)
!
-IF (PRESENT(KMASK)) THEN
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2,KMASK)
+ZWORK(:,:) = XUNDEF
+!
+#ifdef SFX_MPI
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (SIZE(PWORK,1)>0) THEN
+ IF (PRESENT(KMASK)) THEN
+ CALL UNPACK_SAME_RANK(KMASK,PWORK,ZWORK(:,:))
+ ELSE
+ ZWORK(1:SIZE(PWORK,1),:) = PWORK(:,:)
+ ENDIF
+ENDIF
+!
+#ifdef SFX_MPI
+XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+!
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (NRANK/=NPIO) THEN
+ !
+ IDX_W = IDX_W + 1
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+ CALL MPI_SEND(ZWORK(:,:),SIZE(ZWORK)*KIND(ZWORK)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+ELSEIF (NPROC>1) THEN
+ !
+ PWORK2(:,:) = 0.
+ !
+ IDX_W = IDX_W + 1
+ !
+!!$OMP PARALLEL DO PRIVATE(I,ZINTER,ICPT,J,ISTATUS,INFOMPI,ZHOOK_HANDLE_OMP)
+ DO I=0,NPROC-1
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ IF (I/=NPIO) THEN
+#ifdef SFX_MPI
+ CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
+#endif
+ ELSE
+ ZINTER(:,:) = ZWORK(:,:)
+ ENDIF
+! !
+#ifdef SFX_MPI
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+ !
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ ICPT = 0
+ !
+ DO J=1,SIZE(NINDEX)
+ !
+ IF ( NINDEX(J)==I ) THEN
+ ICPT = ICPT + 1
+ PWORK2(J,:) = ZINTER(ICPT,:)
+ ENDIF
+ !
+ ENDDO
+ !
+#ifdef SFX_MPI
+ XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+ ENDDO
+!!$OMP END PARALLEL DO
+ !
ELSE
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2)
+ !
+ PWORK2(:,:) = ZWORK(:,:)
+ !
ENDIF
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2D',1,ZHOOK_HANDLE)
@@ -515,30 +701,142 @@ END SUBROUTINE GATHER_AND_WRITE_MPI_X2D
!
SUBROUTINE GATHER_AND_WRITE_MPI_X3D(PWORK,PWORK2,KMASK)
!
-USE MODI_GATHER_AND_WRITE_MPI_K4
+USE MODD_SURF_PAR, ONLY : XUNDEF
!
-USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+USE MODD_SURFEX_MPI, ONLY : NINDEX, NPROC, NRANK, NCOMM, NPIO, NSIZE, &
+ XTIME_COMM_WRITE, &
+ XTIME_CALC_WRITE, IDX_W, WLOG_MPI
+!
+USE MODI_UNPACK_SAME_RANK
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
IMPLICIT NONE
!
+#ifdef SFX_MPI
+INCLUDE "mpif.h"
+#endif
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
-REAL(KIND=KIND(PWORK)), DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
+REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
+REAL, DIMENSION(NSIZE,SIZE(PWORK2,2),SIZE(PWORK2,3)) :: ZINTER
+REAL, DIMENSION(NSIZE,SIZE(PWORK,2),SIZE(PWORK,3)) :: ZWORK
+REAL :: XTIME0
!
-IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D',0,ZHOOK_HANDLE)
+#ifdef SFX_MPI
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+#endif
+INTEGER :: ICPT, IX2, IS1, IS2, IP1, IP2
+INTEGER :: I,J
+INTEGER :: INFOMPI
!
-IF (PRESENT(KMASK)) THEN
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2,KMASK)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
+!
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_1',0,ZHOOK_HANDLE)
+!
+ZWORK(:,:,:) = XUNDEF
+!
+#ifdef SFX_MPI
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (SIZE(PWORK,1)>0) THEN
+ IF (PRESENT(KMASK)) THEN
+ CALL UNPACK_SAME_RANK(KMASK,PWORK(:,:,:),ZWORK(:,:,:))
+ ELSE
+ ZWORK(1:SIZE(PWORK,1),:,:) = PWORK(:,:,:)
+ ENDIF
+ENDIF
+!
+#ifdef SFX_MPI
+XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+!
+XTIME0 = MPI_WTIME()
+#endif
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_1',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_2',0,ZHOOK_HANDLE)
+
+IF (NRANK/=NPIO) THEN
+ !
+ !
+ IDX_W = IDX_W + 1
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+ CALL MPI_SEND(ZWORK(:,:,:),SIZE(ZWORK)*KIND(ZWORK)/4,MPI_REAL,NPIO,IDX_W,NCOMM,INFOMPI)
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_2',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_5',0,ZHOOK_HANDLE)
+ !
+ELSEIF (NPROC>1) THEN
+ !
+ PWORK2(:,:,:) = 0.
+ !
+ IDX_W = IDX_W + 1
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_2',1,ZHOOK_HANDLE)
+
+!!$OMP PARALLEL DO PRIVATE(I,ZINTER,ICPT,J,INFOMPI,ISTATUS,ZHOOK_HANDLE_OMP)
+ DO I=0,NPROC-1
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_3',0,ZHOOK_HANDLE_OMP)
+ !
+#ifdef SFX_MPI
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+ IF (I/=NPIO) THEN
+#ifdef SFX_MPI
+ CALL MPI_RECV(ZINTER,SIZE(ZINTER)*KIND(ZINTER)/4,MPI_REAL,I,IDX_W,NCOMM,ISTATUS,INFOMPI)
+#endif
+ ELSE
+ ZINTER(:,:,:) = ZWORK(:,:,:)
+ ENDIF
+! !
+#ifdef SFX_MPI
+ XTIME_COMM_WRITE = XTIME_COMM_WRITE + (MPI_WTIME() - XTIME0)
+ !
+ XTIME0 = MPI_WTIME()
+#endif
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_3',1,ZHOOK_HANDLE_OMP)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_4',0,ZHOOK_HANDLE_OMP)
+
+ ICPT = 0
+ !
+ DO J=1,SIZE(NINDEX)
+ !
+ IF ( NINDEX(J)==I ) THEN
+ ICPT = ICPT + 1
+ PWORK2(J,:,:) = ZINTER(ICPT,:,:)
+ ENDIF
+ !
+ ENDDO
+ !
+#ifdef SFX_MPI
+ XTIME_CALC_WRITE = XTIME_CALC_WRITE + (MPI_WTIME() - XTIME0)
+#endif
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_4',1,ZHOOK_HANDLE_OMP)
+ ENDDO
+!!$OMP END PARALLEL DO
+ !
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_5',0,ZHOOK_HANDLE)
+ !
ELSE
- CALL GATHER_AND_WRITE_MPI_K4(PWORK,PWORK2)
+ PWORK2(:,:,:) = ZWORK(:,:,:)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_2',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_5',0,ZHOOK_HANDLE)
+
ENDIF
!
-IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D',1,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3D_5',1,ZHOOK_HANDLE)
!
END SUBROUTINE GATHER_AND_WRITE_MPI_X3D
!
@@ -556,10 +854,10 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN) :: PWORK
-REAL(KIND=KIND(PWORK)/2), DIMENSION(:), INTENT(OUT) :: PWORK2
+REAL(KIND=4), DIMENSION(:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
-REAL, DIMENSION(:), ALLOCATABLE :: ZINTER
+REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: ZINTER
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X1DK4',0,ZHOOK_HANDLE)
@@ -594,10 +892,10 @@ USE PARKIND1 ,ONLY : JPRB
IMPLICIT NONE
!
REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
-REAL(KIND=KIND(PWORK)/2), DIMENSION(:,:), INTENT(OUT) :: PWORK2
+REAL(KIND=4), DIMENSION(:,:), INTENT(OUT) :: PWORK2
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZINTER
+REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: ZINTER
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2DK4',0,ZHOOK_HANDLE)
@@ -617,4 +915,42 @@ DEALLOCATE(ZINTER)
IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X2DK4',1,ZHOOK_HANDLE)
!
END SUBROUTINE GATHER_AND_WRITE_MPI_X2DK4
+!
+!**************************************************************************
+!
+SUBROUTINE GATHER_AND_WRITE_MPI_X3DK4(PWORK,PWORK2,KMASK)
+!
+USE MODI_GATHER_AND_WRITE_MPI_K4
+!
+USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
+REAL(KIND=4), DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
+INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
+!
+REAL(KIND=4), DIMENSION(:,:,:), ALLOCATABLE :: ZINTER
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3DK4',0,ZHOOK_HANDLE)
+!
+ALLOCATE(ZINTER(SIZE(PWORK2,1),SIZE(PWORK2,2),SIZE(PWORK2,3)))
+IF (PRESENT(KMASK)) THEN
+ CALL GATHER_AND_WRITE_MPI_K4(PWORK,ZINTER,KMASK)
+ELSE
+ CALL GATHER_AND_WRITE_MPI_K4(PWORK,ZINTER)
+ENDIF
+!
+IF (NRANK==NPIO) THEN
+ PWORK2(:,:,:) = ZINTER(:,:,:)
+ENDIF
+DEALLOCATE(ZINTER)
+!
+IF (LHOOK) CALL DR_HOOK('GATHER_AND_WRITE_MPI_X3DK4',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE GATHER_AND_WRITE_MPI_X3DK4
diff --git a/src/SURFEX/gather_and_write_mpi_k4.F90 b/src/SURFEX/gather_and_write_mpi_k4.F90
index ddeace8a7..1bccd0f73 100644
--- a/src/SURFEX/gather_and_write_mpi_k4.F90
+++ b/src/SURFEX/gather_and_write_mpi_k4.F90
@@ -8,6 +8,7 @@ MODULE MODI_GATHER_AND_WRITE_MPI_K4
!! -------------
!! Original
!! J.Escobar 10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
+!! J.Escobar 05/04/2018: for real*4 compilation, differenced real(kind=8) & real(kind=4) routine version
!----------------------------------------------------
!
INTERFACE GATHER_AND_WRITE_MPI_K4
@@ -15,7 +16,7 @@ INTERFACE GATHER_AND_WRITE_MPI_K4
SUBROUTINE GATHER_AND_WRITE_MPI_X1D0(PWORK,PWORK2,KMASK)
!
REAL, DIMENSION(:), INTENT(IN) :: PWORK
-REAL, DIMENSION(:), INTENT(OUT) :: PWORK2
+REAL(KIND=4), DIMENSION(:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
@@ -24,7 +25,7 @@ END SUBROUTINE GATHER_AND_WRITE_MPI_X1D0
SUBROUTINE GATHER_AND_WRITE_MPI_X2D0(PWORK,PWORK2,KMASK)
!
REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
-REAL, DIMENSION(:,:), INTENT(OUT) :: PWORK2
+REAL(KIND=4), DIMENSION(:,:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
@@ -33,7 +34,7 @@ END SUBROUTINE GATHER_AND_WRITE_MPI_X2D0
SUBROUTINE GATHER_AND_WRITE_MPI_X3D0(PWORK,PWORK2,KMASK)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
+REAL(KIND=4), DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
@@ -65,7 +66,7 @@ INCLUDE "mpif.h"
#endif
!
REAL, DIMENSION(:), INTENT(IN) :: PWORK
-REAL, DIMENSION(:), INTENT(OUT) :: PWORK2
+REAL(KIND=4), DIMENSION(:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
@@ -187,7 +188,7 @@ INCLUDE "mpif.h"
#endif
!
REAL, DIMENSION(:,:), INTENT(IN) :: PWORK
-REAL, DIMENSION(:,:), INTENT(OUT) :: PWORK2
+REAL(KIND=4), DIMENSION(:,:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
@@ -315,13 +316,13 @@ INCLUDE "mpif.h"
#endif
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PWORK
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
+REAL(KIND=4), DIMENSION(:,:,:), INTENT(OUT) :: PWORK2
!
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: KMASK
!
REAL, DIMENSION(NSIZE,SIZE(PWORK2,2),SIZE(PWORK2,3)) :: ZINTER
REAL, DIMENSION(NSIZE,SIZE(PWORK,2),SIZE(PWORK,3)) :: ZWORK
-DOUBLE PRECISION :: XTIME0
+REAL :: XTIME0
!
#ifdef SFX_MPI
INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
diff --git a/src/SURFEX/mode_geo_gauss.F90 b/src/SURFEX/mode_geo_gauss.F90
index f148bcd5e..58957ed32 100644
--- a/src/SURFEX/mode_geo_gauss.F90
+++ b/src/SURFEX/mode_geo_gauss.F90
@@ -11,6 +11,8 @@ MODULE MODE_GEO_GAUSS
!! MODIFICATION
!! ------------
!! Original 10/2005
+ !! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
+ !! J.Escobar 05/04/2018 : for real*4 compilation , change some REAL kind
!!
!---------------------------------------------------------------------------
USE EGGANGLES, ONLY : LOLA
@@ -106,7 +108,7 @@ CONTAINS
TYPE (LOLA), INTENT(IN) :: PT_TR
TYPE (LOLA), INTENT(IN) :: PT_POLE
- REAL(KIND=JPRB) :: ZSIN, ZCOS
+ REAL :: ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ROTATE_G_S',0,ZHOOK_HANDLE)
@@ -129,7 +131,7 @@ CONTAINS
TYPE (LOLA), INTENT(IN) :: PT_POLE
TYPE (LOLA), DIMENSION(SIZE(PT_TR)) :: PT_REEL
- REAL(KIND=JPRB), DIMENSION(SIZE(PT_TR)) :: ZSIN, ZCOS
+ REAL, DIMENSION(SIZE(PT_TR)) :: ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ROTATE_G_V',0,ZHOOK_HANDLE)
@@ -155,7 +157,7 @@ CONTAINS
TYPE (LOLA), INTENT(IN) :: PT_REEL
TYPE (LOLA), INTENT(IN) :: PT_POLE
- REAL(KIND=JPRB) :: ZSIN, ZCOS
+ REAL :: ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ANTI_ROTATE_G_S',0,ZHOOK_HANDLE)
@@ -177,7 +179,7 @@ CONTAINS
TYPE (LOLA), INTENT(IN) :: PT_POLE
TYPE (LOLA), DIMENSION(SIZE(PT_REEL)) :: PT_TR
- REAL(KIND=JPRB), DIMENSION(SIZE(PT_REEL)) :: ZSIN, ZCOS
+ REAL, DIMENSION(SIZE(PT_REEL)) :: ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ANTI_ROTATE_G_V',0,ZHOOK_HANDLE)
@@ -202,7 +204,7 @@ CONTAINS
TYPE (LOLA), INTENT(IN) :: PT_COORD
REAL, INTENT(IN) :: PCODIL
- REAL(KIND=JPRB) :: ZPC2, ZSIN, ZCOS
+ REAL :: ZPC2, ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ETIR_S',0,ZHOOK_HANDLE)
@@ -222,7 +224,7 @@ CONTAINS
REAL, INTENT(IN) :: PCODIL
TYPE (LOLA), DIMENSION(SIZE(PT_COORD)) :: PT_ET
- REAL(KIND=JPRB), DIMENSION(SIZE(PT_COORD)) :: ZPC2, ZSIN, ZCOS
+ REAL, DIMENSION(SIZE(PT_COORD)) :: ZPC2, ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:ETIR_V',0,ZHOOK_HANDLE)
@@ -241,7 +243,7 @@ CONTAINS
TYPE (LOLA), INTENT(IN) :: PT_COORD
REAL, INTENT(IN) :: PCODIL
- REAL(KIND=JPRB) :: ZPC2, ZSIN, ZCOS
+ REAL :: ZPC2, ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:RETRE_S',0,ZHOOK_HANDLE)
@@ -261,7 +263,7 @@ CONTAINS
REAL, INTENT(IN) :: PCODIL
TYPE (LOLA), DIMENSION(SIZE(PT_COORD)) :: PT_RE
- REAL(KIND=JPRB), DIMENSION(SIZE(PT_COORD)) :: ZPC2, ZSIN, ZCOS
+ REAL, DIMENSION(SIZE(PT_COORD)) :: ZPC2, ZSIN, ZCOS
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:RETRE_V',0,ZHOOK_HANDLE)
@@ -283,7 +285,7 @@ CONTAINS
TYPE (LOLA), INTENT(IN) :: POLE, PT_COORD
REAL, INTENT(IN) :: PCODIL
- REAL(KIND=JPRB) :: ZPC2
+ REAL :: ZPC2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:MAP_FAC_S',0,ZHOOK_HANDLE)
ZPC2 = PCODIL*PCODIL
@@ -299,7 +301,7 @@ CONTAINS
REAL, INTENT(IN) :: PCODIL
REAL, DIMENSION(SIZE(PT_COORD)) :: PMF
- REAL(KIND=JPRB), DIMENSION(SIZE(PT_COORD)) :: ZPC2
+ REAL, DIMENSION(SIZE(PT_COORD)) :: ZPC2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_GEO_GAUSS:MAP_FAC_V',0,ZHOOK_HANDLE)
diff --git a/src/SURFEX/pgd_cover.F90 b/src/SURFEX/pgd_cover.F90
index ff5590177..1df60681c 100644
--- a/src/SURFEX/pgd_cover.F90
+++ b/src/SURFEX/pgd_cover.F90
@@ -38,6 +38,7 @@
!! B. Decharme 07/2009 compatibility between Surfex and Orca (Nemo) grid (Earth Model)
!! B. Decharme 07/2012 if sea or water imposed to 1 in a grid cell: no extrapolation
!! B. Decharme 02/2014 Add LRM_RIVER and remove lake over antarctica
+!! J. Escobar 05/04/2018 : for real*4 compilation , change some REAL kind
!!
!----------------------------------------------------------------------------
!
@@ -741,7 +742,7 @@ INTEGER, INTENT(INOUT) :: KCOVER
INTEGER, INTENT(OUT) :: KC_SURF
!
LOGICAL :: GPRESENT
-REAL :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PGD_COVER:FIT_COVERS',0,ZHOOK_HANDLE)
!
@@ -802,7 +803,7 @@ INTEGER, DIMENSION(:), POINTER :: KMASK_COVER
INTEGER, INTENT(IN) :: KCOVER
!
INTEGER :: ICPT
-REAL :: ZHOOK_HANDLE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PGD_COVER:MAKE_MASK_COVER',0,ZHOOK_HANDLE)
!
@@ -836,7 +837,7 @@ REAL, DIMENSION(U%NDIM_FULL,SIZE(PCOVER,2)) :: ZCOVER_ALL
INTEGER, DIMENSION(U%NDIM_FULL) :: IMAXCOVER_ALL
INTEGER, DIMENSION(U%NSIZE_FULL) :: IMAXCOVER
INTEGER :: JK, JCOV, ISIZE_OMP
-REAL :: ZHOOK_HANDLE_OMP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE_OMP
!
ISIZE_OMP = MAX(1,SIZE(PCOVER,1)/NBLOCKTOT)
!
diff --git a/src/SURFEX/read_and_send_mpi.F90 b/src/SURFEX/read_and_send_mpi.F90
index 8d3275736..39a726edb 100644
--- a/src/SURFEX/read_and_send_mpi.F90
+++ b/src/SURFEX/read_and_send_mpi.F90
@@ -2,6 +2,11 @@
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
+!! MODIFICATION
+!! ------------
+!! J. Escobar 05/04/2018 : for real*4 compilation , change some REAL kind
+!!
+!----------------------------------------------------------------------------
MODULE MODI_READ_AND_SEND_MPI
!
INTERFACE READ_AND_SEND_MPI
@@ -106,7 +111,7 @@ INTEGER, DIMENSION(MPI_STATUS_SIZE,NPROC-1) :: ISTATUS2
INTEGER :: ICPT, IPIO, IDX, IREQ
INTEGER :: I,J
INTEGER :: INFOMPI
-DOUBLE PRECISION :: XTIME0
+REAL :: XTIME0
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
@@ -249,7 +254,7 @@ INTEGER :: IS2, IP2
INTEGER :: ICPT
INTEGER :: I,J, K
INTEGER :: INFOMPI
-DOUBLE PRECISION :: XTIME0
+REAL :: XTIME0
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -352,7 +357,7 @@ INTEGER :: IP2, IS2, IP3, IS3
INTEGER :: ICPT, IPIO, IDX
INTEGER :: I,J
INTEGER :: INFOMPI, IREQ
-DOUBLE PRECISION :: XTIME0
+REAL :: XTIME0
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
@@ -490,7 +495,7 @@ INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
INTEGER :: ICPT, IPIO, IDX
INTEGER :: I,J, IREQ
INTEGER :: INFOMPI
-DOUBLE PRECISION :: XTIME0
+REAL :: XTIME0
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
@@ -636,7 +641,7 @@ INTEGER :: IS2, IP2
INTEGER :: ICPT, IPIO, IDX
INTEGER :: I,J, K, IREQ
INTEGER :: INFOMPI
-DOUBLE PRECISION :: XTIME0
+REAL :: XTIME0
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
@@ -782,7 +787,7 @@ INTEGER :: IP2, IS2, IP3, IS3
INTEGER :: ICPT, IPIO, IDX
INTEGER :: I,J
INTEGER :: INFOMPI, IREQ
-DOUBLE PRECISION :: XTIME0
+REAL :: XTIME0
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OMP
!
--
GitLab