diff --git a/src/MNH/adv_boundaries.f90 b/src/MNH/adv_boundaries.f90 index 4444e683f63864928ced635ff1e72a2079f5b96a..c5e4df7525046cbb35ad06b6d235a428ef7f30ec 100644 --- a/src/MNH/adv_boundaries.f90 +++ b/src/MNH/adv_boundaries.f90 @@ -1,11 +1,16 @@ -!MNH_LIC Copyright 1994-2014 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. +!------------------------------------------------------------------------------- !##################### MODULE MODI_ADV_BOUNDARIES !##################### -! + +use mode_mppdb + +implicit none + #ifdef _OPENACC INTERFACE ADV_BOUNDARIES_DEVICE MODULE PROCEDURE ADV_BOUNDARIES_DEVICE1, ADV_BOUNDARIES_DEVICE2, ADV_BOUNDARIES_DEVICE3 @@ -96,6 +101,8 @@ INTEGER :: IIU, IJU ! Index End in X and Y directions ! !------------------------------------------------------------------------------- ! +CALL MPPDB_CHECK(PFIELD,"ADV_BOUNDARIES beg:PFIELD") +! !* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES: ! ---------------------------------------------- IKB = 1 + JPVEXT @@ -125,6 +132,8 @@ IF (SIZE(PFIELD)==0) RETURN !Not enough? !$acc update self(PFIELD(:,:,IKE+1)) !$acc update self(PFIELD(:,:,:)) ! +CALL MPPDB_CHECK(PFIELD,"ADV_BOUNDARIES end:PFIELD") +! !------------------------------------------------------------------------------- ! END SUBROUTINE ADV_BOUNDARIES_DEVICE1 @@ -168,6 +177,9 @@ INTEGER :: IIB,IIE,IJB,IJE ! interior domaine bound ! !------------------------------------------------------------------------------- ! +CALL MPPDB_CHECK(PFIELDI,"ADV_BOUNDARIES beg:PFIELDI") +CALL MPPDB_CHECK(PFIELD,"ADV_BOUNDARIES beg:PFIELD") +! !* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES: ! ---------------------------------------------- CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) @@ -233,6 +245,8 @@ IF (SIZE(PFIELD)==0) RETURN !$acc update self(PFIELD(:,:,:)) #endif ! +CALL MPPDB_CHECK(PFIELD,"ADV_BOUNDARIES end:PFIELD") +! !------------------------------------------------------------------------------- ! END SUBROUTINE ADV_BOUNDARIES_DEVICE2 @@ -278,6 +292,9 @@ INTEGER :: IFLAG ! Variable to workaround a performance problem ! !------------------------------------------------------------------------------- ! +CALL MPPDB_CHECK(PFIELDI,"ADV_BOUNDARIES beg:PFIELDI") +CALL MPPDB_CHECK(PFIELD,"ADV_BOUNDARIES beg:PFIELD") +! !* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES: ! ---------------------------------------------- CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) @@ -367,6 +384,8 @@ END SELECT !$acc update self(PFIELD(:,:,:)) #endif ! +CALL MPPDB_CHECK(PFIELD,"ADV_BOUNDARIES end:PFIELD") +! !------------------------------------------------------------------------------- ! END SUBROUTINE ADV_BOUNDARIES_DEVICE3 @@ -413,6 +432,9 @@ INTEGER :: IIB,IIE,IJB,IJE ! interior domaine bound ! !------------------------------------------------------------------------------- ! +if ( present( PFIELDI ) ) call MPPDB_CHECK(PFIELDI,"ADV_BOUNDARIES beg:PFIELDI") +CALL MPPDB_CHECK(PFIELD,"ADV_BOUNDARIES beg:PFIELD") +! !* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES: ! ---------------------------------------------- CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) @@ -475,6 +497,7 @@ END IF IF (HFIELD=='W') PFIELD(:,:,IKE+1) = 0. END IF !------------------------------------------------------------------------------- +CALL MPPDB_CHECK(PFIELD,"ADV_BOUNDARIES end:PFIELD") ! END SUBROUTINE ADV_BOUNDARIES diff --git a/src/MNH/advec_ppm_algo.f90 b/src/MNH/advec_ppm_algo.f90 index 5895c04bfda6c324e4fa0b53661a8ed3d92eb602..1717dd884490b6adb211701f4d8433daa241f833 100644 --- a/src/MNH/advec_ppm_algo.f90 +++ b/src/MNH/advec_ppm_algo.f90 @@ -1,13 +1,8 @@ -!MNH_LIC Copyright 1994-2014 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. !----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 adiab 2007/03/27 10:07:52 -!----------------------------------------------------------------- ! ########################## MODULE MODI_ADVEC_PPM_ALGO ! ########################## @@ -148,6 +143,7 @@ USE MODD_TYPE_DATE #ifdef _OPENACC USE MODE_DEVICE #endif +use mode_mppdb ! USE MODI_SHUMAN USE MODI_PPM @@ -186,12 +182,26 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRC ! source term after advection ! LOGICAL :: GFLAG ! Logical flag #ifdef _OPENACC -REAL, DIMENSION(SIZE(PFIELDT,1),SIZE(PFIELDT,2),SIZE(PFIELDT,3)) :: ZPPM ! temp PPM output +REAL, DIMENSION(:,:,:) :: ZPPM ! temp PPM output !$acc declare present(ZPPM) #endif ! !------------------------------------------------------------------------------- ! +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PFIELDT,"ADVEC_PPM_ALGO beg:PFIELDT") + CALL MPPDB_CHECK(PCRU,"ADVEC_PPM_ALGO beg:PCRU") + CALL MPPDB_CHECK(PCRV,"ADVEC_PPM_ALGO beg:PCRV") + CALL MPPDB_CHECK(PCRW,"ADVEC_PPM_ALGO beg:PCRW") + CALL MPPDB_CHECK(PRHODJ,"ADVEC_PPM_ALGO beg:PRHODJ") + CALL MPPDB_CHECK(PRHOX1,"ADVEC_PPM_ALGO beg:PRHOX1") + CALL MPPDB_CHECK(PRHOX2,"ADVEC_PPM_ALGO beg:PRHOX2") + CALL MPPDB_CHECK(PRHOY1,"ADVEC_PPM_ALGO beg:PRHOY1") + CALL MPPDB_CHECK(PRHOY2,"ADVEC_PPM_ALGO beg:PRHOY2") + CALL MPPDB_CHECK(PRHOZ1,"ADVEC_PPM_ALGO beg:PRHOZ1") + CALL MPPDB_CHECK(PRHOZ2,"ADVEC_PPM_ALGO beg:PRHOZ2") +END IF ! The scalar PFIELDT is first advected by U*dt first in X, then the resulting ! field is a advected in Y and finally in Z direction. The advection steps are ! stored in PSRC which is finally passed back to the model as a source after @@ -497,6 +507,11 @@ END SELECT PSRC = (PSRC - PFIELDT)*PRHODJ/PTSTEP_PPM !$acc end kernels ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PSRC,"ADVEC_PPM_ALGO end:PSRC") +END IF +! #ifdef _OPENACC END SUBROUTINE ADVEC_PPM_ALGO_D #endif diff --git a/src/MNH/advec_weno_k_2_aux.f90 b/src/MNH/advec_weno_k_2_aux.f90 index 04a251bf4fca217d692765bcfc7ab797c159de4c..61d549d605cf2c4d431fc6aa2e606cf99d0198c5 100644 --- a/src/MNH/advec_weno_k_2_aux.f90 +++ b/src/MNH/advec_weno_k_2_aux.f90 @@ -1,7 +1,8 @@ -!MNH_LIC Copyright 1994-2014 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. +!------------------------------------------------------------------------------- ! ############################## MODULE MODI_ADVEC_WENO_K_2_AUX ! ############################## @@ -190,7 +191,7 @@ FUNCTION WENO_K_2_WZ(PSRC, PRWCT) RESULT(PR) ! REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID -!$acc declare present(PSRC,PRwCT) +!$acc declare present(PSRC,PRWCT) ! ! output source term REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR @@ -203,7 +204,7 @@ SUBROUTINE WENO_K_2_WZ(PSRC, PRWCT, PR, & ! REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID -!$acc declare present(PSRC,PRwCT) +!$acc declare present(PSRC,PRWCT) ! ! output source term REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR @@ -230,7 +231,7 @@ FUNCTION WENO_K_2_MZ(PSRC, PRWCT) RESULT(PR) ! REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid -!$acc declare present(PSRC,PRwCT) +!$acc declare present(PSRC,PRWCT) ! ! output source term REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR @@ -243,7 +244,7 @@ SUBROUTINE WENO_K_2_MZ(PSRC, PRWCT, PR, & ! REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid -!$acc declare present(PSRC,PRwCT) +!$acc declare present(PSRC,PRWCT) ! ! output source term REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR @@ -365,6 +366,11 @@ REAL, PARAMETER :: ZGAMMA2 = 2./3. REAL, PARAMETER :: ZEPS = 1.0E-15 ! !----------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "ADVEC_WENO_K_2_UX beg:PSRC") + CALL MPPDB_CHECK(PRUCT,"ADVEC_WENO_K_2_UX beg:PRUCT") +END IF !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ ! @@ -635,8 +641,12 @@ CALL GET_HALO(PR) CALL GET_HALO_D(PR) !!$!$acc update device(PR) #endif -CALL MPPDB_CHECK3DM("advec_weno_k_2_ux::PR",PRECISION,PR) ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_2_UX end:PR") +END IF + END SUBROUTINE ADVEC_WENO_K_2_UX ! !------------------------------------------------------------------------------ @@ -673,6 +683,7 @@ USE MODI_GET_HALO #ifdef MNH_BITREP USE MODI_BITREP #endif +use mode_mppdb ! IMPLICIT NONE ! @@ -735,6 +746,10 @@ REAL, PARAMETER :: ZGAMMA2 = 2./3. REAL, PARAMETER :: ZEPS = 1.0E-15 ! !------------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_2_MX end:PR") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -1008,6 +1023,11 @@ CALL GET_HALO_D(PR) !!$!$acc update device(PR) #endif ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_2_MX end:PR") +END IF + END SUBROUTINE ADVEC_WENO_K_2_MX ! !------------------------------------------------------------------------------- @@ -1044,6 +1064,7 @@ USE MODI_GET_HALO #ifdef MNH_BITREP USE MODI_BITREP #endif +use mode_mppdb ! IMPLICIT NONE ! @@ -1107,6 +1128,11 @@ REAL, PARAMETER :: ZGAMMA2 = 2./3. REAL, PARAMETER :: ZEPS = 1.0E-15 ! !----------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "ADVEC_WENO_K_2_MY beg:PSRC") + CALL MPPDB_CHECK(PRVCT,"ADVEC_WENO_K_2_MY beg:PRVCT") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -1378,6 +1404,11 @@ CALL GET_HALO_D(PR) !!$!$acc update device(PR) #endif ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_2_MY end:PR") +END IF + END SUBROUTINE ADVEC_WENO_K_2_MY !------------------------------------------------------------------------------- ! @@ -1412,6 +1443,7 @@ USE MODI_GET_HALO #ifdef MNH_BITREP USE MODI_BITREP #endif +use mode_mppdb ! IMPLICIT NONE ! @@ -1473,6 +1505,11 @@ REAL, PARAMETER :: ZGAMMA2 = 2./3. REAL, PARAMETER :: ZEPS = 1.0E-15 ! !---------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "ADVEC_WENO_K_2_VY beg:PSRC") + CALL MPPDB_CHECK(PRVCT,"ADVEC_WENO_K_2_VY beg:PRVCT") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -1741,6 +1778,11 @@ CALL GET_HALO_D(PR) !!$!$acc update device(PR) #endif ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_2_VY end:PR") +END IF + END SUBROUTINE ADVEC_WENO_K_2_VY ! !------------------------------------------------------------------------------- @@ -1775,6 +1817,7 @@ USE MODI_GET_HALO #ifdef MNH_BITREP USE MODI_BITREP #endif +use mode_mppdb ! IMPLICIT NONE ! @@ -1782,7 +1825,7 @@ IMPLICIT NONE ! REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID -!$acc declare present(PSRC,PRwCT) +!$acc declare present(PSRC,PRWCT) ! ! output source term #ifndef _OPENACC @@ -1829,6 +1872,11 @@ REAL, PARAMETER :: ZGAMMA2 = 2./3. REAL, PARAMETER :: ZEPS = 1.0E-15 ! !------------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "WENO_K_2_WZ beg:PSRC") + CALL MPPDB_CHECK(PRWCT,"WENO_K_2_WZ beg:PRWCT") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -1932,6 +1980,11 @@ CALL GET_HALO_D(PR) !!$!$acc update device(PR) #endif ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"WENO_K_2_WZ end:PR") +END IF + #ifndef _OPENACC END FUNCTION WENO_K_2_WZ #else @@ -1971,6 +2024,7 @@ USE MODI_GET_HALO #ifdef MNH_BITREP USE MODI_BITREP #endif +use mode_mppdb ! IMPLICIT NONE ! @@ -1978,7 +2032,7 @@ IMPLICIT NONE ! REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid -!$acc declare present(PSRC,PRwCT) +!$acc declare present(PSRC,PRWCT) ! ! output source term ! @@ -2027,6 +2081,11 @@ REAL, PARAMETER :: ZGAMMA2 = 2./3. REAL, PARAMETER :: ZEPS = 1.0E-15 ! !------------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "WENO_K_2_MZ beg:PSRC") + CALL MPPDB_CHECK(PRWCT,"WENO_K_2_MZ beg:PRWCT") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -2125,6 +2184,11 @@ CALL GET_HALO_D(PR) !!$!$acc update device(PR) #endif ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"WENO_K_2_MZ end:PR") +END IF + #ifndef _OPENACC END FUNCTION WENO_K_2_MZ #else diff --git a/src/MNH/advec_weno_k_3_aux.f90 b/src/MNH/advec_weno_k_3_aux.f90 index 180b3fc3164a9ec1248884f35b75b12cbdc7baa8..d775355120e9495e8465c7479c74cb7989108f71 100644 --- a/src/MNH/advec_weno_k_3_aux.f90 +++ b/src/MNH/advec_weno_k_3_aux.f90 @@ -295,6 +295,7 @@ USE MODD_CONF USE MODD_LUNIT ! USE MODE_ll +use mode_mppdb use mode_msg ! IMPLICIT NONE @@ -346,6 +347,11 @@ REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3 REAL, PARAMETER :: ZEPS = 1.0E-15 ! !----------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "ADVEC_WENO_K_3_UX beg:PSRC") + CALL MPPDB_CHECK(PRUCT,"ADVEC_WENO_K_3_UX beg:PRUCT") +END IF !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ ! @@ -926,6 +932,11 @@ END IF ! IF(LWEST_ll()) PR = PR * PRUCT ! Add contravariant flux !$acc end kernels ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_3_UX end:PR") +END IF + END SUBROUTINE ADVEC_WENO_K_3_UX ! !------------------------------------------------------------------------------ @@ -963,6 +974,7 @@ USE MODD_CONF USE MODD_LUNIT ! USE MODE_ll +use mode_mppdb use mode_msg ! IMPLICIT NONE @@ -1013,6 +1025,11 @@ REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3 REAL, PARAMETER :: ZEPS = 1.0E-15 ! !------------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "ADVEC_WENO_K_3_MX beg:PSRC") + CALL MPPDB_CHECK(PRUCT,"ADVEC_WENO_K_3_MX beg:PRUCT") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -1593,6 +1610,11 @@ END IF ! IF(LWEST_ll()) PR = PR * PRUCT ! Add contravariant flux !$acc end kernels ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_3_MX end:PR") +END IF + END SUBROUTINE ADVEC_WENO_K_3_MX ! !------------------------------------------------------------------------------- @@ -1631,6 +1653,7 @@ USE MODD_CONF USE MODD_LUNIT ! USE MODE_ll +use mode_mppdb use mode_msg ! IMPLICIT NONE @@ -1684,6 +1707,11 @@ REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3 REAL, PARAMETER :: ZEPS = 1.0E-15 ! !----------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "ADVEC_WENO_K_3_MY beg:PSRC") + CALL MPPDB_CHECK(PRVCT,"ADVEC_WENO_K_3_MY beg:PRVCT") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -2264,6 +2292,11 @@ END IF ! IF(LNORTH_ll()) PR = PR * PRVCT ! Add contravariant flux !$acc end kernels ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_3_MY end:PR") +END IF + END SUBROUTINE ADVEC_WENO_K_3_MY ! !------------------------------------------------------------------------------- @@ -2301,6 +2334,7 @@ USE MODD_CONF USE MODD_LUNIT ! USE MODE_ll +use mode_mppdb use mode_msg ! IMPLICIT NONE @@ -2353,6 +2387,11 @@ REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3 REAL, PARAMETER :: ZEPS = 1.0E-15 ! !---------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "ADVEC_WENO_K_3_VY beg:PSRC") + CALL MPPDB_CHECK(PRVCT,"ADVEC_WENO_K_3_VY beg:PRVCT") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -2937,6 +2976,11 @@ END IF ! IF(LNORTH_ll()) PR = PR * PRVCT ! Add contravariant flux !$acc end kernels ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_3_VY end:PR") +END IF + END SUBROUTINE ADVEC_WENO_K_3_VY ! !------------------------------------------------------------------------------- @@ -2969,6 +3013,7 @@ END SUBROUTINE ADVEC_WENO_K_3_VY USE MODE_ll USE MODD_CONF USE MODD_PARAMETERS,ONLY: JPVEXT +use mode_mppdb ! IMPLICIT NONE ! @@ -3022,6 +3067,11 @@ REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3 REAL, PARAMETER :: ZEPS = 1.0E-15 ! !------------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "WENO_K_3_WZ beg:PSRC") + CALL MPPDB_CHECK(PRWCT,"WENO_K_3_WZ beg:PRWCT") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -3191,6 +3241,11 @@ PR(:,:,IT-1) = (ZOMN2(:,:,IT-1)/(ZOMN1(:,:,IT-1)+ZOMN2(:,:,IT-1))*ZFNEG2(:,:,IT- PR = PR * PRWCT ! Add contravariant flux !$acc end kernels ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"WENO_K_3_WZ end:PR") +END IF + #ifndef _OPENACC END FUNCTION WENO_K_3_WZ #else @@ -3228,6 +3283,7 @@ END SUBROUTINE WENO_K_3_WZ USE MODE_ll USE MODD_CONF USE MODD_PARAMETERS,ONLY: JPVEXT +use mode_mppdb ! IMPLICIT NONE ! @@ -3281,6 +3337,11 @@ REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3 REAL, PARAMETER :: ZEPS = 1.0E-15 ! !------------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PSRC, "WENO_K_3_MZ beg:PSRC") + CALL MPPDB_CHECK(PRWCT,"WENO_K_3_MZ beg:PRWCT") +END IF ! !* 0.3. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ @@ -3450,6 +3511,11 @@ PR(:,:,IT) = (ZOMP2(:,:,IT)/(ZOMP1(:,:,IT)+ZOMP2(:,:,IT)) * ZFPOS2(:,:,IT) & PR = PR * PRWCT ! Add contravariant flux !$acc end kernels ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PR,"WENO_K_3_MZ end:PR") +END IF + #ifndef _OPENACC END FUNCTION WENO_K_3_MZ #else diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90 index b899c0ce0556d0e8d96eefeaa2f055d23fe84bcb..32eecccc25d8ce35b29bda7e1cb951599dc4d766 100644 --- a/src/MNH/advection_metsv.f90 +++ b/src/MNH/advection_metsv.f90 @@ -172,6 +172,7 @@ USE MODD_PARAMETERS USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL USE MODE_IO_FIELD_WRITE, only: IO_Field_write USE MODE_ll +use mode_mppdb USE MODE_MSG ! USE MODI_ADV_BOUNDARIES @@ -318,6 +319,32 @@ INTEGER :: IZ1, IZ2 #endif TYPE(TFIELDDATA) :: TZFIELD !------------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PUT,"ADVECTION_METSV beg:PUT") + CALL MPPDB_CHECK(PVT,"ADVECTION_METSV beg:PVT") + CALL MPPDB_CHECK(PWT,"ADVECTION_METSV beg:PWT") + CALL MPPDB_CHECK(PTHT,"ADVECTION_METSV beg:PTHT") + CALL MPPDB_CHECK(PTKET,"ADVECTION_METSV beg:PTKET") + CALL MPPDB_CHECK(PRHODJ,"ADVECTION_METSV beg:PRHODJ") + CALL MPPDB_CHECK(PPABST,"ADVECTION_METSV beg:PPABST") + CALL MPPDB_CHECK(PRT,"ADVECTION_METSV beg:PRT") + CALL MPPDB_CHECK(PSVT,"ADVECTION_METSV beg:PSVT") + CALL MPPDB_CHECK(PTHVREF,"ADVECTION_METSV beg:PTHVREF") + CALL MPPDB_CHECK(PDXX,"ADVECTION_METSV beg:PDXX") + CALL MPPDB_CHECK(PDYY,"ADVECTION_METSV beg:PDYY") + CALL MPPDB_CHECK(PDZZ,"ADVECTION_METSV beg:PDZZ") + CALL MPPDB_CHECK(PDZX,"ADVECTION_METSV beg:PDZX") + CALL MPPDB_CHECK(PDZY,"ADVECTION_METSV beg:PDZY") + CALL MPPDB_CHECK(PRTHS_CLD,"ADVECTION_METSV beg:PRTHS_CLD") + CALL MPPDB_CHECK(PRRS_CLD,"ADVECTION_METSV beg:PRRS_CLD") + CALL MPPDB_CHECK(PRSVS_CLD,"ADVECTION_METSV beg:PRSVS_CLD") + !Check all INOUT arrays + CALL MPPDB_CHECK(PRTHS,"ADVECTION_METSV beg:PRTHS") + CALL MPPDB_CHECK(PRTKES,"ADVECTION_METSV beg:PRTKES") + CALL MPPDB_CHECK(PRRS,"ADVECTION_METSV beg:PRRS") + CALL MPPDB_CHECK(PRSVS,"ADVECTION_METSV beg:PRSVS") +END IF ! !* 0. INITIALIZATION ! -------------- @@ -905,4 +932,14 @@ CALL MNH_REL_ZT3D(IZ1, IZ2) #endif !------------------------------------------------------------------------------- ! +IF (MPPDB_INITIALIZED) THEN + !Check all INOUT arrays + CALL MPPDB_CHECK(PRTHS,"ADVECTION_METSV end:PRTHS") + CALL MPPDB_CHECK(PRTKES,"ADVECTION_METSV end:PRTKES") + CALL MPPDB_CHECK(PRRS,"ADVECTION_METSV end:PRRS") + CALL MPPDB_CHECK(PRSVS,"ADVECTION_METSV end:PRSVS") + !Check all OUT arrays + CALL MPPDB_CHECK(PRTKES_ADV,"ADVECTION_METSV end:PRTKES_ADV") +END IF + END SUBROUTINE ADVECTION_METSV diff --git a/src/MNH/advection_uvw.f90 b/src/MNH/advection_uvw.f90 index 30b9f621ae84778631cc439a661040683460acb7..01e2ad773d2440ea6d9cb21ce21d02b706907d44 100644 --- a/src/MNH/advection_uvw.f90 +++ b/src/MNH/advection_uvw.f90 @@ -120,6 +120,7 @@ USE MODI_BUDGET USE MODE_DEVICE USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D, MNH_GET_ZT4D , MNH_REL_ZT4D #endif +use mode_mppdb ! !------------------------------------------------------------------------------- ! @@ -212,6 +213,26 @@ INTEGER :: IZRUSB, IZRUSE, IZRVSB, IZRVSE, IZRWSB, IZRWSE ! !* 0. INITIALIZATION ! -------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PUT,"ADVECTION_UVW beg:PUT") + CALL MPPDB_CHECK(PVT,"ADVECTION_UVW beg:PVT") + CALL MPPDB_CHECK(PWT,"ADVECTION_UVW beg:PWT") + CALL MPPDB_CHECK(PRHODJ,"ADVECTION_UVW beg:PRHODJ") + CALL MPPDB_CHECK(PDXX,"ADVECTION_UVW beg:PDXX") + CALL MPPDB_CHECK(PDYY,"ADVECTION_UVW beg:PDYY") + CALL MPPDB_CHECK(PDZZ,"ADVECTION_UVW beg:PDZZ") + CALL MPPDB_CHECK(PDZX,"ADVECTION_UVW beg:PDZX") + CALL MPPDB_CHECK(PDZY,"ADVECTION_UVW beg:PDZY") + CALL MPPDB_CHECK(PRUS_PRES,"ADVECTION_UVW beg:PRUS_PRES") + CALL MPPDB_CHECK(PRVS_PRES,"ADVECTION_UVW beg:PRVS_PRES") + CALL MPPDB_CHECK(PRWS_PRES,"ADVECTION_UVW beg:PRWS_PRES") + !Check all INOUT arrays + CALL MPPDB_CHECK(PRUS,"ADVECTION_UVW beg:PRUS") + CALL MPPDB_CHECK(PRVS,"ADVECTION_UVW beg:PRVS") + CALL MPPDB_CHECK(PRWS,"ADVECTION_UVW beg:PRWS") +END IF + #ifdef _OPENACC CALL INIT_ON_HOST_AND_DEVICE(ZRUT,-1e99,'ADVECTION_UVW::ZRUT') CALL INIT_ON_HOST_AND_DEVICE(ZRVT,-2e99,'ADVECTION_UVW::ZRVT') @@ -465,5 +486,12 @@ CALL MNH_REL_ZT4D(ISPL, IZRVSB) CALL MNH_REL_ZT4D(ISPL, IZRUSB) CALL MNH_REL_ZT3D(IZUT, IZVT, IZWT, IZ1, IZ2) #endif +IF (MPPDB_INITIALIZED) THEN + !Check all INOUT arrays + CALL MPPDB_CHECK(PRUS,"ADVECTION_UVW end:PRUS") + CALL MPPDB_CHECK(PRVS,"ADVECTION_UVW end:PRVS") + CALL MPPDB_CHECK(PRWS,"ADVECTION_UVW end:PRWS") +END IF + ! END SUBROUTINE ADVECTION_UVW diff --git a/src/MNH/advecuvw_rk.f90 b/src/MNH/advecuvw_rk.f90 index bd415b6236585571cff996408a2b5a103fe5047e..f7e1ca5f0ef23111783199959947aa4b48ae8592 100644 --- a/src/MNH/advecuvw_rk.f90 +++ b/src/MNH/advecuvw_rk.f90 @@ -239,6 +239,24 @@ TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange TYPE(LIST_ll), POINTER :: TZFIELDS4_ll ! list of fields to exchange ! !------------------------------------------------------------------------------- +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PU,"ADVECUVW_RK beg:PU") + CALL MPPDB_CHECK(PV,"ADVECUVW_RK beg:PV") + CALL MPPDB_CHECK(PW,"ADVECUVW_RK beg:PW") + CALL MPPDB_CHECK(PUT,"ADVECUVW_RK beg:PUT") + CALL MPPDB_CHECK(PVT,"ADVECUVW_RK beg:PVT") + CALL MPPDB_CHECK(PWT,"ADVECUVW_RK beg:PWT") + CALL MPPDB_CHECK(PMXM_RHODJ,"ADVECUVW_RK beg:PMXM_RHODJ") + CALL MPPDB_CHECK(PMYM_RHODJ,"ADVECUVW_RK beg:PMYM_RHODJ") + CALL MPPDB_CHECK(PMZM_RHODJ,"ADVECUVW_RK beg:PMZM_RHODJ") + CALL MPPDB_CHECK(PRUCT,"ADVECUVW_RK beg:PRUCT") + CALL MPPDB_CHECK(PRVCT,"ADVECUVW_RK beg:PRVCT") + CALL MPPDB_CHECK(PRWCT,"ADVECUVW_RK beg:PRWCT") + CALL MPPDB_CHECK(PRUS_OTHER,"ADVECUVW_RK beg:PRUS_OTHER") + CALL MPPDB_CHECK(PRVS_OTHER,"ADVECUVW_RK beg:PRVS_OTHER") + CALL MPPDB_CHECK(PRWS_OTHER,"ADVECUVW_RK beg:PRWS_OTHER") +END IF ! !* 0. INITIALIZATION ! -------------- @@ -524,4 +542,11 @@ CALL DEL_HALO2_ll(TZHALO2MT_ll) !------------------------------------------------------------------------------- !$acc end data ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PRUS_ADV,"ADVECUVW_RK end:PRUS_ADV") + CALL MPPDB_CHECK(PRVS_ADV,"ADVECUVW_RK end:PRVS_ADV") + CALL MPPDB_CHECK(PRWS_ADV,"ADVECUVW_RK end:PRWS_ADV") +END IF + END SUBROUTINE ADVECUVW_RK diff --git a/src/MNH/advecuvw_weno_k.f90 b/src/MNH/advecuvw_weno_k.f90 index 112b51848a290c6ea759732b210963dfce64cb6f..d27d1fc8bcd0257e210192bd7bf21b81d36c39d3 100644 --- a/src/MNH/advecuvw_weno_k.f90 +++ b/src/MNH/advecuvw_weno_k.f90 @@ -1,7 +1,8 @@ -!MNH_LIC Copyright 1994-2014 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. +!------------------------------------------------------------------------------- ! ########################### MODULE MODI_ADVECUVW_WENO_K ! ########################### @@ -143,6 +144,20 @@ INTEGER :: IZOMN1, IZOMN2, IZOMN3 #endif ! ! +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PRUCT,"ADVECUVW_WENO_K beg:PRUCT") + CALL MPPDB_CHECK(PRVCT,"ADVECUVW_WENO_K beg:PRVCT") + CALL MPPDB_CHECK(PRWCT,"ADVECUVW_WENO_K beg:PRWCT") + CALL MPPDB_CHECK(PUT,"ADVECUVW_WENO_K beg:PUT") + CALL MPPDB_CHECK(PVT,"ADVECUVW_WENO_K beg:PVT") + CALL MPPDB_CHECK(PWT,"ADVECUVW_WENO_K beg:PWT") + !Check all INOUT arrays + CALL MPPDB_CHECK(PRUS,"ADVECUVW_WENO_K beg:PRUS") + CALL MPPDB_CHECK(PRVS,"ADVECUVW_WENO_K beg:PRVS") + CALL MPPDB_CHECK(PRWS,"ADVECUVW_WENO_K beg:PRWS") +END IF + #ifdef _OPENACC CALL INIT_ON_HOST_AND_DEVICE(ZMEAN,1e90,'ADVECUVW_WENO_K::ZMEAN') CALL INIT_ON_HOST_AND_DEVICE(ZWORK,2e90,'ADVECUVW_WENO_K::ZWORK') @@ -636,4 +651,10 @@ END SELECT ! --------------------------------- !$acc update self(PRUS,PRVS,PRWS) ! +IF (MPPDB_INITIALIZED) THEN + CALL MPPDB_CHECK(PRUS,"ADVECUVW_WENO_K end:PRUS") + CALL MPPDB_CHECK(PRVS,"ADVECUVW_WENO_K end:PRVS") + CALL MPPDB_CHECK(PRWS,"ADVECUVW_WENO_K end:PRWS") +END IF + END SUBROUTINE ADVECUVW_WENO_K diff --git a/src/MNH/contrav.f90 b/src/MNH/contrav.f90 index de2d9666d4b3b83cb575c8c6ca5a2d1110014802..259080fb770898a0e8062f9ead8036586f79341f 100644 --- a/src/MNH/contrav.f90 +++ b/src/MNH/contrav.f90 @@ -188,7 +188,17 @@ INTEGER :: IINFO_ll !* 1. Compute the horizontal contravariant components ! ----------------------------------------------- ! -CALL MPPDB_CHECK3DM("contrav big ::PRU/V/WT",PRECISION,PRUT,PRVT,PRWT) +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PRUT,"CONTRAV beg:PRUT") + CALL MPPDB_CHECK(PRVT,"CONTRAV beg:PRVT") + CALL MPPDB_CHECK(PRWT,"CONTRAV beg:PRWT") + CALL MPPDB_CHECK(PDXX,"CONTRAV beg:PDXX") + CALL MPPDB_CHECK(PDYY,"CONTRAV beg:PDYY") + CALL MPPDB_CHECK(PDZZ,"CONTRAV beg:PDZZ") + CALL MPPDB_CHECK(PDZX,"CONTRAV beg:PDZX") + CALL MPPDB_CHECK(PDZY,"CONTRAV beg:PDZY") +END IF ! IIU= SIZE(PDXX,1) IJU= SIZE(PDXX,2) @@ -439,7 +449,12 @@ IF (KADV_ORDER == 4 ) THEN !!$ END IF END IF !----------------------------------------------------------------------- -CALL MPPDB_CHECK3DM("contrav end ::PRU/V/WCT",PRECISION,PRUCT,PRVCT,PRWCT) +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PRUCT,"CONTRAV end:PRUCT") + CALL MPPDB_CHECK(PRVCT,"CONTRAV end:PRVCT") + CALL MPPDB_CHECK(PRWCT,"CONTRAV end:PRWCT") +END IF ! END SUBROUTINE CONTRAV ! @@ -578,7 +593,17 @@ END IF !* 1. Compute the horizontal contravariant components ! ----------------------------------------------- ! -CALL MPPDB_CHECK3DM("contrav big ::PRU/V/WT",PRECISION,PRUT,PRVT,PRWT) +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PRUT,"CONTRAV beg:PRUT") + CALL MPPDB_CHECK(PRVT,"CONTRAV beg:PRVT") + CALL MPPDB_CHECK(PRWT,"CONTRAV beg:PRWT") + CALL MPPDB_CHECK(PDXX,"CONTRAV beg:PDXX") + CALL MPPDB_CHECK(PDYY,"CONTRAV beg:PDYY") + CALL MPPDB_CHECK(PDZZ,"CONTRAV beg:PDZZ") + CALL MPPDB_CHECK(PDZX,"CONTRAV beg:PDZX") + CALL MPPDB_CHECK(PDZY,"CONTRAV beg:PDZY") +END IF ! IIU= SIZE(PDXX,1) IJU= SIZE(PDXX,2) @@ -875,7 +900,12 @@ IF (KADV_ORDER == 4 ) THEN !!$ END IF END IF !----------------------------------------------------------------------- -CALL MPPDB_CHECK3DM("contrav end ::PRU/V/WCT",PRECISION,PRUCT,PRVCT,PRWCT) +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PRUCT,"CONTRAV end:PRUCT") + CALL MPPDB_CHECK(PRVCT,"CONTRAV end:PRVCT") + CALL MPPDB_CHECK(PRWCT,"CONTRAV end:PRWCT") +END IF ! END SUBROUTINE CONTRAV_DEVICE #endif diff --git a/src/MNH/dyn_sources.f90 b/src/MNH/dyn_sources.f90 index 5bdb5483a3334671dea952eafc5b626efe5a7406..d832d614fbad8afb4075ff1fb6b456897dc14c00 100644 --- a/src/MNH/dyn_sources.f90 +++ b/src/MNH/dyn_sources.f90 @@ -1,12 +1,8 @@ -!MNH_LIC Copyright 1994-2014 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. !----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -!----------------------------------------------------------------- ! ####################### MODULE MODI_DYN_SOURCES ! ####################### @@ -243,13 +239,13 @@ IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN ZWORK3(:,:,:) = 1.0 / ( XRADIUS + MZF(1,IKU,1,PZZ(:,:,:)) ) ZWORK1(:,:,:) = SPREAD( PCURVX(:,:),DIM=3,NCOPIES=IKU ) ZWORK2(:,:,:) = SPREAD( PCURVY(:,:),DIM=3,NCOPIES=IKU ) - CALL MPPDB_CHECK3DM("DYN_SOOURCES:ZWORK3,ZWORK1,ZWORK2",PRECISION,& + CALL MPPDB_CHECK3DM("DYN_SOURCES:ZWORK3,ZWORK1,ZWORK2",PRECISION,& & ZWORK3,ZWORK1,ZWORK2,& & MXM( MYF(ZRVT*PVT) * ZWORK2 * ZWORK3 ) , & & MXM( ( MYF(PVT) * ZWORK1 - MZF(1,IKU,1,PWT) ) * ZWORK3 ) ,& & MYF(PVT) * ZWORK1 - MZF(1,IKU,1,PWT) , & & MYF(PVT) , MZF(1,IKU,1,PWT) , MXM(PWT) , MYM(PWT) ) - CALL MPPDB_CHECK3DM("DYN_SOOURCES:SUITE",PRECISION,& + CALL MPPDB_CHECK3DM("DYN_SOURCES:SUITE",PRECISION,& & MXM(ZRVT),MXM(PVT),MXM(PWT),MXM(ZWORK1),MXM(ZWORK2),MXM(ZWORK3) ) ! PRUS(:,:,:) = PRUS & diff --git a/src/MNH/ppm_met.f90 b/src/MNH/ppm_met.f90 index a0f3171a2ac092ec20fafc256067e78c49399c59..54ae39457e1c39fd8d7b1a454a8635dc6031bbe8 100644 --- a/src/MNH/ppm_met.f90 +++ b/src/MNH/ppm_met.f90 @@ -1,7 +1,8 @@ -!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 2006-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. +!------------------------------------------------------------------------------- ! ! ##################### MODULE MODI_PPM_MET @@ -111,6 +112,8 @@ USE MODD_PARAMETERS USE MODD_CONF USE MODD_TYPE_DATE, ONLY: DATE_TIME ! +use mode_mppdb +! USE MODI_SHUMAN USE MODI_PPM USE MODI_ADVEC_PPM_ALGO @@ -172,6 +175,23 @@ INTEGER :: IGRID ! localisation on the model grid ! !------------------------------------------------------------------------------- ! +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PCRU,"PPM_MET beg:PCRU") + CALL MPPDB_CHECK(PCRV,"PPM_MET beg:PCRV") + CALL MPPDB_CHECK(PCRW,"PPM_MET beg:PCRW") + CALL MPPDB_CHECK(PRHODJ,"PPM_MET beg:PRHODJ") + CALL MPPDB_CHECK(PRHOX1,"PPM_MET beg:PRHOX1") + CALL MPPDB_CHECK(PRHOX2,"PPM_MET beg:PRHOX2") + CALL MPPDB_CHECK(PRHOY1,"PPM_MET beg:PRHOY1") + CALL MPPDB_CHECK(PRHOY2,"PPM_MET beg:PRHOY2") + CALL MPPDB_CHECK(PRHOZ1,"PPM_MET beg:PRHOZ1") + CALL MPPDB_CHECK(PRHOZ2,"PPM_MET beg:PRHOZ2") + CALL MPPDB_CHECK(PTHT,"PPM_MET beg:PTHT") + CALL MPPDB_CHECK(PTKET,"PPM_MET beg:PTKET") + CALL MPPDB_CHECK(PRT,"PPM_MET beg:PRT") +END IF +! !* 1. COMPUTES THE DOMAIN DIMENSIONS ! ------------------------------ ! @@ -213,5 +233,11 @@ DO JRR=1,KRR PRRS(:,:,:,JRR), TPDTCUR, PCRU, PCRV, PCRW ) END DO ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PRTHS,"PPM_MET end:PRTHS") + CALL MPPDB_CHECK(PRTKES,"PPM_MET end:PRTKES") + CALL MPPDB_CHECK(PRRS,"PPM_MET end:PRRS") +END IF ! END SUBROUTINE PPM_MET diff --git a/src/MNH/ppm_rhodj.f90 b/src/MNH/ppm_rhodj.f90 index c274100d9ba3b5e8c53bc84fdf2052bd2767666a..94c74171951e6c215f32a919f0825f88c8f80e39 100644 --- a/src/MNH/ppm_rhodj.f90 +++ b/src/MNH/ppm_rhodj.f90 @@ -1,7 +1,8 @@ -!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 2006-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. +!------------------------------------------------------------------------------- ! ! ##################### MODULE MODI_PPM_RHODJ @@ -81,6 +82,7 @@ USE MODI_PPM USE OPENACC USE MODE_DEVICE +use mode_mppdb ! USE MODE_MNH_ZWORK, ONLY : ZUNIT => ZUNIT3D #endif @@ -119,6 +121,13 @@ REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZUNIT ! !------------------------------------------------------------------------------- ! +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PCRU,"PPM_RHODJ beg:PCRU") + CALL MPPDB_CHECK(PCRV,"PPM_RHODJ beg:PCRV") + CALL MPPDB_CHECK(PCRW,"PPM_RHODJ beg:PCRW") + CALL MPPDB_CHECK(PRHODJ,"PPM_RHODJ beg:PRHODJ") +END IF ! IGRID = 1 ! @@ -139,5 +148,14 @@ CALL PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, PRHOZ2, PTSTEP,PRHOY2) CALL PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, PRHOY2, PTSTEP,PRHOX2) #endif ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PRHOX1,"PPM_RHODJ end:PRHOX1") + CALL MPPDB_CHECK(PRHOX2,"PPM_RHODJ end:PRHOX2") + CALL MPPDB_CHECK(PRHOY1,"PPM_RHODJ end:PRHOY1") + CALL MPPDB_CHECK(PRHOY2,"PPM_RHODJ end:PRHOY2") + CALL MPPDB_CHECK(PRHOZ1,"PPM_RHODJ end:PRHOZ1") + CALL MPPDB_CHECK(PRHOZ2,"PPM_RHODJ end:PRHOZ2") +END IF ! END SUBROUTINE PPM_RHODJ diff --git a/src/MNH/ppm_scalar.f90 b/src/MNH/ppm_scalar.f90 index bf722f2c5c92e375a252f51133b91185075a6627..f2a70f386b5b9da328cb7585a6434d193c345271 100644 --- a/src/MNH/ppm_scalar.f90 +++ b/src/MNH/ppm_scalar.f90 @@ -1,7 +1,8 @@ -!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 2006-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. +!------------------------------------------------------------------------------- ! ! ! ##################### @@ -171,6 +172,8 @@ USE MODD_CONF USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll USE MODD_TYPE_DATE, ONLY: DATE_TIME ! +use mode_mppdb +! USE MODI_SHUMAN USE MODI_PPM USE MODI_ADVEC_PPM_ALGO @@ -217,6 +220,21 @@ INTEGER :: IGRID ! localisation on the model grid ! !------------------------------------------------------------------------------- ! +IF (MPPDB_INITIALIZED) THEN + !Check all IN arrays + CALL MPPDB_CHECK(PCRU,"PPM_SCALAR beg:PCRU") + CALL MPPDB_CHECK(PCRV,"PPM_SCALAR beg:PCRV") + CALL MPPDB_CHECK(PCRW,"PPM_SCALAR beg:PCRW") + CALL MPPDB_CHECK(PRHODJ,"PPM_SCALAR beg:PRHODJ") + CALL MPPDB_CHECK(PRHOX1,"PPM_SCALAR beg:PRHOX1") + CALL MPPDB_CHECK(PRHOX2,"PPM_SCALAR beg:PRHOX2") + CALL MPPDB_CHECK(PRHOY1,"PPM_SCALAR beg:PRHOY1") + CALL MPPDB_CHECK(PRHOY2,"PPM_SCALAR beg:PRHOY2") + CALL MPPDB_CHECK(PRHOZ1,"PPM_SCALAR beg:PRHOZ1") + CALL MPPDB_CHECK(PRHOZ2,"PPM_SCALAR beg:PRHOZ2") + CALL MPPDB_CHECK(PSVT,"PPM_SCALAR beg:PSVT") +END IF +! !* 1. CALL THE ADVEC_PPM_ALGO ROUTINE FOR EACH FIELD ! ----------------------------------------------- ! @@ -235,6 +253,11 @@ CALL ABORT PRSVS(:,:,:,JSV), TPDTCUR, PCRU, PCRV, PCRW) END DO ! +IF (MPPDB_INITIALIZED) THEN + !Check all OUT arrays + CALL MPPDB_CHECK(PRSVS,"PPM_SCALAR end:PRSVS") +END IF +! #ifdef _OPENACC END SUBROUTINE PPM_SCALAR_D #endif diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90 index ae46274d611f0804f31ddd544b5bab0b067fff79..8927e5492e890511b9734f9291621fa6c6cbc98f 100644 --- a/src/MNH/resolved_cloud.f90 +++ b/src/MNH/resolved_cloud.f90 @@ -1532,7 +1532,8 @@ IF (MPPDB_INITIALIZED) THEN CALL MPPDB_CHECK(PNPRO,"RESOLVED_CLOUD end:PNPRO") CALL MPPDB_CHECK(PSSPRO,"RESOLVED_CLOUD end:PSSPRO") !Check all OUT arrays - CALL MPPDB_CHECK(PSRCS,"RESOLVED_CLOUD end:PSRCS") + CALL MPPDB_CHECK(PSRCS, "RESOLVED_CLOUD end:PSRCS") + CALL MPPDB_CHECK(PRAINFR,"RESOLVED_CLOUD end:PRAINFR") END IF !------------------------------------------------------------------------------- !