From f4103f28be8308d5bc5bfc82a4dcdf0d9de9abdb Mon Sep 17 00:00:00 2001 From: Sebastian Schubert Date: Fri, 19 Jun 2020 18:40:27 +0200 Subject: [PATCH 1/2] Consider only boxes with non-vanishing lad_s as plant boxes Before, if there was a box with non-vanishing lad_s above an empty box, the empty box was also considered --- SOURCE/radiation_model_mod.f90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/SOURCE/radiation_model_mod.f90 b/SOURCE/radiation_model_mod.f90 index a7bdd404..e19b6369 100644 --- a/SOURCE/radiation_model_mod.f90 +++ b/SOURCE/radiation_model_mod.f90 @@ -6957,13 +6957,12 @@ ! !-- Find topography top index k_topo = topo_top_ind(j,i,0) - + npcbl = npcbl + COUNT(lad_s(:,j,i) > 0.00000001_wp) DO k = nzt+1, 0, -1 IF ( lad_s(k,j,i) /= 0.0_wp ) THEN !-- we are at the top of the pcs pct(j,i) = k + k_topo pch(j,i) = k - npcbl = npcbl + pch(j,i) EXIT ENDIF ENDDO @@ -7082,9 +7081,11 @@ k_topo = topo_top_ind(j,i,0) DO k = k_topo + 1, pct(j,i) - ipcgb = ipcgb + 1 - gridpcbl(k,j,i) = ipcgb - pcbl(:,ipcgb) = (/ k, j, i /) + IF (lad_s(k - k_topo, j, i) > 0.00000001_wp) THEN + ipcgb = ipcgb + 1 + gridpcbl(k,j,i) = ipcgb + pcbl(:,ipcgb) = (/ k, j, i /) + END IF ENDDO ENDDO ENDDO -- GitLab From acbf0e18f8a9f62ada460c02d6ebe7f405575269 Mon Sep 17 00:00:00 2001 From: Sebastian Schubert Date: Mon, 22 Jun 2020 10:23:23 +0200 Subject: [PATCH 2/2] Introduce eps value for lad --- SOURCE/radiation_model_mod.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/SOURCE/radiation_model_mod.f90 b/SOURCE/radiation_model_mod.f90 index e19b6369..710f20fc 100644 --- a/SOURCE/radiation_model_mod.f90 +++ b/SOURCE/radiation_model_mod.f90 @@ -6925,7 +6925,7 @@ TYPE(c_ptr) :: gridsurf_rma_p !< allocated c pointer INTEGER(iwp) :: minfo !< MPI RMA window info handle #endif - + REAL(wp), PARAMETER :: eps_lad = 1E-10_wp !< epsilon for value comparison ! !-- precalculate face areas for different face directions using normal vector DO d = 0, nsurf_type @@ -6957,9 +6957,9 @@ ! !-- Find topography top index k_topo = topo_top_ind(j,i,0) - npcbl = npcbl + COUNT(lad_s(:,j,i) > 0.00000001_wp) + npcbl = npcbl + COUNT( lad_s(:,j,i) > eps_lad ) DO k = nzt+1, 0, -1 - IF ( lad_s(k,j,i) /= 0.0_wp ) THEN + IF ( lad_s(k,j,i) > eps_lad ) THEN !-- we are at the top of the pcs pct(j,i) = k + k_topo pch(j,i) = k @@ -7081,7 +7081,7 @@ k_topo = topo_top_ind(j,i,0) DO k = k_topo + 1, pct(j,i) - IF (lad_s(k - k_topo, j, i) > 0.00000001_wp) THEN + IF ( lad_s(k - k_topo, j, i) > eps_lad ) THEN ipcgb = ipcgb + 1 gridpcbl(k,j,i) = ipcgb pcbl(:,ipcgb) = (/ k, j, i /) -- GitLab