Changeset 4602 for palm/trunk/SOURCE/land_surface_model_mod.f90
- Timestamp:
- Jul 14, 2020 2:49:45 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/land_surface_model_mod.f90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/land_surface_model_mod.f90
r4581 r4602 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! - Bugfix in level 3 initialization of pavements - wrongly assumed existence of 28 ! pavement_subsurface_pars 29 ! - Add missing initialization of albedo type with values given from static input 30 ! file 31 ! 32 ! 4581 2020-06-29 08:49:58Z suehring 27 33 ! Minor formatting of error message 28 34 ! … … 264 270 265 271 USE netcdf_data_input_mod, & 266 ONLY : building_type_f, & 272 ONLY : albedo_type_f, & 273 building_type_f, & 267 274 char_fill, & 268 275 char_lod, & … … 4036 4043 surf_lsm_h%z0q(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i) 4037 4044 ENDIF 4045 IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= & 4046 pavement_pars_f%fill ) & 4047 surf_lsm_h%albedo_type(m,ind_pav_green) = & 4048 INT( pavement_pars_f%pars_xy(ind_p_at,j,i) ) 4049 IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= & 4050 pavement_pars_f%fill ) & 4051 surf_lsm_h%emissivity(m,ind_pav_green) = & 4052 pavement_pars_f%pars_xy(ind_p_emis,j,i) 4053 ENDIF 4054 4055 ENDDO 4056 ! 4057 !-- Vertical surfaces 4058 DO l = 0, 3 4059 DO m = 1, surf_lsm_v(l)%ns 4060 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 4061 surf_lsm_v(l)%building_covered(m) ) 4062 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 4063 surf_lsm_v(l)%building_covered(m) ) 4064 ! 4065 !-- If surface element is not a pavement surface and any value in 4066 !-- pavement_pars is given, neglect this information and give an 4067 !-- informative message that this value will not be used. 4068 IF ( .NOT. surf_lsm_v(l)%pavement_surface(m) .AND. & 4069 ANY( pavement_pars_f%pars_xy(:,j,i) /= & 4070 pavement_pars_f%fill ) ) THEN 4071 WRITE( message_string, * ) & 4072 'surface element at grid point (j,i) = (', & 4073 j, i, ') is not a pavement surface, ', & 4074 'so that information given in ', & 4075 'pavement_pars at this point is neglected.' 4076 CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 ) 4077 ELSE 4078 IF ( pavement_pars_f%pars_xy(ind_p_z0,j,i) /= & 4079 pavement_pars_f%fill ) & 4080 surf_lsm_v(l)%z0(m) = pavement_pars_f%pars_xy(ind_p_z0,j,i) 4081 IF ( pavement_pars_f%pars_xy(ind_p_z0h,j,i) /= & 4082 pavement_pars_f%fill ) THEN 4083 surf_lsm_v(l)%z0h(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i) 4084 surf_lsm_v(l)%z0q(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i) 4085 ENDIF 4086 IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= & 4087 pavement_pars_f%fill ) & 4088 surf_lsm_v(l)%albedo_type(m,ind_pav_green) = & 4089 INT( pavement_pars_f%pars_xy(ind_p_at,j,i) ) 4090 4091 IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= & 4092 pavement_pars_f%fill ) & 4093 surf_lsm_v(l)%emissivity(m,ind_pav_green) = & 4094 pavement_pars_f%pars_xy(ind_p_emis,j,i) 4095 ENDIF 4096 ENDDO 4097 ENDDO 4098 ENDIF 4099 ! 4100 !-- Moreover, for grid points which are flagged with pavement-type 0 or whre 4101 !-- pavement_subsurface_pars_f is provided, soil heat conductivity and 4102 !-- capacity are initialized with parameters given in 4103 !-- pavement_subsurface_pars read from file. 4104 IF ( pavement_subsurface_pars_f%from_file ) THEN 4105 ! 4106 !-- Set pavement depth to nzt_soil. Please note, this is just a 4107 !-- workaround at the moment. 4108 DO m = 1, surf_lsm_h%ns 4109 IF ( surf_lsm_h%pavement_surface(m) ) THEN 4110 4111 i = surf_lsm_h%i(m) 4112 j = surf_lsm_h%j(m) 4113 4114 surf_lsm_h%nzt_pavement(m) = nzt_soil 4115 4038 4116 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i) & 4039 4117 /= pavement_subsurface_pars_f%fill ) THEN … … 4054 4132 * 0.25_wp 4055 4133 ENDIF 4056 IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= & 4057 pavement_pars_f%fill ) & 4058 surf_lsm_h%albedo_type(m,ind_pav_green) = & 4059 INT( pavement_pars_f%pars_xy(ind_p_at,j,i) ) 4060 IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= & 4061 pavement_pars_f%fill ) & 4062 surf_lsm_h%emissivity(m,ind_pav_green) = & 4063 pavement_pars_f%pars_xy(ind_p_emis,j,i) 4064 ENDIF 4065 4066 ENDDO 4067 ! 4068 !-- Vertical surfaces 4069 DO l = 0, 3 4070 DO m = 1, surf_lsm_v(l)%ns 4071 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 4072 surf_lsm_v(l)%building_covered(m) ) 4073 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 4074 surf_lsm_v(l)%building_covered(m) ) 4075 ! 4076 !-- If surface element is not a pavement surface and any value in 4077 !-- pavement_pars is given, neglect this information and give an 4078 !-- informative message that this value will not be used. 4079 IF ( .NOT. surf_lsm_v(l)%pavement_surface(m) .AND. & 4080 ANY( pavement_pars_f%pars_xy(:,j,i) /= & 4081 pavement_pars_f%fill ) ) THEN 4082 WRITE( message_string, * ) & 4083 'surface element at grid point (j,i) = (', & 4084 j, i, ') is not a pavement surface, ', & 4085 'so that information given in ', & 4086 'pavement_pars at this point is neglected.' 4087 CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 ) 4088 ELSE 4089 4090 IF ( pavement_pars_f%pars_xy(ind_p_z0,j,i) /= & 4091 pavement_pars_f%fill ) & 4092 surf_lsm_v(l)%z0(m) = pavement_pars_f%pars_xy(ind_p_z0,j,i) 4093 IF ( pavement_pars_f%pars_xy(ind_p_z0h,j,i) /= & 4094 pavement_pars_f%fill ) THEN 4095 surf_lsm_v(l)%z0h(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i) 4096 surf_lsm_v(l)%z0q(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i) 4134 4135 DO k = nzb_soil, nzt_soil 4136 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i) /= & 4137 pavement_subsurface_pars_f%fill ) THEN 4138 surf_lsm_h%lambda_h_def(k,m) = & 4139 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i) 4097 4140 ENDIF 4098 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)& 4099 /= pavement_subsurface_pars_f%fill ) THEN 4100 surf_lsm_v(l)%lambda_surface_s(m) = & 4101 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)& 4102 * ddz_soil(nzb_soil) & 4103 * 2.0_wp 4104 surf_lsm_v(l)%lambda_surface_u(m) = & 4105 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)& 4106 * ddz_soil(nzb_soil) & 4107 * 2.0_wp 4141 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i) /= & 4142 pavement_subsurface_pars_f%fill ) THEN 4143 surf_lsm_h%rho_c_total_def(k,m) = & 4144 pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i) 4108 4145 ENDIF 4109 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) &4110 /= pavement_subsurface_pars_f%fill ) THEN4111 surf_lsm_v(l)%c_surface(m) = &4112 pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i)&4113 * dz_soil(nzb_soil) &4114 * 0.25_wp4115 ENDIF4116 IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= &4117 pavement_pars_f%fill ) &4118 surf_lsm_v(l)%albedo_type(m,ind_pav_green) = &4119 INT( pavement_pars_f%pars_xy(ind_p_at,j,i) )4120 4121 IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /= &4122 pavement_pars_f%fill ) &4123 surf_lsm_v(l)%emissivity(m,ind_pav_green) = &4124 pavement_pars_f%pars_xy(ind_p_emis,j,i)4125 ENDIF4126 ENDDO4127 ENDDO4128 ENDIF4129 !4130 !-- Moreover, for grid points which are flagged with pavement-type 0 or whre4131 !-- pavement_subsurface_pars_f is provided, soil heat conductivity and4132 !-- capacity are initialized with parameters given in4133 !-- pavement_subsurface_pars read from file.4134 IF ( pavement_subsurface_pars_f%from_file ) THEN4135 !4136 !-- Set pavement depth to nzt_soil. Please note, this is just a4137 !-- workaround at the moment.4138 DO m = 1, surf_lsm_h%ns4139 IF ( surf_lsm_h%pavement_surface(m) ) THEN4140 4141 i = surf_lsm_h%i(m)4142 j = surf_lsm_h%j(m)4143 4144 surf_lsm_h%nzt_pavement(m) = nzt_soil4145 4146 DO k = nzb_soil, nzt_soil4147 surf_lsm_h%lambda_h_def(k,m) = &4148 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i)4149 surf_lsm_h%rho_c_total_def(k,m) = &4150 pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i)4151 4146 ENDDO 4152 4147 … … 4164 4159 surf_lsm_v(l)%nzt_pavement(m) = nzt_soil 4165 4160 4161 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i) & 4162 /= pavement_subsurface_pars_f%fill ) THEN 4163 surf_lsm_v(l)%lambda_surface_s(m) = & 4164 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i) & 4165 * ddz_soil(nzb_soil) & 4166 * 2.0_wp 4167 surf_lsm_v(l)%lambda_surface_u(m) = & 4168 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i) & 4169 * ddz_soil(nzb_soil) & 4170 * 2.0_wp 4171 ENDIF 4172 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) & 4173 /= pavement_subsurface_pars_f%fill ) THEN 4174 surf_lsm_v(l)%c_surface(m) = & 4175 pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) & 4176 * dz_soil(nzb_soil) & 4177 * 0.25_wp 4178 ENDIF 4179 4166 4180 DO k = nzb_soil, nzt_soil 4167 surf_lsm_v(l)%lambda_h_def(k,m) = & 4168 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i) 4169 surf_lsm_v(l)%rho_c_total_def(k,m) = & 4170 pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i) 4181 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i) & 4182 /= pavement_subsurface_pars_f%fill ) THEN 4183 surf_lsm_v(l)%lambda_h_def(k,m) = & 4184 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i) 4185 ENDIF 4186 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) & 4187 /= pavement_subsurface_pars_f%fill ) THEN 4188 surf_lsm_v(l)%rho_c_total_def(k,m) = & 4189 pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i) 4190 ENDIF 4171 4191 ENDDO 4172 4192 … … 4175 4195 ENDDO 4176 4196 ENDIF 4177 4197 ! 4198 !-- Initialize albedo type via given type from static input file. Please note, even though 4199 !-- the albedo type has been already given by the pars, albedo_type overwrites these values. 4200 IF ( albedo_type_f%from_file ) THEN 4201 DO m = 1, surf_lsm_h%ns 4202 i = surf_lsm_h%i(m) 4203 j = surf_lsm_h%j(m) 4204 IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill ) & 4205 surf_lsm_h%albedo_type(m,:) = albedo_type_f%var(j,i) 4206 ENDDO 4207 DO l = 0, 3 4208 DO m = 1, surf_lsm_v(l)%ns 4209 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 4210 surf_lsm_v(l)%building_covered(m) ) 4211 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 4212 surf_lsm_v(l)%building_covered(m) ) 4213 IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill ) & 4214 surf_lsm_v(l)%albedo_type(m,:) = albedo_type_f%var(j,i) 4215 ENDDO 4216 ENDDO 4217 ENDIF 4178 4218 ! 4179 4219 !-- Initial run actions
Note: See TracChangeset
for help on using the changeset viewer.
