Changeset 3014 for palm/trunk/SOURCE/plant_canopy_model_mod.f90

Timestamp:

May 9, 2018 8:42:38 AM (6 years ago)

Author:

maronga

Message:

series of bugfixes

File:

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

palm/trunk/SOURCE/plant_canopy_model_mod.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! Bugfix: nzb_do and nzt_do were not used for 3d data output
+! Added pc_transpiration_rate
+! 
+! 2977 2018-04-17 10:27:57Z kanani
 ! Implement changes from branch radiation (r2948-2971) with minor modifications,
 ! plus some formatting.
@@ -230 +234 @@
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  lad_s            !< lad on scalar-grid
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_heating_rate  !< plant canopy heating rate
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pc_transpiration_rate  !< plant canopy transpiration rate
 
     SAVE
@@ -243 +248 @@
 !
 !-- Public variables and constants
-    PUBLIC pc_heating_rate, canopy_mode, cthf, dt_plant_canopy, lad, lad_s,   &
+    PUBLIC pc_heating_rate, pc_transpiration_rate, canopy_mode, cthf, dt_plant_canopy, lad, lad_s,   &
            pch_index
            
@@ -315 +320 @@
           unit = 'K s-1'
     
+       CASE ( 'pcm_transpirationrate' )
+          unit = 'kg kg-1 s-1'
+
        CASE ( 'pcm_lad' )
           unit = 'm2 m-3'
@@ -404 +412 @@
 !> Subroutine defining 3D output variables
 !------------------------------------------------------------------------------!
- SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf, fill_value )
- 
-    USE control_parameters,                                                    &
-        ONLY :  nz_do3d
- 
+ SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf, fill_value,     &
+                                nzb_do, nzt_do )
+  
     USE indices
 
@@ -423 +429 @@
     INTEGER(iwp) ::  k      !< 
     INTEGER(iwp) ::  k_topo !< topography top index
+    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)
 
     LOGICAL      ::  found !< 
 
     REAL(wp)     ::  fill_value
-    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nz_do3d) ::  local_pf !< 
+    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !< 
 
 
@@ -449 +457 @@
             ENDDO
          ENDIF
-    
+   
+       CASE ( 'pcm_transpirationrate' )
+         IF ( av == 0 )  THEN
+            DO  i = nxl, nxr
+               DO  j = nys, nyn
+                  IF ( pch_index_ji(j,i) /= 0 )  THEN
+                     k_topo = get_topography_top_index_ji( j, i, 's' )
+                     DO  k = k_topo, k_topo + pch_index_ji(j,i)
+                        local_pf(i,j,k) = pc_transpiration_rate(k-k_topo,j,i)
+                     ENDDO
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF
     
       CASE ( 'pcm_lad' )
@@ -497 +518 @@
      SELECT CASE ( TRIM( var ) )
 
-        CASE ( 'pcm_heatrate', 'pcm_lad' )
+        CASE ( 'pcm_heatrate', 'pcm_lad', 'pcm_transpirationrate')
            grid_x = 'x'
            grid_y = 'y'
@@ -873 +894 @@
 
           ALLOCATE( cum_lai_hf(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                 &
-                    pc_heating_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+                    pc_heating_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg),            & 
+                    pc_transpiration_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
 !
 !--       Piecewise calculation of the cumulative leaf area index by vertical
@@ -1397 +1419 @@
 
                       kk = k - k_wall   !- lad arrays are defined flat
-                      tend(k,j,i) = tend(k,j,i) -                              &
-                                       lsec *                                  &
-                                       lad_s(kk,j,i) *                         &
+                      pc_transpiration_rate(kk,j,i) =  - lsec                  &
+                                       * lad_s(kk,j,i) *                       &
                                        SQRT( ( 0.5_wp * ( u(k,j,i) +           &
                                                           u(k,j,i+1) )         &
@@ -1411 +1432 @@
                                            ) *                                 &
                                        ( q(k,j,i) - lsc )
+
+                      tend(k,j,i) = tend(k,j,i) + pc_transpiration_rate(kk,j,i)
                    ENDDO
                 ENDDO
@@ -1728 +1751 @@
 
              DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
-
-                kk = k - k_wall
-                tend(k,j,i) = tend(k,j,i) -                                    &
-                                 lsec *                                        &
-                                 lad_s(kk,j,i) *                               &
+                kk = k - k_wall  !- lad arrays are defined flat
+
+                pc_transpiration_rate(kk,j,i) = - lsec                         &
+                                 * lad_s(kk,j,i) *                             &
                                  SQRT( ( 0.5_wp * ( u(k,j,i) +                 &
                                                     u(k,j,i+1) )               &
@@ -1744 +1766 @@
                                      ) *                                       &
                                  ( q(k,j,i) - lsc )
+
+                tend(k,j,i) = tend(k,j,i) + pc_transpiration_rate(kk,j,i)
+
              ENDDO