From 6fa32f3673e570df3a8035a88fa30a44b82f8473 Mon Sep 17 00:00:00 2001 From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr> Date: Wed, 24 Jul 2019 13:08:13 +0200 Subject: [PATCH] Philippe 24/07/2019: mppdb_check: use 4D version for 4D real arrays to prevent problems with arrays smaller than thought --- src/MNH/ice4_sedimentation_split.f90 | 18 ++------ src/MNH/rain_ice.f90 | 6 +-- src/MNH/rain_ice_red.f90 | 6 +-- src/MNH/rain_ice_sedimentation_split.f90 | 6 +-- src/MNH/resolved_cloud.f90 | 56 +++++------------------- 5 files changed, 16 insertions(+), 76 deletions(-) diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90 index 662914c2d..747050304 100644 --- a/src/MNH/ice4_sedimentation_split.f90 +++ b/src/MNH/ice4_sedimentation_split.f90 @@ -372,11 +372,7 @@ IF (MPPDB_INITIALIZED) THEN CALL MPPDB_CHECK(PINPRS,"ICE4_SEDIMENTATION_SPLIT end:PINPRS") CALL MPPDB_CHECK(PINPRG,"ICE4_SEDIMENTATION_SPLIT end:PINPRG") IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PINPRH,"ICE4_SEDIMENTATION_SPLIT end:PINPRH") - IF (PRESENT(PFPR)) THEN - DO JK=1,SIZE(PFPR,4) - CALL MPPDB_CHECK(PFPR(:,:,:,JK),"ICE4_SEDIMENTATION_SPLIT end:PFPR(:,:,:,JK)") - END DO - END IF + IF (PRESENT(PFPR)) CALL MPPDB_CHECK(PFPR, "ICE4_SEDIMENTATION_SPLIT end:PFPR") END IF ! ! @@ -465,11 +461,7 @@ IF (MPPDB_INITIALIZED) THEN !Check all INOUT arrays CALL MPPDB_CHECK(PRXT,"INTERNAL_SEDIM_SPLI beg:PRXT") CALL MPPDB_CHECK(PRXS,"INTERNAL_SEDIM_SPLI beg:PRXS") - IF (PRESENT(PFPR)) THEN - DO JI=1,KRR - CALL MPPDB_CHECK(PFPR(:,:,:,JI),"INTERNAL_SEDIM_SPLI beg:") - END DO - END IF + IF (PRESENT(PFPR)) CALL MPPDB_CHECK(PFPR,"INTERNAL_SEDIM_SPLI beg:PFPR") END IF ! !------------------------------------------------------------------------------- @@ -665,11 +657,7 @@ IF (MPPDB_INITIALIZED) THEN !Check all INOUT arrays CALL MPPDB_CHECK(PRXT,"INTERNAL_SEDIM_SPLI end:PRXT") CALL MPPDB_CHECK(PRXS,"INTERNAL_SEDIM_SPLI end:PRXS") - IF (PRESENT(PFPR)) THEN - DO JI=1,KRR - CALL MPPDB_CHECK(PFPR(:,:,:,JI),"INTERNAL_SEDIM_SPLI beg:") - END DO - END IF + IF (PRESENT(PFPR)) CALL MPPDB_CHECK(PFPR,"INTERNAL_SEDIM_SPLI beg:PFPR") !Check all OUT arrays CALL MPPDB_CHECK(PINPRX,"INTERNAL_SEDIM_SPLI end:PINPRX") END IF diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90 index 3be17cc22..678be70b0 100644 --- a/src/MNH/rain_ice.f90 +++ b/src/MNH/rain_ice.f90 @@ -1299,11 +1299,7 @@ IF (MPPDB_INITIALIZED) THEN !Check all OUT arrays CALL MPPDB_CHECK(PINPRR3D,"RAIN_ICE end:PINPRR3D") CALL MPPDB_CHECK(PRAINFR, "RAIN_ICE end:PRAINFR") - IF (PRESENT(PFPR)) THEN - DO JL=1,SIZE(PFPR,4) - CALL MPPDB_CHECK(PFPR(:,:,:,JL),"RAIN_ICE end:PFPR(:,:,:,JL)") - END DO - END IF + IF (PRESENT(PFPR)) CALL MPPDB_CHECK(PFPR,"RAIN_ICE end:PFPR") END IF ! ! !$acc end data diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90 index e1195a4a5..843a35aaf 100644 --- a/src/MNH/rain_ice_red.f90 +++ b/src/MNH/rain_ice_red.f90 @@ -2003,11 +2003,7 @@ IF (MPPDB_INITIALIZED) THEN CALL MPPDB_CHECK(PINPRG,"RAIN_ICE_RED end:PINPRG") CALL MPPDB_CHECK(PRAINFR,"RAIN_ICE_RED end:PRAINFR") IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PINPRH,"RAIN_ICE_RED end:PINPRH") - IF (PRESENT(PFPR)) THEN - DO JL=1,SIZE(PFPR,4) - CALL MPPDB_CHECK(PFPR(:,:,:,JL),"RAIN_ICE_RED end:PFPR(:,:,:,JL)") - END DO - END IF + IF (PRESENT(PFPR)) CALL MPPDB_CHECK(PFPR, "RAIN_ICE_RED end:PFPR") END IF ! CONTAINS diff --git a/src/MNH/rain_ice_sedimentation_split.f90 b/src/MNH/rain_ice_sedimentation_split.f90 index 6a5024378..82ec74e5f 100644 --- a/src/MNH/rain_ice_sedimentation_split.f90 +++ b/src/MNH/rain_ice_sedimentation_split.f90 @@ -683,11 +683,7 @@ IF (MPPDB_INITIALIZED) THEN CALL MPPDB_CHECK(PINPRG,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRG") CALL MPPDB_CHECK(PINPRR3D,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRR3D") IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRH") - IF (PRESENT(PFPR)) THEN - DO JK=1,KRR - CALL MPPDB_CHECK(PFPR(:,:,:,JK),"RAIN_ICE_SEDIMENTATION_SPLIT end:PFPR(:,:,:,JK)") - END DO - END IF + IF (PRESENT(PFPR)) CALL MPPDB_CHECK(PFPR,"RAIN_ICE_SEDIMENTATION_SPLIT end:PFPR") END IF END SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90 index ec7847af7..7ab40d6ee 100644 --- a/src/MNH/resolved_cloud.f90 +++ b/src/MNH/resolved_cloud.f90 @@ -532,36 +532,16 @@ IF (MPPDB_INITIALIZED) THEN CALL MPPDB_CHECK(PCF_MF,"RESOLVED_CLOUD beg:PCF_MF") CALL MPPDB_CHECK(PRC_MF,"RESOLVED_CLOUD beg:PRC_MF") CALL MPPDB_CHECK(PRI_MF,"RESOLVED_CLOUD beg:PRI_MF") - ! DO JI=1,SIZE(PSOLORG,4) - ! CALL MPPDB_CHECK(PSOLORG(:,:,:,JI),"RESOLVED_CLOUD beg:PSOLORG(:,:,:,JI)") - ! END DO - ! DO JI=1,SIZE(PMI,4) - ! CALL MPPDB_CHECK(PMI(:,:,:,JI),"RESOLVED_CLOUD beg:PMI(:,:,:,JI)") - ! END DO + ! CALL MPPDB_CHECK(PSOLORG,"RESOLVED_CLOUD beg:PSOLORG") + ! CALL MPPDB_CHECK(PMI,"RESOLVED_CLOUD beg:PMI") IF (PRESENT(PSEA)) CALL MPPDB_CHECK(PSEA,"RESOLVED_CLOUD beg:PSEA") IF (PRESENT(PTOWN)) CALL MPPDB_CHECK(PTOWN,"RESOLVED_CLOUD beg:PTOWN") !Check all INOUT arrays - CALL MPPDB_CHECK(PRT(:,:,:,1),"RESOLVED_CLOUD beg:PRT(:,:,:,1)") - CALL MPPDB_CHECK(PRT(:,:,:,2),"RESOLVED_CLOUD beg:PRT(:,:,:,2)") - CALL MPPDB_CHECK(PRT(:,:,:,3),"RESOLVED_CLOUD beg:PRT(:,:,:,3)") - CALL MPPDB_CHECK(PRT(:,:,:,4),"RESOLVED_CLOUD beg:PRT(:,:,:,4)") - CALL MPPDB_CHECK(PRT(:,:,:,5),"RESOLVED_CLOUD beg:PRT(:,:,:,5)") - CALL MPPDB_CHECK(PRT(:,:,:,6),"RESOLVED_CLOUD beg:PRT(:,:,:,6)") - IF(SIZE(PRT,4)>6) CALL MPPDB_CHECK(PRT(:,:,:,7),"RESOLVED_CLOUD beg:PRT(:,:,:,7)") + CALL MPPDB_CHECK(PRT,"RESOLVED_CLOUD beg:PRT") CALL MPPDB_CHECK(PTHS,"RESOLVED_CLOUD beg:PTHS") - CALL MPPDB_CHECK(PRS(:,:,:,1),"RESOLVED_CLOUD beg:PRS(:,:,:,1)") - CALL MPPDB_CHECK(PRS(:,:,:,2),"RESOLVED_CLOUD beg:PRS(:,:,:,2)") - CALL MPPDB_CHECK(PRS(:,:,:,3),"RESOLVED_CLOUD beg:PRS(:,:,:,3)") - CALL MPPDB_CHECK(PRS(:,:,:,4),"RESOLVED_CLOUD beg:PRS(:,:,:,4)") - CALL MPPDB_CHECK(PRS(:,:,:,5),"RESOLVED_CLOUD beg:PRS(:,:,:,5)") - CALL MPPDB_CHECK(PRS(:,:,:,6),"RESOLVED_CLOUD beg:PRS(:,:,:,6)") - IF(SIZE(PRS,4)>6) CALL MPPDB_CHECK(PRS(:,:,:,7),"RESOLVED_CLOUD beg:PRS(:,:,:,7)") - DO JI=1,SIZE(PSVT,4) - CALL MPPDB_CHECK(PSVT(:,:,:,JI),"RESOLVED_CLOUD beg:PSVT(:,:,:,JI)") - END DO - DO JI=1,SIZE(PSVS,4) - CALL MPPDB_CHECK(PSVS(:,:,:,JI),"RESOLVED_CLOUD beg:PSVS(:,:,:,JI)") - END DO + CALL MPPDB_CHECK(PRS, "RESOLVED_CLOUD beg:PRS") + CALL MPPDB_CHECK(PSVT,"RESOLVED_CLOUD beg:PSVT") + CALL MPPDB_CHECK(PSVS,"RESOLVED_CLOUD beg:PSVS") CALL MPPDB_CHECK(PCLDFR,"RESOLVED_CLOUD beg:PCLDFR") CALL MPPDB_CHECK(PCIT,"RESOLVED_CLOUD beg:PCIT") CALL MPPDB_CHECK(PINPRC,"RESOLVED_CLOUD beg:PINPRC") @@ -1506,27 +1486,11 @@ ENDIF ! IF (MPPDB_INITIALIZED) THEN !Check all INOUT arrays - CALL MPPDB_CHECK(PRT(:,:,:,1),"RESOLVED_CLOUD end:PRT(:,:,:,1)") - CALL MPPDB_CHECK(PRT(:,:,:,2),"RESOLVED_CLOUD end:PRT(:,:,:,2)") - CALL MPPDB_CHECK(PRT(:,:,:,3),"RESOLVED_CLOUD end:PRT(:,:,:,3)") - CALL MPPDB_CHECK(PRT(:,:,:,4),"RESOLVED_CLOUD end:PRT(:,:,:,4)") - CALL MPPDB_CHECK(PRT(:,:,:,5),"RESOLVED_CLOUD end:PRT(:,:,:,5)") - CALL MPPDB_CHECK(PRT(:,:,:,6),"RESOLVED_CLOUD end:PRT(:,:,:,6)") - IF(SIZE(PRT,4)>6) CALL MPPDB_CHECK(PRT(:,:,:,7),"RESOLVED_CLOUD end:PRT(:,:,:,7)") + CALL MPPDB_CHECK(PRT,"RESOLVED_CLOUD end:PRT") CALL MPPDB_CHECK(PTHS,"RESOLVED_CLOUD end:PTHS") - CALL MPPDB_CHECK(PRS(:,:,:,1),"RESOLVED_CLOUD end:PRS(:,:,:,1)") - CALL MPPDB_CHECK(PRS(:,:,:,2),"RESOLVED_CLOUD end:PRS(:,:,:,2)") - CALL MPPDB_CHECK(PRS(:,:,:,3),"RESOLVED_CLOUD end:PRS(:,:,:,3)") - CALL MPPDB_CHECK(PRS(:,:,:,4),"RESOLVED_CLOUD end:PRS(:,:,:,4)") - CALL MPPDB_CHECK(PRS(:,:,:,5),"RESOLVED_CLOUD end:PRS(:,:,:,5)") - CALL MPPDB_CHECK(PRS(:,:,:,6),"RESOLVED_CLOUD end:PRS(:,:,:,6)") - IF(SIZE(PRS,4)>6) CALL MPPDB_CHECK(PRS(:,:,:,7),"RESOLVED_CLOUD end:PRS(:,:,:,7)") - DO JI=1,SIZE(PSVT,4) - CALL MPPDB_CHECK(PSVT(:,:,:,JI),"RESOLVED_CLOUD end:PSVT(:,:,:,JI)") - END DO - DO JI=1,SIZE(PSVS,4) - CALL MPPDB_CHECK(PSVS(:,:,:,JI),"RESOLVED_CLOUD end:PSVS(:,:,:,JI)") - END DO + CALL MPPDB_CHECK(PRS,"RESOLVED_CLOUD end:PRS") + CALL MPPDB_CHECK(PSVT,"RESOLVED_CLOUD end:PSVT") + CALL MPPDB_CHECK(PSVS,"RESOLVED_CLOUD end:PSVS") CALL MPPDB_CHECK(PCLDFR,"RESOLVED_CLOUD end:PCLDFR") CALL MPPDB_CHECK(PCIT,"RESOLVED_CLOUD end:PCIT") CALL MPPDB_CHECK(PINPRC,"RESOLVED_CLOUD end:PINPRC") -- GitLab