Changeset 4381
- Timestamp:
- Jan 20, 2020 1:51:46 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
land_surface_model_mod.f90 (modified) (7 diffs)
-
plant_canopy_model_mod.f90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/land_surface_model_mod.f90
r4360 r4381 25 25 ! ----------------- 26 26 ! $Id$ 27 ! - Bugfix in nested soil initialization in case no dynamic input file is 28 ! present 29 ! - In order to do not mess-up the job-protocoll, give error messages 503, 507 30 ! and 508 only once 31 ! 32 ! 4360 2020-01-07 11:25:50Z suehring 27 33 ! Fix wrong location string in message call 28 34 ! … … 2347 2353 #if defined( __parallel ) 2348 2354 INTEGER(iwp) :: nzs_root !< number of soil layers in root domain (used in case soil data needs to be 2349 !< transferred from root model to child models) 2350 2355 !< transferred from root model to child models) 2356 2357 LOGICAL :: init_msoil_from_driver_root !< flag indicating that msoil in root is initialized from dynamic file 2358 LOGICAL :: init_tsoil_from_driver_root !< flag indicating that tsoil in root is initialized from dynamic file 2359 #endif 2360 LOGICAL :: flag_exceed_z0 !< dummy flag to indicate whether roughness length is too high 2361 LOGICAL :: flag_exceed_z0h !< dummy flag to indicate whether roughness length for scalars is too high 2362 2363 #if defined( __parallel ) 2351 2364 REAL(wp), DIMENSION(:), ALLOCATABLE :: m_soil_root !< domain-averaged soil moisture profile in root domain 2352 2365 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_soil_root !< domain-averaged soil temperature profile in root domain … … 4293 4306 #if defined( __parallel ) 4294 4307 ! 4308 !-- Check if soil moisture and temperature in the root model are 4309 !-- initialized from dynamic input. This case, distribute these 4310 !-- information to its child domain(s). 4311 IF ( pmc_is_rootmodel() ) THEN 4312 init_msoil_from_driver_root = init_3d%from_file_msoil 4313 init_tsoil_from_driver_root = init_3d%from_file_tsoil 4314 ENDIF 4315 4316 CALL MPI_BCAST( init_msoil_from_driver_root, 1, MPI_LOGICAL, & 4317 0, MPI_COMM_WORLD, ierr ) 4318 CALL MPI_BCAST( init_tsoil_from_driver_root, 1, MPI_LOGICAL, & 4319 0, MPI_COMM_WORLD, ierr ) 4320 ! 4295 4321 !-- In case of a nested run, first average the soil profiles in the 4296 4322 !-- root domain. 4297 IF ( pmc_is_rootmodel() ) THEN 4298 ! 4299 !-- Child domains will be only initialized with horizontally 4300 !-- averaged soil profiles in parent domain (for sake of simplicity). 4301 !-- If required, average soil data on root parent domain before the 4302 !-- soil profiles are distributed onto the child domains. 4303 !-- Start with soil moisture. 4304 IF ( init_3d%from_file_msoil .AND. init_3d%lod_msoil == 2 ) & 4305 THEN 4306 ALLOCATE( pr_soil_init(0:init_3d%nzs-1) ) 4307 DO k = 0, init_3d%nzs-1 4308 pr_soil_init(k) = SUM( init_3d%msoil_3d(k,nys:nyn,nxl:nxr) ) 4309 ENDDO 4310 ! 4311 !-- Allocate 1D array for soil-moisture profile (will not be 4312 !-- allocated in lod==2 case). 4313 ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) ) 4314 init_3d%msoil_1d = 0.0_wp 4315 CALL MPI_ALLREDUCE( pr_soil_init(0), init_3d%msoil_1d(0), & 4316 SIZE(pr_soil_init), & 4317 MPI_REAL, MPI_SUM, comm2d, ierr ) 4318 4319 init_3d%msoil_1d = init_3d%msoil_1d / & 4323 IF ( init_msoil_from_driver_root .OR. & 4324 init_tsoil_from_driver_root ) THEN 4325 4326 IF ( pmc_is_rootmodel() ) THEN 4327 ! 4328 !-- Child domains will be only initialized with horizontally 4329 !-- averaged soil profiles in parent domain (for sake of simplicity). 4330 !-- If required, average soil data on root parent domain before the 4331 !-- soil profiles are distributed onto the child domains. 4332 !-- Start with soil moisture. 4333 IF ( init_3d%from_file_msoil .AND. & 4334 init_3d%lod_msoil == 2 ) THEN 4335 ALLOCATE( pr_soil_init(0:init_3d%nzs-1) ) 4336 DO k = 0, init_3d%nzs-1 4337 pr_soil_init(k) = SUM( init_3d%msoil_3d(k,nys:nyn,nxl:nxr) ) 4338 ENDDO 4339 ! 4340 !-- Allocate 1D array for soil-moisture profile (will not be 4341 !-- allocated in lod==2 case). 4342 ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) ) 4343 init_3d%msoil_1d = 0.0_wp 4344 CALL MPI_ALLREDUCE( pr_soil_init(0), init_3d%msoil_1d(0),& 4345 SIZE(pr_soil_init), & 4346 MPI_REAL, MPI_SUM, comm2d, ierr ) 4347 4348 init_3d%msoil_1d = init_3d%msoil_1d / & 4320 4349 REAL( ( nx + 1 ) * ( ny + 1), KIND=wp ) 4321 DEALLOCATE( pr_soil_init )4322 ENDIF4323 ! 4324 !-- Proceed with soil temperature.4325 IF ( init_3d%from_file_tsoil .AND. init_3d%lod_tsoil == 2 )&4326 THEN4327 ALLOCATE( pr_soil_init(0:init_3d%nzs-1) )4328 4329 DO k = 0, init_3d%nzs-14330 pr_soil_init(k) = SUM( init_3d%tsoil_3d(k,nys:nyn,nxl:nxr) )4331 ENDDO4332 ! 4333 !-- Allocate 1D array for soil-temperature profile (will not be4334 !-- allocated in lod==2 case).4335 ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) )4336 init_3d%tsoil_1d = 0.0_wp4337 CALL MPI_ALLREDUCE( pr_soil_init(0), init_3d%tsoil_1d(0),&4338 SIZE(pr_soil_init),&4339 MPI_REAL, MPI_SUM, comm2d, ierr )4340 init_3d%tsoil_1d = init_3d%tsoil_1d /&4350 DEALLOCATE( pr_soil_init ) 4351 ENDIF 4352 ! 4353 !-- Proceed with soil temperature. 4354 IF ( init_3d%from_file_tsoil .AND. & 4355 init_3d%lod_tsoil == 2 ) THEN 4356 ALLOCATE( pr_soil_init(0:init_3d%nzs-1) ) 4357 4358 DO k = 0, init_3d%nzs-1 4359 pr_soil_init(k) = SUM( init_3d%tsoil_3d(k,nys:nyn,nxl:nxr) ) 4360 ENDDO 4361 ! 4362 !-- Allocate 1D array for soil-temperature profile (will not be 4363 !-- allocated in lod==2 case). 4364 ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) ) 4365 init_3d%tsoil_1d = 0.0_wp 4366 CALL MPI_ALLREDUCE( pr_soil_init(0), init_3d%tsoil_1d(0),& 4367 SIZE(pr_soil_init), & 4368 MPI_REAL, MPI_SUM, comm2d, ierr ) 4369 init_3d%tsoil_1d = init_3d%tsoil_1d / & 4341 4370 REAL( ( nx + 1 ) * ( ny + 1), KIND=wp ) 4342 DEALLOCATE( pr_soil_init ) 4343 4344 ENDIF 4345 ENDIF 4346 ! 4347 !-- Broadcast number of soil layers in root model to all childs. 4348 !-- Note, only process 0 in COMM_WORLD is sending. 4349 IF ( pmc_is_rootmodel() ) nzs_root = init_3d%nzs 4350 4351 CALL MPI_BCAST( nzs_root, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr ) 4352 ! 4353 !-- Allocate dummy arrays for soil moisture and temperature profiles 4354 !-- on all domains. 4355 ALLOCATE( z_soil_root(1:nzs_root) ) 4356 ALLOCATE( m_soil_root(0:nzs_root-1) ) 4357 ALLOCATE( t_soil_root(0:nzs_root-1) ) 4358 ! 4359 !-- Distribute the mean soil profiles to all child domains. 4360 IF ( pmc_is_rootmodel() ) THEN 4361 z_soil_root = init_3d%z_soil 4362 m_soil_root = init_3d%msoil_1d 4363 t_soil_root = init_3d%tsoil_1d 4364 ENDIF 4365 4366 CALL MPI_BCAST( z_soil_root, SIZE( z_soil_root ), & 4367 MPI_REAL, 0, MPI_COMM_WORLD, ierr ) 4368 CALL MPI_BCAST( m_soil_root, SIZE( m_soil_root ), & 4369 MPI_REAL, 0, MPI_COMM_WORLD, ierr ) 4370 CALL MPI_BCAST( t_soil_root, SIZE( t_soil_root ), & 4371 MPI_REAL, 0, MPI_COMM_WORLD, ierr ) 4372 ! 4373 !-- In the following, the child domains decide whether they take 4374 !-- the information from the root domain or not. 4375 IF ( .NOT. pmc_is_rootmodel() ) THEN 4376 ! 4377 !-- If soil moisture or temperature isn't in dynamic input file for 4378 !-- the child, take the information provided from the root model. 4379 !-- Start with z-dimension 4380 IF ( .NOT. init_3d%from_file_msoil .OR. & 4381 .NOT. init_3d%from_file_msoil ) THEN 4382 init_3d%nzs = nzs_root 4383 ALLOCATE( init_3d%z_soil(1:init_3d%nzs) ) 4384 init_3d%z_soil(1:init_3d%nzs) = z_soil_root 4371 DEALLOCATE( pr_soil_init ) 4372 4373 ENDIF 4385 4374 ENDIF 4386 4375 ! 4387 !-- Take soil moisture. Note, control flags from_file... and LoD 4388 !-- need to be set. 4389 IF ( .NOT. init_3d%from_file_msoil ) THEN 4390 ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) ) 4391 init_3d%lod_msoil = 1 4392 init_3d%from_file_msoil = .TRUE. 4393 4394 init_3d%msoil_1d = m_soil_root 4376 !-- Broadcast number of soil layers in root model to all childs. 4377 !-- Note, only process 0 in COMM_WORLD is sending. 4378 IF ( pmc_is_rootmodel() ) nzs_root = init_3d%nzs 4379 4380 CALL MPI_BCAST( nzs_root, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr ) 4381 ! 4382 !-- Allocate dummy arrays for soil moisture and temperature profiles 4383 !-- on all domains. 4384 ALLOCATE( z_soil_root(1:nzs_root) ) 4385 IF ( init_msoil_from_driver_root ) & 4386 ALLOCATE( m_soil_root(0:nzs_root-1) ) 4387 IF ( init_tsoil_from_driver_root ) & 4388 ALLOCATE( t_soil_root(0:nzs_root-1) ) 4389 ! 4390 !-- Distribute the mean soil profiles to all child domains. 4391 IF ( pmc_is_rootmodel() ) THEN 4392 z_soil_root = init_3d%z_soil 4393 IF ( init_msoil_from_driver_root ) & 4394 m_soil_root = init_3d%msoil_1d 4395 IF ( init_tsoil_from_driver_root ) & 4396 t_soil_root = init_3d%tsoil_1d 4395 4397 ENDIF 4398 4399 CALL MPI_BCAST( z_soil_root, SIZE( z_soil_root ), & 4400 MPI_REAL, 0, MPI_COMM_WORLD, ierr ) 4401 4402 IF ( init_msoil_from_driver_root ) & 4403 CALL MPI_BCAST( m_soil_root, SIZE( m_soil_root ), & 4404 MPI_REAL, 0, MPI_COMM_WORLD, ierr ) 4405 4406 IF ( init_msoil_from_driver_root ) & 4407 CALL MPI_BCAST( t_soil_root, SIZE( t_soil_root ), & 4408 MPI_REAL, 0, MPI_COMM_WORLD, ierr ) 4409 ! 4410 !-- In the following, the child domains decide whether they take 4411 !-- the information from the root domain or not. 4412 IF ( .NOT. pmc_is_rootmodel() ) THEN 4396 4413 ! 4397 !-- Take soil temperature. Note, control flags from_file... and LoD 4398 !-- need to be set. 4399 IF ( .NOT. init_3d%from_file_tsoil ) THEN 4400 ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) ) 4401 init_3d%lod_tsoil = 1 4402 init_3d%from_file_tsoil = .TRUE. 4403 4404 init_3d%tsoil_1d = t_soil_root 4414 !-- If soil moisture or temperature isn't in dynamic input file for 4415 !-- the child, take the information provided from the root model. 4416 !-- Start with z-dimension 4417 IF ( .NOT. init_3d%from_file_msoil .OR. & 4418 .NOT. init_3d%from_file_msoil ) THEN 4419 init_3d%nzs = nzs_root 4420 ALLOCATE( init_3d%z_soil(1:init_3d%nzs) ) 4421 init_3d%z_soil(1:init_3d%nzs) = z_soil_root 4422 ENDIF 4423 ! 4424 !-- Take soil moisture. Note, control flags from_file... and LoD 4425 !-- need to be set. 4426 IF ( .NOT. init_3d%from_file_msoil ) THEN 4427 ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) ) 4428 init_3d%lod_msoil = 1 4429 init_3d%from_file_msoil = .TRUE. 4430 4431 init_3d%msoil_1d = m_soil_root 4432 ENDIF 4433 ! 4434 !-- Take soil temperature. Note, control flags from_file... and LoD 4435 !-- need to be set. 4436 IF ( .NOT. init_3d%from_file_tsoil ) THEN 4437 ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) ) 4438 init_3d%lod_tsoil = 1 4439 init_3d%from_file_tsoil = .TRUE. 4440 4441 init_3d%tsoil_1d = t_soil_root 4442 ENDIF 4405 4443 ENDIF 4444 4445 DEALLOCATE( z_soil_root ) 4446 DEALLOCATE( m_soil_root ) 4447 DEALLOCATE( t_soil_root ) 4406 4448 ENDIF 4407 4408 DEALLOCATE( z_soil_root )4409 DEALLOCATE( m_soil_root )4410 DEALLOCATE( t_soil_root )4411 4449 ENDIF 4412 4450 #endif … … 4878 4916 !-- Check if roughness length for momentum, heat, or moisture exceed 4879 4917 !-- surface-layer height and decrease local roughness length where 4880 !-- necessary. 4918 !-- necessary. This case, give an informative message. Note, to avoid 4919 !-- that the job-protocoll is messed-up, this message is only given once. 4920 flag_exceed_z0 = .FALSE. 4921 flag_exceed_z0h = .FALSE. 4881 4922 DO m = 1, surf_lsm_h%ns 4882 4923 IF ( surf_lsm_h%z0(m) > 0.5_wp * surf_lsm_h%z_mo(m) ) THEN 4883 4884 4924 surf_lsm_h%z0(m) = 0.5_wp * surf_lsm_h%z_mo(m) 4885 4886 WRITE( message_string, * ) 'z0 exceeds surface-layer height ' // & 4887 'at horizontal natural surface and is ' // & 4888 'decreased appropriately at grid point (i,j) = ', & 4889 surf_lsm_h%i(m), surf_lsm_h%j(m) 4890 CALL message( 'land_surface_model_mod', 'PA0503', & 4891 0, 0, myid, 6, 0 ) 4925 flag_exceed_z0 = .TRUE. 4892 4926 ENDIF 4893 4927 IF ( surf_lsm_h%z0h(m) > 0.5_wp * surf_lsm_h%z_mo(m) ) THEN 4894 4895 4928 surf_lsm_h%z0h(m) = 0.5_wp * surf_lsm_h%z_mo(m) 4896 4929 surf_lsm_h%z0q(m) = 0.5_wp * surf_lsm_h%z_mo(m) 4897 4898 WRITE( message_string, * ) 'z0h exceeds surface-layer height ' // & 4899 'at horizontal natural surface and is ' // & 4900 'decreased appropriately at grid point (i,j) = ', & 4901 surf_lsm_h%i(m), surf_lsm_h%j(m) 4902 CALL message( 'land_surface_model_mod', 'PA0507', & 4903 0, 0, myid, 6, 0 ) 4930 flag_exceed_z0h = .TRUE. 4904 4931 ENDIF 4905 4932 ENDDO 4906 4933 #if defined( __parallel ) 4934 CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0, 1, MPI_LOGICAL, & 4935 MPI_LOR, comm2d, ierr) 4936 #endif 4937 IF ( flag_exceed_z0 ) THEN 4938 WRITE( message_string, * ) 'z0 exceeds surface-layer height ' // & 4939 'at horizontal natural surface(s) and '// & 4940 'is decreased appropriately' 4941 CALL message( 'land_surface_model_mod', 'PA0503', 0, 0, 0, 6, 0 ) 4942 ENDIF 4943 #if defined( __parallel ) 4944 CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0h, 1, MPI_LOGICAL, & 4945 MPI_LOR, comm2d, ierr) 4946 #endif 4947 IF ( flag_exceed_z0h ) THEN 4948 WRITE( message_string, * ) 'z0h exceeds surface-layer height ' // & 4949 'at horizontal natural surface(s) and '// & 4950 'is decreased appropriately.' 4951 CALL message( 'land_surface_model_mod', 'PA0507', 0, 0, 0, 6, 0 ) 4952 ENDIF 4953 4954 flag_exceed_z0 = .FALSE. 4955 flag_exceed_z0h = .FALSE. 4907 4956 DO l = 0, 3 4908 4957 DO m = 1, surf_lsm_v(l)%ns 4909 4958 IF ( surf_lsm_v(l)%z0(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) ) THEN 4910 4911 4959 surf_lsm_v(l)%z0(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m) 4912 4913 WRITE( message_string, * ) 'z0 exceeds surface-layer height '//& 4914 'at vertical natural surface and is ' // & 4915 'decreased appropriately at grid point (i,j) = ', & 4916 surf_lsm_v(l)%i(m)+surf_lsm_v(l)%ioff, & 4917 surf_lsm_v(l)%j(m)+surf_lsm_v(l)%joff 4918 CALL message( 'land_surface_model_mod', 'PA0503', & 4919 0, 0, myid, 6, 0 ) 4960 flag_exceed_z0 = .TRUE. 4920 4961 ENDIF 4921 4962 IF ( surf_lsm_v(l)%z0h(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) ) THEN 4922 4923 4963 surf_lsm_v(l)%z0h(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m) 4924 4964 surf_lsm_v(l)%z0q(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m) 4925 4926 WRITE( message_string, * ) 'z0h exceeds surface-layer height '//& 4927 'at vertical natural surface and is ' // & 4928 'decreased appropriately at grid point (i,j) = ', & 4929 surf_lsm_v(l)%i(m)+surf_lsm_v(l)%ioff, & 4930 surf_lsm_v(l)%j(m)+surf_lsm_v(l)%joff 4931 CALL message( 'land_surface_model_mod', 'PA0507', & 4932 0, 0, myid, 6, 0 ) 4965 flag_exceed_z0h = .TRUE. 4933 4966 ENDIF 4934 4967 ENDDO 4935 4968 ENDDO 4969 #if defined( __parallel ) 4970 CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0, 1, MPI_LOGICAL, & 4971 MPI_LOR, comm2d, ierr) 4972 #endif 4973 IF ( flag_exceed_z0 ) THEN 4974 WRITE( message_string, * ) 'z0 exceeds surface-layer height ' // & 4975 'at vertical natural surface(s) and '// & 4976 'is decreased appropriately' 4977 CALL message( 'land_surface_model_mod', 'PA0503', 0, 0, 0, 6, 0 ) 4978 ENDIF 4979 #if defined( __parallel ) 4980 CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0h, 1, MPI_LOGICAL, & 4981 MPI_LOR, comm2d, ierr) 4982 #endif 4983 IF ( flag_exceed_z0h ) THEN 4984 WRITE( message_string, * ) 'z0h exceeds surface-layer height ' // & 4985 'at vertical natural surface(s) and '// & 4986 'is decreased appropriately.' 4987 CALL message( 'land_surface_model_mod', 'PA0507', 0, 0, 0, 6, 0 ) 4988 ENDIF 4936 4989 4937 4990 IF ( debug_output ) CALL debug_message( 'lsm_init', 'end' ) … … 7201 7254 7202 7255 USE control_parameters, & 7203 ONLY: message_string, molecular_viscosity 7204 7205 IMPLICIT NONE 7256 ONLY: message_string, & 7257 molecular_viscosity 7206 7258 7207 7259 INTEGER(iwp) :: i !< running index 7208 7260 INTEGER(iwp) :: j !< running index 7209 7261 INTEGER(iwp) :: m !< running index 7262 7263 LOGICAL :: flag_exceed_z0 = .FALSE. !< dummy flag to indicate whether roughness length is too high 7264 LOGICAL :: flag_exceed_z0h = .FALSE. !< dummy flag to indicate whether roughness length for scalars is too high 7210 7265 7211 7266 REAL(wp), PARAMETER :: alpha_ch = 0.018_wp !< Charnock constant (0.01-0.11). Use 0.01 for FLake and 0.018 for ECMWF … … 7255 7310 ( surf_lsm_h%us(m) + 1E-8_wp ) 7256 7311 7257 7312 7258 7313 IF ( surf_lsm_h%z0(m) > 0.1_wp * surf_lsm_h%z_mo(m) ) THEN 7259 7260 7314 surf_lsm_h%z0(m) = 0.1_wp * surf_lsm_h%z_mo(m) 7261 7262 WRITE( message_string, * ) 'z0 exceeds surface-layer height' //& 7263 ' at horizontal sea surface and is ' // & 7264 'decreased appropriately at grid point (i,j) = ', & 7265 surf_lsm_h%i(m), surf_lsm_h%j(m) 7266 CALL message( 'land_surface_model_mod', 'PA0508', & 7267 0, 0, myid, 6, 0 ) 7315 flag_exceed_z0 = .TRUE. 7268 7316 ENDIF 7269 7317 7270 7318 IF ( surf_lsm_h%z0h(m) >= 0.1_wp * surf_lsm_h%z_mo(m) ) THEN 7271 7272 7319 surf_lsm_h%z0h(m) = 0.1_wp * surf_lsm_h%z_mo(m) 7273 7274 WRITE( message_string, * ) 'z0h exceeds surface-layer height'//& 7275 ' at horizontal sea surface and is ' // & 7276 'decreased appropriately at grid point (i,j) = ', & 7277 surf_lsm_h%i(m), surf_lsm_h%j(m) 7278 CALL message( 'land_surface_model_mod', 'PA0508', & 7279 0, 0, myid, 6, 0 ) 7320 flag_exceed_z0h = .TRUE. 7280 7321 ENDIF 7281 7322 7282 7323 IF ( surf_lsm_h%z0q(m) >= 0.1_wp * surf_lsm_h%z_mo(m) ) THEN 7283 7284 7324 surf_lsm_h%z0q(m) = 0.1_wp * surf_lsm_h%z_mo(m) 7285 7286 WRITE( message_string, * ) 'z0q exceeds surface-layer height'//& 7287 ' at horizontal sea surface and is ' // & 7288 'decreased appropriately at grid point (i,j) = ', & 7289 surf_lsm_h%i(m), surf_lsm_h%j(m) 7290 CALL message( 'land_surface_model_mod', 'PA0508', & 7291 0, 0, myid, 6, 0 ) 7325 flag_exceed_z0h = .TRUE. 7292 7326 ENDIF 7293 7327 … … 7295 7329 ENDIF 7296 7330 ENDDO 7331 #if defined( __parallel ) 7332 CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0, 1, MPI_LOGICAL, & 7333 MPI_LOR, comm2d, ierr) 7334 #endif 7335 IF ( flag_exceed_z0 ) THEN 7336 WRITE( message_string, * ) 'z0 exceeds surface-layer height ' // & 7337 'at horizontal sea surface(s) and ' // & 7338 'is decreased appropriately' 7339 CALL message( 'land_surface_model_mod', 'PA0508', 0, 0, 0, 6, 0 ) 7340 ENDIF 7341 #if defined( __parallel ) 7342 CALL MPI_ALLREDUCE( MPI_IN_PLACE, flag_exceed_z0h, 1, MPI_LOGICAL, & 7343 MPI_LOR, comm2d, ierr) 7344 #endif 7345 IF ( flag_exceed_z0h ) THEN 7346 WRITE( message_string, * ) 'z0h/q exceeds surface-layer height ' // & 7347 'at horizontal sea surface(s) and ' // & 7348 'is decreased appropriately' 7349 CALL message( 'land_surface_model_mod', 'PA0508', 0, 0, 0, 6, 0 ) 7350 ENDIF 7297 7351 7298 7352 END SUBROUTINE calc_z0_water_surface -
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r4363 r4381 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Give error message 313 only once 30 ! 31 ! 4363 2020-01-07 18:11:28Z suehring 29 32 ! Fix for last commit 30 33 ! … … 973 976 INTEGER(iwp) :: m !< running index 974 977 978 LOGICAL :: lad_on_top = .FALSE. !< dummy flag to indicate that LAD is defined on a building roof 979 975 980 REAL(wp) :: canopy_height !< canopy height for lad-profile construction 976 981 REAL(wp) :: gradient !< gradient for lad-profile construction … … 1227 1232 ANY( BTEST( wall_flags_total_0(:,j,i), 4 ) ) ) THEN 1228 1233 lad_s(:,j,i) = 0.0_wp 1229 WRITE( message_string, * ) & 1234 lad_on_top = .TRUE. 1235 ENDIF 1236 ENDDO 1237 ENDDO 1238 #if defined( __parallel ) 1239 CALL MPI_ALLREDUCE( MPI_IN_PLACE, lad_on_top, 1, MPI_LOGICAL, & 1240 MPI_LOR, comm2d, ierr) 1241 #endif 1242 IF ( lad_on_top ) THEN 1243 WRITE( message_string, * ) & 1230 1244 'Resolved plant-canopy is ' // & 1231 1245 'defined on top of an artificially '// & 1232 'created building grid point ' //&1246 'created building grid point(s) ' // & 1233 1247 '(emerged from the filtering) - ' // & 1234 'LAD profile is omitted at this ' // & 1235 'grid point: (i,j) = ', i, j 1236 CALL message( 'pcm_init', 'PA0313', 0, 0, myid, 6, 0 ) 1237 ENDIF 1238 ENDDO 1239 ENDDO 1248 'LAD profile is omitted at this / ' // & 1249 'these grid point(s).' 1250 CALL message( 'pcm_init', 'PA0313', 0, 0, 0, 6, 0 ) 1251 ENDIF 1240 1252 CALL exchange_horiz( lad_s, nbgp ) 1241 1253 !
Note: See TracChangeset
for help on using the changeset viewer.
