Changeset 4220 for palm/trunk/SOURCE

Timestamp:

Sep 5, 2019 4:42:39 PM (5 years ago)

Author:

suehring

Message:

Map 3d plant-canopy output to surface (this feature was lost by the latest bugfix in 3d canopy output)

File:

• palm/trunk/SOURCE/plant_canopy_model_mod.f90 (modified) (11 diffs)

palm/trunk/SOURCE/plant_canopy_model_mod.f90

@@ -27 +27 @@
 ! -----------------
 ! $Id$
+! Further bugfix in 3d data output for plant canopy
+! 
+! 4216 2019-09-04 09:09:03Z suehring
 ! Bugfixes in 3d data output
 ! 
@@ -633 +636 @@
     INTEGER(iwp) ::  j      !< grid index y-direction
     INTEGER(iwp) ::  k      !< grid index z-direction
-    INTEGER(iwp) ::  kk     !< grid index z-direction relative to canopy arrays
     INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
     INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
@@ -652 +654 @@
 !--    Thus, output must be relative to these array indices. Further, check
 !--    whether the output is within the vertical output range,
-!--    i.e. nzb_do:nzt_do.
+!--    i.e. nzb_do:nzt_do, which is necessary as local_pf is only allocated
+!--    for this index space. Note, plant-canopy output has a separate 
+!--    vertical output coordinate zlad, so that output is mapped down to the 
+!--    surface. 
        CASE ( 'pcm_heatrate' )
           IF ( av == 0 )  THEN
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
-                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
-                      kk = k - topo_top_ind(j,i,0)
-                      local_pf(i,j,k) = pc_heating_rate(kk,j,i)
+                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
+                      local_pf(i,j,k) = pc_heating_rate(k,j,i)
                    ENDDO
                 ENDDO
@@ -667 +670 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
-                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
-                      kk = k - topo_top_ind(j,i,0)
-                      local_pf(i,j,k) = pcm_heatrate_av(kk,j,i)
+                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
+                      local_pf(i,j,k) = pcm_heatrate_av(k,j,i)
                    ENDDO
                 ENDDO
@@ -680 +681 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
-                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
-                      kk = k - topo_top_ind(j,i,0)
-                      local_pf(i,j,k) = pc_latent_rate(kk,j,i)
+                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
+                      local_pf(i,j,k) = pc_latent_rate(k,j,i)
                    ENDDO
                 ENDDO
@@ -690 +689 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
-                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
-                      kk = k - topo_top_ind(j,i,0)
-                      local_pf(i,j,k) = pcm_latentrate_av(kk,j,i)
+                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
+                      local_pf(i,j,k) = pcm_latentrate_av(k,j,i)
                    ENDDO
                 ENDDO
@@ -703 +700 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
-                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
-                      kk = k - topo_top_ind(j,i,0)
-                      local_pf(i,j,k) = pc_transpiration_rate(kk,j,i)
+                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
+                      local_pf(i,j,k) = pc_transpiration_rate(k,j,i)
                    ENDDO
                 ENDDO
@@ -713 +708 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
-                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
-                      kk = k - topo_top_ind(j,i,0)
-                      local_pf(i,j,k) = pcm_transpirationrate_av(kk,j,i)
+                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
+                      local_pf(i,j,k) = pcm_transpirationrate_av(k,j,i)
                    ENDDO
                 ENDDO
@@ -726 +719 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
-                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
-                      kk = k - topo_top_ind(j,i,0)
-                      IF ( pc_latent_rate(kk,j,i) /= 0.0_wp ) THEN
-                         local_pf(i,j,k) = pc_heating_rate(kk,j,i) /           &
-                                           pc_latent_rate(kk,j,i)
+                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
+                      IF ( pc_latent_rate(k,j,i) /= 0.0_wp ) THEN
+                         local_pf(i,j,k) = pc_heating_rate(k,j,i) /            &
+                                           pc_latent_rate(k,j,i)
                       ENDIF
                    ENDDO
@@ -739 +730 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
-                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
-                      kk = k - topo_top_ind(j,i,0)
-                      IF ( pcm_latentrate_av(kk,j,i) /= 0.0_wp ) THEN
-                         local_pf(i,j,k) = pcm_heatrate_av(kk,j,i) /           &
-                                           pcm_latentrate_av(kk,j,i)
+                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
+                      IF ( pcm_latentrate_av(k,j,i) /= 0.0_wp ) THEN
+                         local_pf(i,j,k) = pcm_heatrate_av(k,j,i) /            &
+                                           pcm_latentrate_av(k,j,i)
                       ENDIF
                    ENDDO
@@ -755 +744 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   DO  k = MAX( topo_top_ind(j,i,0)+1, nzb_do ),               &
-                           MIN( topo_top_ind(j,i,0) + pch_index_ji(j,i), nzt_do )
-                      kk = k - topo_top_ind(j,i,0)
-                      local_pf(i,j,k) = lad_s(kk,j,i)
+                   DO  k = MAX( 1, nzb_do ), MIN( pch_index, nzt_do )
+                      local_pf(i,j,k) = lad_s(k,j,i)
                    ENDDO
                 ENDDO