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

Timestamp:

Apr 19, 2017 9:34:46 AM (7 years ago)

Author:

kanani

Message:

small bugfix, formatting and new PCM output

File:

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

palm/trunk/SOURCE/plant_canopy_model_mod.f90

@@ -20 +20 @@
 ! Current revisions:
 ! -----------------
-! 
+! Added 3d output of leaf area density (pcm_lad) and canopy 
+! heat rate (pcm_heatrate)
 ! 
 ! Former revisions:
@@ -166 +167 @@
 !
 !-- Public functions
-    PUBLIC pcm_check_parameters, pcm_header, pcm_init, pcm_parin, pcm_tendency
+    PUBLIC pcm_check_data_output, pcm_check_parameters, pcm_data_output_3d,    &
+           pcm_define_netcdf_grid, pcm_header, pcm_init, pcm_parin, pcm_tendency
 
 !
@@ -174 +176 @@
            
 
-
+    INTERFACE pcm_check_data_output
+       MODULE PROCEDURE pcm_check_data_output
+    END INTERFACE pcm_check_data_output
+    
     INTERFACE pcm_check_parameters
        MODULE PROCEDURE pcm_check_parameters
-    END INTERFACE pcm_check_parameters     
+    END INTERFACE pcm_check_parameters
+
+    INTERFACE pcm_data_output_3d
+       MODULE PROCEDURE pcm_data_output_3d
+    END INTERFACE pcm_data_output_3d
+
+    INTERFACE pcm_define_netcdf_grid
+       MODULE PROCEDURE pcm_define_netcdf_grid
+    END INTERFACE pcm_define_netcdf_grid
     
      INTERFACE pcm_header
@@ -203 +216 @@
  CONTAINS
 
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Check data output for plant canopy model
+!------------------------------------------------------------------------------!
+ SUBROUTINE pcm_check_data_output( var, unit )
+ 
+ 
+    USE control_parameters,                                                 &
+        ONLY:  data_output, message_string
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  unit  !< 
+    CHARACTER (LEN=*) ::  var   !<
+
+
+    SELECT CASE ( TRIM( var ) )
+
+       CASE ( 'pcm_heatrate' )
+          unit = 'K s-1'
+    
+       CASE ( 'pcm_lad' )
+          unit = 'm2 m-3'
+
+
+       CASE DEFAULT
+          unit = 'illegal'
+
+    END SELECT
+
+
+ END SUBROUTINE pcm_check_data_output
+ 
  
 !------------------------------------------------------------------------------!
@@ -259 +307 @@
  
 
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining 3D output variables
+!------------------------------------------------------------------------------!
+ SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf )
+ 
+    USE control_parameters,                                                    &
+        ONLY :  nz_do3d
+ 
+    USE indices
+
+    USE kinds
+
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  variable !< 
+
+    INTEGER(iwp) ::  av    !< 
+    INTEGER(iwp) ::  i     !< 
+    INTEGER(iwp) ::  j     !< 
+    INTEGER(iwp) ::  k     !< 
+
+    LOGICAL      ::  found !< 
+
+    REAL(sp), DIMENSION(nxlg:nxrg,nysg:nyng,nzb:nz_do3d) ::  local_pf !< 
+
+
+    found = .TRUE.
+
+
+    SELECT CASE ( TRIM( variable ) )
+
+      CASE ( 'pcm_heatrate' )
+         IF ( av == 0 )  THEN
+            DO  i = nxlg, nxrg
+               DO  j = nysg, nyng
+                  DO  k = nzb_s_inner(j,i), nz_do3d
+                     local_pf(i,j,k) = pc_heating_rate(k,j,i)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDIF
+    
+    
+      CASE ( 'pcm_lad' )
+
+         IF ( av == 0 )  THEN
+            DO  i = nxlg, nxrg
+               DO  j = nysg, nyng
+                  DO  k = nzb_s_inner(j,i), nz_do3d
+                     local_pf(i,j,k) = lad_s(k,j,i)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDIF
+                  
+         
+       CASE DEFAULT
+          found = .FALSE.
+
+    END SELECT
+
+
+ END SUBROUTINE pcm_data_output_3d 
+         
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining appropriate grid for netcdf variables.
+!> It is called from subroutine netcdf.
+!------------------------------------------------------------------------------!
+ SUBROUTINE pcm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
+    
+     IMPLICIT NONE
+
+     CHARACTER (LEN=*), INTENT(IN)  ::  var         !< 
+     LOGICAL, INTENT(OUT)           ::  found       !< 
+     CHARACTER (LEN=*), INTENT(OUT) ::  grid_x      !< 
+     CHARACTER (LEN=*), INTENT(OUT) ::  grid_y      !< 
+     CHARACTER (LEN=*), INTENT(OUT) ::  grid_z      !< 
+
+     found  = .TRUE.
+
+!
+!--  Check for the grid
+     SELECT CASE ( TRIM( var ) )
+
+        CASE ( 'pcm_heatrate', 'pcm_lad' )
+           grid_x = 'x'
+           grid_y = 'y'
+           grid_z = 'zu'
+
+        CASE DEFAULT
+           found  = .FALSE.
+           grid_x = 'none'
+           grid_y = 'none'
+           grid_z = 'none'
+     END SELECT
+
+ END SUBROUTINE pcm_define_netcdf_grid
+ 
+ 
 !------------------------------------------------------------------------------!
 ! Description: