From 0323dbc56d250c9244b2c809d32f6a479744164a Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 16 Jul 2019 12:42:00 +0200
Subject: [PATCH] Philippe 16/07/2019: add MPPDB_CHECK calls at beginning and
end of several advection subroutines
---
src/MNH/advec_4th_order_aux.f90 | 12 +++
src/MNH/advection_uvw_cen.f90 | 31 +++++++
src/MNH/advecuvw_4th.f90 | 31 +++++--
src/MNH/ppm.f90 | 150 +++++++++++++++++++++++++++++++-
4 files changed, 213 insertions(+), 11 deletions(-)
diff --git a/src/MNH/advec_4th_order_aux.f90 b/src/MNH/advec_4th_order_aux.f90
index 5f2092ff0..6352bb536 100644
--- a/src/MNH/advec_4th_order_aux.f90
+++ b/src/MNH/advec_4th_order_aux.f90
@@ -112,6 +112,7 @@ USE MODD_CONF
USE MODE_DEVICE
#endif
use mode_ll, only: GET_INDICE_ll, LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll
+use mode_mppdb
#ifdef _OPENACC
use mode_msg
#endif
@@ -147,6 +148,11 @@ REAL, DIMENSION(SIZE(PFIELDT,2),SIZE(PFIELDT,3)) :: ZHALO2_WEST,ZHALO2_EAST
REAL, DIMENSION(SIZE(PFIELDT,1),SIZE(PFIELDT,3)) :: ZHALO2_SOUTH,ZHALO2_NORTH
!$acc declare create (ZHALO2_WEST,ZHALO2_EAST,ZHALO2_SOUTH,ZHALO2_NORTH)
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PFIELDT,"ADVEC_4TH_ORDER_ALGO beg:PFIELDT")
+END IF
+
!-------------------------------------------------------------------------------
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
@@ -445,6 +451,12 @@ ELSE
!$acc end kernels
ENDIF
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PMEANX,"ADVEC_4TH_ORDER_ALGO end:PMEANX")
+ CALL MPPDB_CHECK(PMEANY,"ADVEC_4TH_ORDER_ALGO end:PMEANY")
+END IF
+
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADVEC_4TH_ORDER_ALGO
diff --git a/src/MNH/advection_uvw_cen.f90 b/src/MNH/advection_uvw_cen.f90
index f0d4b1e81..9cc640dfb 100644
--- a/src/MNH/advection_uvw_cen.f90
+++ b/src/MNH/advection_uvw_cen.f90
@@ -96,6 +96,7 @@ END MODULE MODI_ADVECTION_UVW_CEN
! ------------
!
USE MODE_ll
+use mode_mppdb
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
USE MODD_CONF
USE MODD_PARAMETERS
@@ -200,6 +201,29 @@ call Print_msg( NVERB_WARNING, 'GEN', 'ADVECTION_UVW_CEN', 'OpenACC: not yet tes
#endif
!-------------------------------------------------------------------------------
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PUM,"ADVECTION_UVW_CEN beg:PUM")
+ CALL MPPDB_CHECK(PVM,"ADVECTION_UVW_CEN beg:PVM")
+ CALL MPPDB_CHECK(PWM,"ADVECTION_UVW_CEN beg:PWM")
+ CALL MPPDB_CHECK(PDUM,"ADVECTION_UVW_CEN beg:PDUM")
+ CALL MPPDB_CHECK(PDVM,"ADVECTION_UVW_CEN beg:PDVM")
+ CALL MPPDB_CHECK(PDWM,"ADVECTION_UVW_CEN beg:PDWM")
+ CALL MPPDB_CHECK(PUT,"ADVECTION_UVW_CEN beg:PUT")
+ CALL MPPDB_CHECK(PVT,"ADVECTION_UVW_CEN beg:PVT")
+ CALL MPPDB_CHECK(PWT,"ADVECTION_UVW_CEN beg:PWT")
+ CALL MPPDB_CHECK(PRHODJ,"ADVECTION_UVW_CEN beg:PRHODJ")
+ CALL MPPDB_CHECK(PDXX,"ADVECTION_UVW_CEN beg:PDXX")
+ CALL MPPDB_CHECK(PDYY,"ADVECTION_UVW_CEN beg:PDYY")
+ CALL MPPDB_CHECK(PDZZ,"ADVECTION_UVW_CEN beg:PDZZ")
+ CALL MPPDB_CHECK(PDZX,"ADVECTION_UVW_CEN beg:PDZX")
+ CALL MPPDB_CHECK(PDZY,"ADVECTION_UVW_CEN beg:PDZY")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PRUS,"ADVECTION_UVW_CEN beg:PRUS")
+ CALL MPPDB_CHECK(PRVS,"ADVECTION_UVW_CEN beg:PRVS")
+ CALL MPPDB_CHECK(PRWS,"ADVECTION_UVW_CEN beg:PRWS")
+END IF
+
#ifdef _OPENACC
CALL INIT_ON_HOST_AND_DEVICE(ZUS,-1e99,'ADVECTION_UVW_CEN::ZUS')
CALL INIT_ON_HOST_AND_DEVICE(ZVS,-2e99,'ADVECTION_UVW_CEN::ZVS')
@@ -327,6 +351,13 @@ IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADV_BU_RW')
#ifdef _OPENACC
CALL MNH_REL_ZT3D(IZ1, IZ2)
#endif
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PRUS,"ADVECTION_UVW_CEN end:PRUS")
+ CALL MPPDB_CHECK(PRVS,"ADVECTION_UVW_CEN end:PRVS")
+ CALL MPPDB_CHECK(PRWS,"ADVECTION_UVW_CEN end:PRWS")
+END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADVECTION_UVW_CEN
diff --git a/src/MNH/advecuvw_4th.f90 b/src/MNH/advecuvw_4th.f90
index 6b934947c..a08f06bd1 100644
--- a/src/MNH/advecuvw_4th.f90
+++ b/src/MNH/advecuvw_4th.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 adiab 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###########################
MODULE MODI_ADVECUVW_4TH
! ###########################
@@ -184,6 +179,7 @@ USE MODD_GRID_n
USE MODD_PARAMETERS
USE MODE_ll
+use mode_mppdb
#ifdef _OPENACC
use mode_msg
#endif
@@ -263,6 +259,20 @@ INTEGER :: II
#ifdef _OPENACC
call Print_msg( NVERB_WARNING, 'GEN', 'ADVECUVW_4TH', 'OpenACC: not yet tested' )
#endif
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PRUCT,"ADVECUVW_4TH beg:PRUCT")
+ CALL MPPDB_CHECK(PRVCT,"ADVECUVW_4TH beg:PRVCT")
+ CALL MPPDB_CHECK(PRWCT,"ADVECUVW_4TH beg:PRWCT")
+ CALL MPPDB_CHECK(PUT,"ADVECUVW_4TH beg:PUT")
+ CALL MPPDB_CHECK(PVT,"ADVECUVW_4TH beg:PVT")
+ CALL MPPDB_CHECK(PWT,"ADVECUVW_4TH beg:PWT")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PRUS,"ADVECUVW_4TH beg:PRUS")
+ CALL MPPDB_CHECK(PRVS,"ADVECUVW_4TH beg:PRVS")
+ CALL MPPDB_CHECK(PRWS,"ADVECUVW_4TH beg:PRWS")
+END IF
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES THE DOMAIN DIMENSIONS
@@ -448,6 +458,13 @@ PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP4
!$acc end kernels
#endif
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PRUS,"ADVECUVW_4TH end:PRUS")
+ CALL MPPDB_CHECK(PRVS,"ADVECUVW_4TH end:PRVS")
+ CALL MPPDB_CHECK(PRWS,"ADVECUVW_4TH end:PRWS")
+END IF
+
!-------------------------------------------------------------------------------
!
#ifdef _OPENACC
diff --git a/src/MNH/ppm.f90 b/src/MNH/ppm.f90
index 707ad9846..bd8606399 100644
--- a/src/MNH/ppm.f90
+++ b/src/MNH/ppm.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
@@ -428,6 +428,7 @@ CONTAINS
!-------------------------------------------------------------------------------
!
USE MODE_ll
+use mode_mppdb
#ifdef _OPENACC
use mode_msg
#endif
@@ -512,6 +513,14 @@ INTEGER :: IJS,IJN
#endif
LOGICAL :: GWEST , GEAST
!-------------------------------------------------------------------------------
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PCR, "PPM_01_X beg:PCR")
+ CALL MPPDB_CHECK(PRHO,"PPM_01_X beg:PRHO")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_01_X beg:PSRC")
+END IF
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -999,6 +1008,13 @@ ENDDO ; ENDDO ; ENDDO
!
END SELECT
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_01_X end:PSRC")
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PR,"PPM_01_X end:PR")
+END IF
+
#ifndef _OPENACC
CONTAINS
!
@@ -1145,6 +1161,8 @@ USE MODE_ll
#ifdef _OPENACC
use mode_msg
#endif
+use mode_mppdb
+
#ifndef _OPENACC
USE MODI_SHUMAN
#else
@@ -1227,6 +1245,14 @@ INTEGER :: IJN,IJS
#endif
integer :: ji, jj, jk
!-------------------------------------------------------------------------------
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PCR, "PPM_01_Y beg:PCR")
+ CALL MPPDB_CHECK(PRHO,"PPM_01_Y beg:PRHO")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_01_Y beg:PSRC")
+END IF
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -1699,6 +1725,13 @@ CALL GET_HALO_D(ZFPOS,HDIR="01_Y")
!
END SELECT
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_01_Y end:PSRC")
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PR,"PPM_01_Y end:PR")
+END IF
+
#ifndef _OPENACC
CONTAINS
!
@@ -1917,6 +1950,14 @@ INTEGER :: I,J,K
integer :: ji, jj, jk
!
!-------------------------------------------------------------------------------
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PCR, "PPM_01_Z beg:PCR")
+ CALL MPPDB_CHECK(PRHO,"PPM_01_Z beg:PRHO")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_01_Z beg:PSRC")
+END IF
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -2185,7 +2226,12 @@ end do
!Unnecessary CALL GET_HALO_D(PR)
#endif
!
-CALL MPPDB_CHECK3DM("PPM::PPM_01_Z ::PR",PRECISION,PR)
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_01_Z end:PSRC")
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PR,"PPM_01_Z end:PR")
+END IF
!
#ifndef _OPENACC
CONTAINS
@@ -2406,6 +2452,14 @@ INTEGER :: I,J,K
REAL, DIMENSION(SIZE(PCR,2),SIZE(PCR,3)) :: ZPSRC_HALO2_WEST
!$acc declare present (ZPSRC_HALO2_WEST)
!-------------------------------------------------------------------------------
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PCR, "PPM_S0_X beg:PCR")
+ CALL MPPDB_CHECK(PRHO,"PPM_S0_X beg:PRHO")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_S0_X beg:PSRC")
+END IF
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -2671,6 +2725,13 @@ CALL MPPDB_CHECK3DM("PPM::PPM_S0_X OPEN ::PR",PRECISION,PR)
!-------------------------------------------------------------------------------
CALL DEL_HALO2_ll(TZ_PSRC_HALO2_ll)
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_S0_X end:PSRC")
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PR,"PPM_S0_X end:PR")
+END IF
+!
#ifdef _OPENACC
END SUBROUTINE PPM_S0_X_D
@@ -2826,6 +2887,14 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,3)) :: ZPSRC_HALO2_SOUTH
!$acc declare present (ZPSRC_HALO2_SOUTH)
!
!-------------------------------------------------------------------------------
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PCR, "PPM_S0_Y beg:PCR")
+ CALL MPPDB_CHECK(PRHO,"PPM_S0_Y beg:PRHO")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_S0_Y beg:PSRC")
+END IF
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -3088,6 +3157,13 @@ CALL MPPDB_CHECK3DM("PPM::PPM_S0_Y OPEN ::PR",PRECISION,PR)
!
CALL DEL_HALO2_ll(TZ_PSRC_HALO2_ll)
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_S0_Y end:PSRC")
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PR,"PPM_S0_Y end:PR")
+END IF
+
#ifdef _OPENACC
END SUBROUTINE PPM_S0_Y_D
@@ -3219,6 +3295,14 @@ REAL, DIMENSION(:,:,:),INTENT(OUT):: ZFPOS, ZFNEG &
#endif
!
!-------------------------------------------------------------------------------
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PCR, "PPM_S0_Z beg:PCR")
+ CALL MPPDB_CHECK(PRHO,"PPM_S0_Z beg:PRHO")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_S0_Z beg:PSRC")
+END IF
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -3322,7 +3406,12 @@ PR = PSRC * PRHO - &
CALL GET_HALO_D(PR)
!$acc update device(PR)
#endif
-CALL MPPDB_CHECK3DM("PPM::PPM_S0_Z ::PR",PRECISION,PR)
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_S0_Z end:PSRC")
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PR,"PPM_S0_Z end:PR")
+END IF
!
#ifdef _OPENACC
END SUBROUTINE PPM_S0_Z_D
@@ -3421,6 +3510,8 @@ INTEGER :: IZPHAT,IZRUT,IZFUP,IZFCOR,IZRPOS,IZRNEG
!-------------------------------------------------------------------------------
!
USE MODE_ll
+use mode_mppdb
+
#ifndef _OPENACC
USE MODI_SHUMAN
#else
@@ -3486,6 +3577,15 @@ INTEGER :: II, IJ, IK
INTEGER :: IRESP ! for prints
!
!-------------------------------------------------------------------------------
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PCR, "PPM_S1_X beg:PCR")
+ CALL MPPDB_CHECK(PRHO, "PPM_S1_X beg:PRHO")
+ CALL MPPDB_CHECK(PRHOT,"PPM_S1_X beg:PRHOT")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC, "PPM_S1_X beg:PSRC")
+END IF
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -3669,6 +3769,12 @@ ZFCOR(IIB-1,:,:) = MIN( &
!
PR = PR - PTSTEP*DXF(ZFCOR)
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_S1_X end:PSRC")
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PR,"PPM_S1_X end:PR")
+END IF
!
#ifdef _OPENACC
END SUBROUTINE PPM_S1_X_D
@@ -3766,6 +3872,8 @@ INTEGER :: IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG
!-------------------------------------------------------------------------------
!
USE MODE_ll
+use mode_mppdb
+
#ifndef _OPENACC
USE MODI_SHUMAN
#else
@@ -3835,6 +3943,16 @@ INTEGER :: II, IJ, IK
INTEGER :: IRESP ! Return code of FM-routines
!
!-------------------------------------------------------------------------------
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PCR, "PPM_S1_Y beg:PCR")
+ CALL MPPDB_CHECK(PRHO, "PPM_S1_Y beg:PRHO")
+ CALL MPPDB_CHECK(PRHOT,"PPM_S1_Y beg:PRHOT")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC, "PPM_S1_Y beg:PSRC")
+END IF
+
!
IF ( L2D ) THEN
PR = PSRC*PRHO
@@ -4020,6 +4138,12 @@ ZFCOR(:,IJB-1,:) = MIN( &
!
PR = PR - PTSTEP*DYF(ZFCOR)
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_S1_Y end:PSRC")
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PR,"PPM_S1_Y end:PR")
+END IF
!
#ifdef _OPENACC
END SUBROUTINE PPM_S1_Y_D
@@ -4113,6 +4237,8 @@ INTEGER :: IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG
!-------------------------------------------------------------------------------
!
USE MODE_ll
+use mode_mppdb
+
#ifndef _OPENACC
USE MODI_SHUMAN
#else
@@ -4179,6 +4305,16 @@ REAL, PARAMETER :: ZEPS = 1.0E-16
INTEGER :: II, IJ, IK
!
!-------------------------------------------------------------------------------
+
+IF (MPPDB_INITIALIZED) THEN
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PCR, "PPM_S1_Z beg:PCR")
+ CALL MPPDB_CHECK(PRHO, "PPM_S1_Z beg:PRHO")
+ CALL MPPDB_CHECK(PRHOT,"PPM_S1_Z beg:PRHOT")
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC, "PPM_S1_Z beg:PSRC")
+END IF
+
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
@@ -4427,6 +4563,12 @@ ZFCOR(:,:,IKB-1) = MIN( &
!
PR = PR - PTSTEP*DZF(1,IKU,1,ZFCOR)
!
+IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK(PSRC,"PPM_S1_Z end:PSRC")
+ !Check all OUT arrays
+ CALL MPPDB_CHECK(PR,"PPM_S1_Z end:PR")
+END IF
!
#ifdef _OPENACC
END SUBROUTINE PPM_S1_Z_D
--
GitLab