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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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.