Changeset 4187 for palm/trunk/SOURCE


Ignore:
Timestamp:
Aug 26, 2019 12:43:15 PM (5 years ago)
Author:
suehring
Message:

radiation: Take external radiation input from root domain dynamic file if no dynamic input file is provided for each nested domain; radiation: Combine MPI_ALLREDUCE calls to reduce latency; land_surface + plant_canopy: Give specific error numbers; land-surface: Adjust error messages for local checks; init_3d_model: Deallocate temporary string array for netcdf-data input since it may be re-used in other modules for different input files

Location:
palm/trunk/SOURCE
Files:
4 edited

Legend:

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

    r4186 r4187  
    2525! -----------------
    2626! $Id$
     27! Deallocate temporary string array since it may be re-used to read different
     28! input data in other modules
     29!
     30! 4186 2019-08-23 16:06:14Z suehring
    2731! Design change, use variables defined in netcdf_data_input_mod to read netcd
    2832! variables rather than define local ones.
     
    15941598                           
    15951599!
    1596 !--    Finally, close the input file.
     1600!--    Finally, close the input file and deallocate temporary arrays
     1601       DEALLOCATE( vars_pids )
     1602       
    15971603       CALL close_input_file( pids_id )
    15981604#endif
  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r4182 r4187  
    2525! -----------------
    2626! $Id$
     27! Adjust message call in case of local checks
     28!
     29! 4182 2019-08-22 15:20:23Z scharf
    2730! Corrected "Former revisions" section
    2831!
     
    12891292          message_string = 'pavement-surfaces are not allowed in ' //           &
    12901293                           'combination with a non-default setting of dz_soil'
    1291           CALL message( 'lsm_check_parameters', 'PA0999', 2, 2, 0, 6, 0 )
     1294          CALL message( 'lsm_check_parameters', 'PA0316', 2, 2, 0, 6, 0 )
    12921295       ENDIF
    12931296    ENDIF
     
    31693172                                 'so that information given in ',              &
    31703173                                 'vegetation_pars at this point is neglected.'
    3171                 CALL message( 'land_surface_model_mod', 'PA0999', 0, 0, 0, 6, 0 )
     3174                CALL message( 'land_surface_model_mod', 'PA0436', 0, 0, myid, 6, 0 )
    31723175             ELSE
    31733176
     
    32453248                                 'so that information given in ',              &
    32463249                                 'vegetation_pars at this point is neglected.'
    3247                    CALL message( 'land_surface_model_mod', 'PA0999', 0, 0, 0, 6, 0 )
     3250                   CALL message( 'land_surface_model_mod', 'PA0437', 0, 0, myid, 6, 0 )
    32483251                ELSE
    32493252
     
    34613464                              'so that information given in ',                 &
    34623465                              'water_pars at this point is neglected.'
    3463                 CALL message( 'land_surface_model_mod', 'PA0999', 0, 0, 0, 6, 0 )
     3466                CALL message( 'land_surface_model_mod', 'PA0645', 0, 0, myid, 6, 0 )
    34643467             ELSE
    34653468                IF ( water_pars_f%pars_xy(ind_w_temp,j,i) /=                   &
     
    35173520                              'so that information given in ',                 &
    35183521                              'water_pars at this point is neglected.'
    3519                    CALL message( 'land_surface_model_mod', 'PA0999',           &
    3520                                   0, 0, 0, 6, 0 )
     3522                   CALL message( 'land_surface_model_mod', 'PA0646',           &
     3523                                  0, 0, myid, 6, 0 )
    35213524                ELSE
    35223525
     
    38243827                              'so that information given in ',                 &
    38253828                              'pavement_pars at this point is neglected.'
    3826                 CALL message( 'land_surface_model_mod', 'PA0999', 0, 0, 0, 6, 0 )
     3829                CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 )
    38273830             ELSE
    38283831                IF ( pavement_pars_f%pars_xy(ind_p_z0,j,i) /=                  &
     
    38833886                                 'so that information given in ',              &
    38843887                                 'pavement_pars at this point is neglected.'
    3885                    CALL message( 'land_surface_model_mod', 'PA0999', 0, 0, 0, 6, 0 )
     3888                   CALL message( 'land_surface_model_mod', 'PA0670', 0, 0, myid, 6, 0 )
    38863889                ELSE
    38873890
     
    43034306                            'than its saturation value at (k,j,i) ', k,        &
    43044307                            surf_lsm_h%i(m), surf_lsm_h%j(m)
    4305                       CALL message( 'lsm_init', 'PA0458', 2, 2, 0, 6, 0 )
     4308                      CALL message( 'lsm_init', 'PA0458', 2, 2, myid, 6, 0 )
    43064309                   ENDIF               
    43074310                ENDDO
     
    43194322                            'its saturation value at (k,j,i) ', k,             &
    43204323                            surf_lsm_v(l)%i(m), surf_lsm_v(l)%j(m)
    4321                          CALL message( 'lsm_init', 'PA0458', 2, 2, 0, 6, 0 )                   
     4324                         CALL message( 'lsm_init', 'PA0458', 2, 2, myid, 6, 0 )                   
    43224325                      ENDIF
    43234326                   ENDDO
     
    45814584          message_string = 'For non-pavement surfaces the combination ' //     &
    45824585                           ' lai = 0.0 and c_veg = 1.0 is not allowed.'
    4583           CALL message( 'lsm_rrd_local', 'PA0999', 2, 2, 0, 6, 0 )
     4586          CALL message( 'lsm_rrd_local', 'PA0671', 2, 2, 0, 6, 0 )
    45844587       ENDIF
    45854588
     
    45904593             message_string = 'For non-pavement surfaces the combination ' //  &
    45914594                              ' lai = 0.0 and c_veg = 1.0 is not allowed.'
    4592              CALL message( 'lsm_rrd_local', 'PA0999', 2, 2, 0, 6, 0 )
     4595             CALL message( 'lsm_rrd_local', 'PA0672', 2, 2, 0, 6, 0 )
    45934596          ENDIF
    45944597       ENDDO
     
    46074610                            surf_lsm_h%i(m), surf_lsm_h%j(m)
    46084611             CALL message( 'land_surface_model_mod', 'PA0503',                 &
    4609                             0, 0, 0, 6, 0 )
     4612                            0, 0, myid, 6, 0 )
    46104613          ENDIF
    46114614          IF ( surf_lsm_h%z0h(m) > 0.5_wp * surf_lsm_h%z_mo(m) )  THEN
     
    46194622                            surf_lsm_h%i(m), surf_lsm_h%j(m)
    46204623             CALL message( 'land_surface_model_mod', 'PA0507',                 &
    4621                             0, 0, 0, 6, 0 )
     4624                            0, 0, myid, 6, 0 )
    46224625          ENDIF
    46234626       ENDDO
     
    46354638                            surf_lsm_v(l)%j(m)+surf_lsm_v(l)%joff
    46364639                CALL message( 'land_surface_model_mod', 'PA0503',              &
    4637                             0, 0, 0, 6, 0 )
     4640                            0, 0, myid, 6, 0 )
    46384641             ENDIF
    46394642             IF ( surf_lsm_v(l)%z0h(m) > 0.5_wp * surf_lsm_v(l)%z_mo(m) )  THEN
     
    46484651                            surf_lsm_v(l)%j(m)+surf_lsm_v(l)%joff
    46494652                CALL message( 'land_surface_model_mod', 'PA0507',              &
    4650                             0, 0, 0, 6, 0 )
     4653                            0, 0, myid, 6, 0 )
    46514654             ENDIF
    46524655          ENDDO
     
    69826985                            surf_lsm_h%i(m), surf_lsm_h%j(m)
    69836986                CALL message( 'land_surface_model_mod', 'PA0508',              &
    6984                               0, 0, 0, 6, 0 )
     6987                              0, 0, myid, 6, 0 )
    69856988             ENDIF
    69866989 
     
    69946997                            surf_lsm_h%i(m), surf_lsm_h%j(m)
    69956998                CALL message( 'land_surface_model_mod', 'PA0508',              &
    6996                               0, 0, 0, 6, 0 )
     6999                              0, 0, myid, 6, 0 )
    69977000             ENDIF
    69987001             
     
    70067009                            surf_lsm_h%i(m), surf_lsm_h%j(m)
    70077010                CALL message( 'land_surface_model_mod', 'PA0508',              &
    7008                               0, 0, 0, 6, 0 )
     7011                              0, 0, myid, 6, 0 )
    70097012             ENDIF
    70107013 
  • palm/trunk/SOURCE/plant_canopy_model_mod.f90

    r4182 r4187  
    2727! -----------------
    2828! $Id$
     29! Give specific error numbers instead of PA0999
     30!
     31! 4182 2019-08-22 15:20:23Z scharf
    2932! Corrected "Former revisions" section
    3033!
     
    430433                           TRIM( coupling_char ) // ' requires ' //            &
    431434                           'canopy_mode = read_from_file_3d'
    432           CALL message( 'pcm_check_parameters', 'PA0999', 1, 2, 0, 6, 0 )
     435          CALL message( 'pcm_check_parameters', 'PA0673', 1, 2, 0, 6, 0 )
    433436       ENDIF
    434437
     
    10661069                   ENDDO
    10671070                ENDDO
     1071               
    10681072                CALL exchange_horiz( lad_s, nbgp )
    10691073!
     
    10911095       ALLOCATE( pch_index_ji(nysg:nyng,nxlg:nxrg) )
    10921096       pch_index_ji = 0
    1093 
     1097       
    10941098       DO  i = nxl, nxr
    10951099          DO  j = nys, nyn
     
    11041108                message_string =  'Local vegetation height on top of ' //      &
    11051109                                  'topography exceeds height of model domain.'
    1106                 CALL message( 'pcm_init', 'PA0999', 2, 2, 0, 6, 0 )
     1110                CALL message( 'pcm_init', 'PA0674', 2, 2, 0, 6, 0 )
    11071111             ENDIF
    11081112
     
    11141118!--    Calculate global pch_index value (index of top of plant canopy from ground)
    11151119       pch_index = MAXVAL( pch_index_ji )
     1120       
     1121       
    11161122!
    11171123!--    Exchange pch_index from all processors
     
    11291135          pc_latent_rate = 0.0_wp
    11301136       ENDIF
    1131 
    11321137!
    11331138!--    Initialization of the canopy heat source distribution due to heating
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r4182 r4187  
    2828! -----------------
    2929! $Id$
     30! - Take external radiation from root domain dynamic input if not provided for
     31!   each nested domain
     32! - Combine MPI_ALLREDUCE calls to reduce mpi overhead
     33!
     34! 4182 2019-08-22 15:20:23Z scharf
    3035! Corrected "Former revisions" section
    3136!
     
    234239               inquire_variable_names,                                         &
    235240               input_file_dynamic,                                             &
     241               input_pids_dynamic,                                             &
    236242               netcdf_data_input_get_dimension_length,                         &
    237243               num_var_pids,                                                   &
     
    14531459       INTEGER(iwp) ::  ind_type  !< running index for subgrid-surface tiles
    14541460#endif
     1461       LOGICAL      ::  radiation_input_root_domain !< flag indicating the existence of a dynamic input file for the root domain
    14551462
    14561463
     
    24512458       IF ( radiation_scheme == 'external' )  THEN
    24522459!
    2453 !--       Open the radiation input file
     2460!--       Open the radiation input file. Note, for child domain, a dynamic
     2461!--       input file is often not provided. In order to do not need to
     2462!--       duplicate the dynamic input file just for the radiation input, take
     2463!--       it from the dynamic file for the parent if not available for the
     2464!--       child domain(s). In this case this is possible because radiation
     2465!--       input should be the same for each model.
     2466          INQUIRE( FILE = TRIM( input_file_dynamic ),                          &
     2467                   EXIST = radiation_input_root_domain  )
     2468                   
     2469          IF ( .NOT. input_pids_dynamic  .AND.                                 &
     2470               .NOT. radiation_input_root_domain )  THEN
     2471             message_string = 'In case of external radiation forcing ' //      &
     2472                              'a dynamic input file is required. If no ' //    &
     2473                              'dynamic input for the child domain(s) is ' //   &
     2474                              'provided, at least one for the root domain ' // &
     2475                              'needs to be provided.'
     2476             CALL message( 'radiation_init', 'PA0315', 1, 2, 0, 6, 0 )
     2477          ENDIF
    24542478#if defined( __netcdf )
    2455           CALL open_read_file( TRIM( input_file_dynamic ) //                   &
    2456                                TRIM( coupling_char ),                          &
    2457                                pids_id )
     2479!
     2480!--       Open dynamic input file for child domain if available, else, open
     2481!--       dynamic input file for the root domain.
     2482          IF ( input_pids_dynamic )  THEN
     2483             CALL open_read_file( TRIM( input_file_dynamic ) //                &
     2484                                  TRIM( coupling_char ),                       &
     2485                                  pids_id )
     2486          ELSEIF ( radiation_input_root_domain )  THEN
     2487             CALL open_read_file( TRIM( input_file_dynamic ),                  &
     2488                                  pids_id )
     2489          ENDIF
    24582490                               
    24592491          CALL inquire_num_variables( pids_id, num_var_pids )
     
    24622494          ALLOCATE( vars_pids(1:num_var_pids) )
    24632495          CALL inquire_variable_names( pids_id, vars_pids )
    2464          
    24652496!         
    24662497!--       Input time dimension.
     
    25192550          ENDIF
    25202551!         
    2521 !--       Finally, close the input file.
     2552!--       Finally, close the input file and deallocate temporary arrays
     2553          DEALLOCATE( vars_pids )
     2554         
    25222555          CALL close_input_file( pids_id )
    25232556#endif
     
    51135146     IMPLICIT NONE
    51145147
    5115      INTEGER(iwp)                      :: i, j, k, kk, d, refstep, m, mm, l, ll
    5116      INTEGER(iwp)                      :: isurf, isurfsrc, isvf, icsf, ipcgb
    5117      INTEGER(iwp)                      :: imrt, imrtf
    5118      INTEGER(iwp)                      :: isd                !< solar direction number
    5119      INTEGER(iwp)                      :: pc_box_dimshift    !< transform for best accuracy
    5120      INTEGER(iwp), DIMENSION(0:3)      :: reorder = (/ 1, 0, 3, 2 /)
    5121      
    5122      REAL(wp), DIMENSION(3,3)          :: mrot               !< grid rotation matrix (zyx)
    5123      REAL(wp), DIMENSION(3,0:nsurf_type):: vnorm             !< face direction normal vectors (zyx)
    5124      REAL(wp), DIMENSION(3)            :: sunorig            !< grid rotated solar direction unit vector (zyx)
    5125      REAL(wp), DIMENSION(3)            :: sunorig_grid       !< grid squashed solar direction unit vector (zyx)
    5126      REAL(wp), DIMENSION(0:nsurf_type) :: costheta           !< direct irradiance factor of solar angle
    5127      REAL(wp), DIMENSION(nz_urban_b:nz_urban_t)    :: pchf_prep          !< precalculated factor for canopy temperature tendency
     5148     INTEGER(iwp)                      ::  i, j, k, kk, d, refstep, m, mm, l, ll
     5149     INTEGER(iwp)                      ::  isurf, isurfsrc, isvf, icsf, ipcgb
     5150     INTEGER(iwp)                      ::  imrt, imrtf
     5151     INTEGER(iwp)                      ::  isd                !< solar direction number
     5152     INTEGER(iwp)                      ::  pc_box_dimshift    !< transform for best accuracy
     5153     INTEGER(iwp), DIMENSION(0:3)      ::  reorder = (/ 1, 0, 3, 2 /)
     5154                                          
     5155     REAL(wp), DIMENSION(3,3)          ::  mrot               !< grid rotation matrix (zyx)
     5156     REAL(wp), DIMENSION(3,0:nsurf_type)::  vnorm             !< face direction normal vectors (zyx)
     5157     REAL(wp), DIMENSION(3)            ::  sunorig            !< grid rotated solar direction unit vector (zyx)
     5158     REAL(wp), DIMENSION(3)            ::  sunorig_grid       !< grid squashed solar direction unit vector (zyx)
     5159     REAL(wp), DIMENSION(0:nsurf_type) ::  costheta           !< direct irradiance factor of solar angle
     5160     REAL(wp), DIMENSION(nz_urban_b:nz_urban_t) :: pchf_prep          !< precalculated factor for canopy temperature tendency
    51285161     REAL(wp), PARAMETER               :: alpha = 0._wp      !< grid rotation (TODO: synchronize with rotation_angle
    51295162                                                             !< from netcdf_data_input_mod)
    5130      REAL(wp)                          :: pc_box_area, pc_abs_frac, pc_abs_eff
    5131      REAL(wp)                          :: asrc               !< area of source face
    5132      REAL(wp)                          :: pcrad              !< irradiance from plant canopy
    5133      REAL(wp)                          :: pabsswl  = 0.0_wp  !< total absorbed SW radiation energy in local processor (W)
    5134      REAL(wp)                          :: pabssw   = 0.0_wp  !< total absorbed SW radiation energy in all processors (W)
    5135      REAL(wp)                          :: pabslwl  = 0.0_wp  !< total absorbed LW radiation energy in local processor (W)
    5136      REAL(wp)                          :: pabslw   = 0.0_wp  !< total absorbed LW radiation energy in all processors (W)
    5137      REAL(wp)                          :: pemitlwl = 0.0_wp  !< total emitted LW radiation energy in all processors (W)
    5138      REAL(wp)                          :: pemitlw  = 0.0_wp  !< total emitted LW radiation energy in all processors (W)
    5139      REAL(wp)                          :: pinswl   = 0.0_wp  !< total received SW radiation energy in local processor (W)
    5140      REAL(wp)                          :: pinsw    = 0.0_wp  !< total received SW radiation energy in all processor (W)
    5141      REAL(wp)                          :: pinlwl   = 0.0_wp  !< total received LW radiation energy in local processor (W)
    5142      REAL(wp)                          :: pinlw    = 0.0_wp  !< total received LW radiation energy in all processor (W)
    5143      REAL(wp)                          :: emiss_sum_surfl    !< sum of emissisivity of surfaces in local processor
    5144      REAL(wp)                          :: emiss_sum_surf     !< sum of emissisivity of surfaces in all processor
    5145      REAL(wp)                          :: area_surfl         !< total area of surfaces in local processor
    5146      REAL(wp)                          :: area_surf          !< total area of surfaces in all processor
    5147      REAL(wp)                          :: area_hor           !< total horizontal area of domain in all processor
    5148 
     5163     REAL(wp)                          ::  pc_box_area, pc_abs_frac, pc_abs_eff
     5164     REAL(wp)                          ::  asrc               !< area of source face
     5165     REAL(wp)                          ::  pcrad              !< irradiance from plant canopy
     5166     REAL(wp)                          ::  pabsswl  = 0.0_wp  !< total absorbed SW radiation energy in local processor (W)
     5167     REAL(wp)                          ::  pabssw   = 0.0_wp  !< total absorbed SW radiation energy in all processors (W)
     5168     REAL(wp)                          ::  pabslwl  = 0.0_wp  !< total absorbed LW radiation energy in local processor (W)
     5169     REAL(wp)                          ::  pabslw   = 0.0_wp  !< total absorbed LW radiation energy in all processors (W)
     5170     REAL(wp)                          ::  pemitlwl = 0.0_wp  !< total emitted LW radiation energy in all processors (W)
     5171     REAL(wp)                          ::  pemitlw  = 0.0_wp  !< total emitted LW radiation energy in all processors (W)
     5172     REAL(wp)                          ::  pinswl   = 0.0_wp  !< total received SW radiation energy in local processor (W)
     5173     REAL(wp)                          ::  pinsw    = 0.0_wp  !< total received SW radiation energy in all processor (W)
     5174     REAL(wp)                          ::  pinlwl   = 0.0_wp  !< total received LW radiation energy in local processor (W)
     5175     REAL(wp)                          ::  pinlw    = 0.0_wp  !< total received LW radiation energy in all processor (W)
     5176     REAL(wp)                          ::  emiss_sum_surfl    !< sum of emissisivity of surfaces in local processor
     5177     REAL(wp)                          ::  emiss_sum_surf     !< sum of emissisivity of surfaces in all processor
     5178     REAL(wp)                          ::  area_surfl         !< total area of surfaces in local processor
     5179     REAL(wp)                          ::  area_surf          !< total area of surfaces in all processor
     5180     REAL(wp)                          ::  area_hor           !< total horizontal area of domain in all processor
     5181#if defined( __parallel )     
     5182     REAL(wp), DIMENSION(1:7)          ::  combine_allreduce   !< dummy array used to combine several MPI_ALLREDUCE calls
     5183     REAL(wp), DIMENSION(1:7)          ::  combine_allreduce_l !< dummy array used to combine several MPI_ALLREDUCE calls
     5184#endif
    51495185
    51505186     IF ( debug_output_timestep )  CALL debug_message( 'radiation_interaction', 'start' )
     
    58295865        pabsswl = pabsswl + SUM(pcbinsw)
    58305866        pabslwl = pabslwl + SUM(pcbinlw)
    5831         pinswl = pinswl + SUM(pcbinswdir) + SUM(pcbinswdif)
     5867        pinswl  = pinswl + SUM(pcbinswdir) + SUM(pcbinswdif)
    58325868     ENDIF
    58335869!
    5834 !--  gather all rad flux energy in all processors
     5870!--  gather all rad flux energy in all processors. In order to reduce
     5871!--  the number of MPI calls (to reduce latencies), combine the required
     5872!--  quantities in one array, sum it up, and subsequently re-distribute
     5873!--  back to the respective quantities.
    58355874#if defined( __parallel )
    5836      CALL MPI_ALLREDUCE( pinswl, pinsw, 1, MPI_REAL, MPI_SUM, comm2d, ierr)
    5837      IF ( ierr /= 0 ) THEN
    5838          WRITE(9,*) 'Error MPI_AllReduce5:', ierr, pinswl, pinsw
    5839          FLUSH(9)
    5840      ENDIF
    5841      CALL MPI_ALLREDUCE( pinlwl, pinlw, 1, MPI_REAL, MPI_SUM, comm2d, ierr)
    5842      IF ( ierr /= 0 ) THEN
    5843          WRITE(9,*) 'Error MPI_AllReduce6:', ierr, pinlwl, pinlw
    5844          FLUSH(9)
    5845      ENDIF
    5846      CALL MPI_ALLREDUCE( pabsswl, pabssw, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
    5847      IF ( ierr /= 0 ) THEN
    5848          WRITE(9,*) 'Error MPI_AllReduce7:', ierr, pabsswl, pabssw
    5849          FLUSH(9)
    5850      ENDIF
    5851      CALL MPI_ALLREDUCE( pabslwl, pabslw, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
    5852      IF ( ierr /= 0 ) THEN
    5853          WRITE(9,*) 'Error MPI_AllReduce8:', ierr, pabslwl, pabslw
    5854          FLUSH(9)
    5855      ENDIF
    5856      CALL MPI_ALLREDUCE( pemitlwl, pemitlw, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
    5857      IF ( ierr /= 0 ) THEN
    5858          WRITE(9,*) 'Error MPI_AllReduce8:', ierr, pemitlwl, pemitlw
    5859          FLUSH(9)
    5860      ENDIF
    5861      CALL MPI_ALLREDUCE( emiss_sum_surfl, emiss_sum_surf, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
    5862      IF ( ierr /= 0 ) THEN
    5863          WRITE(9,*) 'Error MPI_AllReduce9:', ierr, emiss_sum_surfl, emiss_sum_surf
    5864          FLUSH(9)
    5865      ENDIF
    5866      CALL MPI_ALLREDUCE( area_surfl, area_surf, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
    5867      IF ( ierr /= 0 ) THEN
    5868          WRITE(9,*) 'Error MPI_AllReduce10:', ierr, area_surfl, area_surf
    5869          FLUSH(9)
    5870      ENDIF
     5875     combine_allreduce_l(1) = pinswl
     5876     combine_allreduce_l(2) = pinlwl
     5877     combine_allreduce_l(3) = pabsswl
     5878     combine_allreduce_l(4) = pabslwl
     5879     combine_allreduce_l(5) = pemitlwl
     5880     combine_allreduce_l(6) = emiss_sum_surfl
     5881     combine_allreduce_l(7) = area_surfl
     5882     
     5883     CALL MPI_ALLREDUCE( combine_allreduce_l,                                  &
     5884                         combine_allreduce,                                    &
     5885                         SIZE( combine_allreduce ),                            &
     5886                         MPI_REAL,                                             &
     5887                         MPI_SUM,                                              &
     5888                         comm2d,                                               &
     5889                         ierr )
     5890     
     5891     pinsw          = combine_allreduce(1)
     5892     pinlw          = combine_allreduce(2)
     5893     pabssw         = combine_allreduce(3)
     5894     pabslw         = combine_allreduce(4)
     5895     pemitlw        = combine_allreduce(5)
     5896     emiss_sum_surf = combine_allreduce(6)
     5897     area_surf      = combine_allreduce(7)
    58715898#else
    5872      pinsw = pinswl
    5873      pinlw = pinlwl
    5874      pabssw = pabsswl
    5875      pabslw = pabslwl
    5876      pemitlw = pemitlwl
     5899     pinsw          = pinswl
     5900     pinlw          = pinlwl
     5901     pabssw         = pabsswl
     5902     pabslw         = pabslwl
     5903     pemitlw        = pemitlwl
    58775904     emiss_sum_surf = emiss_sum_surfl
    5878      area_surf = area_surfl
     5905     area_surf      = area_surfl
    58795906#endif
    58805907
    58815908!--  (1) albedo
    5882      IF ( pinsw /= 0.0_wp )  &
    5883           albedo_urb = (pinsw - pabssw) / pinsw
     5909     IF ( pinsw /= 0.0_wp )  albedo_urb = ( pinsw - pabssw ) / pinsw
    58845910!--  (2) average emmsivity
    5885      IF ( area_surf /= 0.0_wp ) &
    5886           emissivity_urb = emiss_sum_surf / area_surf
     5911     IF ( area_surf /= 0.0_wp )  emissivity_urb = emiss_sum_surf / area_surf
    58875912!
    58885913!--  Temporally comment out calculation of effective radiative temperature.
     
    58925917!--   the effect of vertical surfaces (which contributes to LW emission)
    58935918!--   We simply use the ratio of the total LW to the incoming LW flux
    5894       area_hor = pinlw/rad_lw_in_diff(nyn,nxl)
    5895       t_rad_urb = ( (pemitlw - pabslw + emissivity_urb*pinlw) / &
    5896            (emissivity_urb*sigma_sb * area_hor) )**0.25_wp
     5919      area_hor = pinlw / rad_lw_in_diff(nyn,nxl)
     5920      t_rad_urb = ( ( pemitlw - pabslw + emissivity_urb * pinlw ) / &
     5921           (emissivity_urb * sigma_sb * area_hor) )**0.25_wp
    58975922
    58985923     IF ( debug_output_timestep )  CALL debug_message( 'radiation_interaction', 'end' )
Note: See TracChangeset for help on using the changeset viewer.