Changeset 4381 for palm/trunk


Ignore:
Timestamp:
Jan 20, 2020 1:51:46 PM (5 years ago)
Author:
suehring
Message:

Land-surface model: Bugfix in nested soil initialization in case no dynamic input file is present; give local error messages only onces

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r4360 r4381  
    2525! -----------------
    2626! $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
    2733! Fix wrong location string in message call
    2834!
     
    23472353#if defined( __parallel )
    23482354       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 )
    23512364       REAL(wp), DIMENSION(:), ALLOCATABLE ::  m_soil_root    !< domain-averaged soil moisture profile in root domain
    23522365       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_soil_root    !< domain-averaged soil temperature profile in root domain
     
    42934306#if defined( __parallel )
    42944307!
     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!
    42954321!--          In case of a nested run, first average the soil profiles in the
    42964322!--          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 /                    &
    43204349                                        REAL( ( nx + 1 ) * ( ny + 1), KIND=wp )
    4321                    DEALLOCATE( pr_soil_init )
    4322                 ENDIF
    4323 !
    4324 !--             Proceed with soil temperature.
    4325                 IF ( init_3d%from_file_tsoil  .AND.  init_3d%lod_tsoil == 2 )  &
    4326                 THEN
    4327                    ALLOCATE( pr_soil_init(0:init_3d%nzs-1) )
    4328              
    4329                    DO  k = 0, init_3d%nzs-1
    4330                       pr_soil_init(k) = SUM( init_3d%tsoil_3d(k,nys:nyn,nxl:nxr)  )
    4331                    ENDDO
    4332 !           
    4333 !--                Allocate 1D array for soil-temperature profile (will not be
    4334 !--                allocated in lod==2 case).
    4335                    ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) )
    4336                    init_3d%tsoil_1d = 0.0_wp
    4337                    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 /                    &
    43414370                                        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
    43854374                ENDIF
    43864375!               
    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
    43954397                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
    43964413!               
    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
    44054443                ENDIF
     4444               
     4445                DEALLOCATE( z_soil_root )
     4446                DEALLOCATE( m_soil_root )
     4447                DEALLOCATE( t_soil_root )
    44064448             ENDIF
    4407              
    4408              DEALLOCATE( z_soil_root )
    4409              DEALLOCATE( m_soil_root )
    4410              DEALLOCATE( t_soil_root )
    44114449          ENDIF
    44124450#endif
     
    48784916!--    Check if roughness length for momentum, heat, or moisture exceed
    48794917!--    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.
    48814922       DO  m = 1, surf_lsm_h%ns
    48824923          IF ( surf_lsm_h%z0(m) > 0.5_wp * surf_lsm_h%z_mo(m) )  THEN
    4883          
    48844924             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.
    48924926          ENDIF
    48934927          IF ( surf_lsm_h%z0h(m) > 0.5_wp * surf_lsm_h%z_mo(m) )  THEN
    4894          
    48954928             surf_lsm_h%z0h(m) = 0.5_wp * surf_lsm_h%z_mo(m)
    48964929             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.
    49044931          ENDIF
    49054932       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.
    49074956       DO  l = 0, 3
    49084957          DO  m = 1, surf_lsm_v(l)%ns
    49094958             IF ( surf_lsm_v(l)%z0(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) )  THEN
    4910          
    49114959                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.
    49204961             ENDIF
    49214962             IF ( surf_lsm_v(l)%z0h(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) )  THEN
    4922          
    49234963                surf_lsm_v(l)%z0h(m) = 0.5_wp * surf_lsm_v(l)%z_mo(m)
    49244964                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.
    49334966             ENDIF
    49344967          ENDDO
    49354968       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
    49364989
    49374990       IF ( debug_output )  CALL debug_message( 'lsm_init', 'end' )
     
    72017254
    72027255       USE control_parameters,                                                 &
    7203            ONLY: message_string, molecular_viscosity
    7204 
    7205        IMPLICIT NONE
     7256           ONLY:  message_string,                                              &
     7257                  molecular_viscosity
    72067258
    72077259       INTEGER(iwp) ::  i       !< running index
    72087260       INTEGER(iwp) ::  j       !< running index
    72097261       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
    72107265
    72117266       REAL(wp), PARAMETER :: alpha_ch  = 0.018_wp !< Charnock constant (0.01-0.11). Use 0.01 for FLake and 0.018 for ECMWF
     
    72557310                                 ( surf_lsm_h%us(m) + 1E-8_wp )
    72567311
    7257  
     7312
    72587313             IF ( surf_lsm_h%z0(m) > 0.1_wp * surf_lsm_h%z_mo(m) )  THEN
    7259  
    72607314                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.
    72687316             ENDIF
    7269  
     7317
    72707318             IF ( surf_lsm_h%z0h(m) >= 0.1_wp * surf_lsm_h%z_mo(m) )  THEN
    7271  
    72727319                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.
    72807321             ENDIF
    7281              
     7322
    72827323             IF ( surf_lsm_h%z0q(m) >= 0.1_wp * surf_lsm_h%z_mo(m) )  THEN
    7283  
    72847324                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.
    72927326             ENDIF
    72937327 
     
    72957329          ENDIF
    72967330       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
    72977351
    72987352    END SUBROUTINE calc_z0_water_surface
  • palm/trunk/SOURCE/plant_canopy_model_mod.f90

    r4363 r4381  
    2727! -----------------
    2828! $Id$
     29! Give error message 313 only once
     30!
     31! 4363 2020-01-07 18:11:28Z suehring
    2932! Fix for last commit
    3033!
     
    973976       INTEGER(iwp) ::  m   !< running index
    974977
     978       LOGICAL      ::  lad_on_top = .FALSE.  !< dummy flag to indicate that LAD is defined on a building roof
     979
    975980       REAL(wp) ::  canopy_height   !< canopy height for lad-profile construction
    976981       REAL(wp) ::  gradient        !< gradient for lad-profile construction
     
    12271232                           ANY( BTEST( wall_flags_total_0(:,j,i), 4 ) ) )  THEN
    12281233                         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, * )                                  &
    12301244                                        'Resolved plant-canopy is ' //         &
    12311245                                        'defined on top of an artificially '// &
    1232                                         'created building grid point ' //      &
     1246                                        'created building grid point(s) ' //   &
    12331247                                        '(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
    12401252                CALL exchange_horiz( lad_s, nbgp )
    12411253!
Note: See TracChangeset for help on using the changeset viewer.