Changeset 4362 for palm/trunk/SOURCE/plant_canopy_model_mod.f90
- Timestamp:
- Jan 7, 2020 5:15:02 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/plant_canopy_model_mod.f90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r4361 r4362 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Input of plant canopy variables from static driver moved to plant-canopy 30 ! model 31 ! 32 ! 4361 2020-01-07 12:22:38Z suehring 29 33 ! - Remove unused arrays in pmc_rrd_local 30 34 ! - Remove one exchange of ghost points … … 183 187 184 188 USE netcdf_data_input_mod, & 185 ONLY: input_pids_static, leaf_area_density_f 189 ONLY: input_pids_static, & 190 char_fill, & 191 check_existence, & 192 close_input_file, & 193 get_attribute, & 194 get_dimension_length, & 195 get_variable, & 196 inquire_num_variables, & 197 inquire_variable_names, & 198 input_file_static, & 199 num_var_pids, & 200 open_read_file, & 201 pids_id, & 202 real_3d, & 203 vars_pids 186 204 187 205 USE pegrid … … 234 252 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pcm_latentrate_av !< array for averaging plant canopy latent heating rate 235 253 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pcm_transpirationrate_av !< array for averaging plant canopy transpiration rate 254 255 TYPE(real_3d) :: basal_area_density_f !< input variable for basal area density - resolved vegetation 256 TYPE(real_3d) :: leaf_area_density_f !< input variable for leaf area density - resolved vegetation 257 TYPE(real_3d) :: root_area_density_lad_f !< input variable for root area density - resolved vegetation 236 258 237 259 SAVE … … 831 853 !> Header output for plant canopy model 832 854 !------------------------------------------------------------------------------! 833 855 SUBROUTINE pcm_header ( io ) 834 856 835 836 837 838 839 840 857 CHARACTER (LEN=10) :: coor_chr !< 858 859 CHARACTER (LEN=86) :: coordinates !< 860 CHARACTER (LEN=86) :: gradients !< 861 CHARACTER (LEN=86) :: leaf_area_density !< 862 CHARACTER (LEN=86) :: slices !< 841 863 842 INTEGER(iwp) :: i !< 843 INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file 844 INTEGER(iwp) :: k !< 845 846 REAL(wp) :: canopy_height !< canopy height (in m) 864 INTEGER(iwp) :: i !< 865 INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file 866 INTEGER(iwp) :: k !< 867 868 REAL(wp) :: canopy_height !< canopy height (in m) 869 870 canopy_height = zw(pch_index) 871 872 WRITE ( io, 1 ) canopy_mode, canopy_height, pch_index, & 873 canopy_drag_coeff 874 IF ( passive_scalar ) THEN 875 WRITE ( io, 2 ) leaf_scalar_exch_coeff, & 876 leaf_surface_conc 877 ENDIF 878 879 ! 880 ! Heat flux at the top of vegetation 881 WRITE ( io, 3 ) cthf 882 883 ! 884 ! Leaf area density profile, calculated either from given vertical 885 ! gradients or from beta probability density function. 886 IF ( .NOT. calc_beta_lad_profile ) THEN 887 888 ! Building output strings, starting with surface value 889 WRITE ( leaf_area_density, '(F7.4)' ) lad_surface 890 gradients = '------' 891 slices = ' 0' 892 coordinates = ' 0.0' 893 DO i = 1, UBOUND(lad_vertical_gradient_level_ind, DIM=1) 894 IF ( lad_vertical_gradient_level_ind(i) /= -9999 ) THEN 895 896 WRITE (coor_chr,'(F7.2)') lad(lad_vertical_gradient_level_ind(i)) 897 leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr ) 898 899 WRITE (coor_chr,'(F7.2)') lad_vertical_gradient(i) 900 gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr ) 901 902 WRITE (coor_chr,'(I7)') lad_vertical_gradient_level_ind(i) 903 slices = TRIM( slices ) // ' ' // TRIM( coor_chr ) 904 905 WRITE (coor_chr,'(F7.1)') lad_vertical_gradient_level(i) 906 coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr ) 907 ELSE 908 EXIT 909 ENDIF 910 ENDDO 911 912 WRITE ( io, 4 ) TRIM( coordinates ), TRIM( leaf_area_density ), & 913 TRIM( gradients ), TRIM( slices ) 914 915 ELSE 916 917 WRITE ( leaf_area_density, '(F7.4)' ) lad_surface 918 coordinates = ' 0.0' 847 919 848 canopy_height = zw(pch_index) 849 850 WRITE ( io, 1 ) canopy_mode, canopy_height, pch_index, & 851 canopy_drag_coeff 852 IF ( passive_scalar ) THEN 853 WRITE ( io, 2 ) leaf_scalar_exch_coeff, & 854 leaf_surface_conc 855 ENDIF 856 857 ! 858 !-- Heat flux at the top of vegetation 859 WRITE ( io, 3 ) cthf 860 861 ! 862 !-- Leaf area density profile, calculated either from given vertical 863 !-- gradients or from beta probability density function. 864 IF ( .NOT. calc_beta_lad_profile ) THEN 865 866 !-- Building output strings, starting with surface value 867 WRITE ( leaf_area_density, '(F7.4)' ) lad_surface 868 gradients = '------' 869 slices = ' 0' 870 coordinates = ' 0.0' 871 DO i = 1, UBOUND(lad_vertical_gradient_level_ind, DIM=1) 872 IF ( lad_vertical_gradient_level_ind(i) /= -9999 ) THEN 873 874 WRITE (coor_chr,'(F7.2)') lad(lad_vertical_gradient_level_ind(i)) 875 leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr ) 876 877 WRITE (coor_chr,'(F7.2)') lad_vertical_gradient(i) 878 gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr ) 879 880 WRITE (coor_chr,'(I7)') lad_vertical_gradient_level_ind(i) 881 slices = TRIM( slices ) // ' ' // TRIM( coor_chr ) 882 883 WRITE (coor_chr,'(F7.1)') lad_vertical_gradient_level(i) 884 coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr ) 885 ELSE 886 EXIT 887 ENDIF 888 ENDDO 889 890 WRITE ( io, 4 ) TRIM( coordinates ), TRIM( leaf_area_density ), & 891 TRIM( gradients ), TRIM( slices ) 892 893 ELSE 894 895 WRITE ( leaf_area_density, '(F7.4)' ) lad_surface 896 coordinates = ' 0.0' 897 898 DO k = 1, pch_index 899 900 WRITE (coor_chr,'(F7.2)') lad(k) 901 leaf_area_density = TRIM( leaf_area_density ) // ' ' // & 902 TRIM( coor_chr ) 903 904 WRITE (coor_chr,'(F7.1)') zu(k) 905 coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr ) 906 907 ENDDO 908 909 WRITE ( io, 5 ) TRIM( coordinates ), TRIM( leaf_area_density ), & 910 alpha_lad, beta_lad, lai_beta 911 912 ENDIF 913 914 1 FORMAT (//' Vegetation canopy (drag) model:'/ & 920 DO k = 1, pch_index 921 922 WRITE (coor_chr,'(F7.2)') lad(k) 923 leaf_area_density = TRIM( leaf_area_density ) // ' ' // & 924 TRIM( coor_chr ) 925 926 WRITE (coor_chr,'(F7.1)') zu(k) 927 coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr ) 928 929 ENDDO 930 931 WRITE ( io, 5 ) TRIM( coordinates ), TRIM( leaf_area_density ), & 932 alpha_lad, beta_lad, lai_beta 933 934 ENDIF 935 936 1 FORMAT (//' Vegetation canopy (drag) model:'/ & 915 937 ' ------------------------------'// & 916 938 ' Canopy mode: ', A / & 917 939 ' Canopy height: ',F6.2,'m (',I4,' grid points)' / & 918 940 ' Leaf drag coefficient: ',F6.2 /) 919 2 FORMAT (/ ' Scalar exchange coefficient: ',F6.2 /&941 2 FORMAT (/ ' Scalar exchange coefficient: ',F6.2 / & 920 942 ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /) 921 3 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2,&922 ' K m/s')923 4 FORMAT (/ ' Characteristic levels of the leaf area density:'//&943 3 FORMAT (' Predefined constant heatflux at the top of the vegetation: ', & 944 F6.2, ' K m/s') 945 4 FORMAT (/ ' Characteristic levels of the leaf area density:'// & 924 946 ' Height: ',A,' m'/ & 925 947 ' Leaf area density: ',A,' m**2/m**3'/ & 926 948 ' Gradient: ',A,' m**2/m**4'/ & 927 949 ' Gridpoint: ',A) 928 5 FORMAT (//' Characteristic levels of the leaf area density and coefficients:'&950 5 FORMAT (//' Characteristic levels of the leaf area density and coefficients:'& 929 951 // ' Height: ',A,' m'/ & 930 952 ' Leaf area density: ',A,' m**2/m**3'/ & … … 1068 1090 1069 1091 CASE ( 'read_from_file' ) 1092 ! 1093 !-- Read plant canopy 1094 IF ( input_pids_static ) THEN 1095 ! 1096 !-- Open the static input file 1097 #if defined( __netcdf ) 1098 CALL open_read_file( TRIM( input_file_static ) // & 1099 TRIM( coupling_char ), & 1100 pids_id ) 1101 1102 CALL inquire_num_variables( pids_id, num_var_pids ) 1103 ! 1104 !-- Allocate memory to store variable names and read them 1105 ALLOCATE( vars_pids(1:num_var_pids) ) 1106 CALL inquire_variable_names( pids_id, vars_pids ) 1107 ! 1108 !-- Read leaf area density - resolved vegetation 1109 IF ( check_existence( vars_pids, 'lad' ) ) THEN 1110 leaf_area_density_f%from_file = .TRUE. 1111 CALL get_attribute( pids_id, char_fill, & 1112 leaf_area_density_f%fill, & 1113 .FALSE., 'lad' ) 1114 ! 1115 !-- Inquire number of vertical vegetation layer 1116 CALL get_dimension_length( pids_id, & 1117 leaf_area_density_f%nz, & 1118 'zlad' ) 1119 ! 1120 !-- Allocate variable for leaf-area density 1121 ALLOCATE( leaf_area_density_f%var & 1122 (0:leaf_area_density_f%nz-1, & 1123 nys:nyn,nxl:nxr) ) 1124 1125 CALL get_variable( pids_id, 'lad', leaf_area_density_f%var, & 1126 nxl, nxr, nys, nyn, & 1127 0, leaf_area_density_f%nz-1 ) 1128 1129 ELSE 1130 leaf_area_density_f%from_file = .FALSE. 1131 ENDIF 1132 ! 1133 !-- Read basal area density - resolved vegetation 1134 IF ( check_existence( vars_pids, 'bad' ) ) THEN 1135 basal_area_density_f%from_file = .TRUE. 1136 CALL get_attribute( pids_id, char_fill, & 1137 basal_area_density_f%fill, & 1138 .FALSE., 'bad' ) 1139 ! 1140 !-- Inquire number of vertical vegetation layer 1141 CALL get_dimension_length( pids_id, & 1142 basal_area_density_f%nz, & 1143 'zlad' ) 1144 ! 1145 !-- Allocate variable 1146 ALLOCATE( basal_area_density_f%var & 1147 (0:basal_area_density_f%nz-1, & 1148 nys:nyn,nxl:nxr) ) 1149 1150 CALL get_variable( pids_id, 'bad', basal_area_density_f%var,& 1151 nxl, nxr, nys, nyn, & 1152 0, basal_area_density_f%nz-1 ) 1153 ELSE 1154 basal_area_density_f%from_file = .FALSE. 1155 ENDIF 1156 ! 1157 !-- Read root area density - resolved vegetation 1158 IF ( check_existence( vars_pids, 'root_area_dens_r' ) ) THEN 1159 root_area_density_lad_f%from_file = .TRUE. 1160 CALL get_attribute( pids_id, char_fill, & 1161 root_area_density_lad_f%fill, & 1162 .FALSE., 'root_area_dens_r' ) 1163 ! 1164 !-- Inquire number of vertical soil layers 1165 CALL get_dimension_length( pids_id, & 1166 root_area_density_lad_f%nz, & 1167 'zsoil' ) 1168 ! 1169 !-- Allocate variable 1170 ALLOCATE( root_area_density_lad_f%var & 1171 (0:root_area_density_lad_f%nz-1,& 1172 nys:nyn,nxl:nxr) ) 1173 1174 CALL get_variable( pids_id, 'root_area_dens_r', & 1175 root_area_density_lad_f%var, & 1176 nxl, nxr, nys, nyn, & 1177 0, root_area_density_lad_f%nz-1 ) 1178 ELSE 1179 root_area_density_lad_f%from_file = .FALSE. 1180 ENDIF 1181 1182 DEALLOCATE( vars_pids ) 1183 1184 ENDIF 1185 ! 1186 !-- Finally, close the input file and deallocate temporary arrays 1187 CALL close_input_file( pids_id ) 1188 #endif 1070 1189 ! 1071 1190 !-- Initialize LAD with data from file. If LAD is given in NetCDF file,
Note: See TracChangeset
for help on using the changeset viewer.
