Skip to content

Commit

Permalink
Added mpi_bast commands back in
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Feb 27, 2020
1 parent 75fdb61 commit 36de8f5
Showing 1 changed file with 61 additions and 2 deletions.
63 changes: 61 additions & 2 deletions physics/rrtmgp_lw_gas_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,9 @@ module rrtmgp_lw_gas_optics
use mo_compute_bc, only: compute_bc
use rrtmgp_aux, only: check_error_msg
use netcdf
#ifdef MPI
use mpi
#endif

contains

Expand Down Expand Up @@ -102,6 +105,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp
integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4, &
temp_log_array1, temp_log_array2, temp_log_array3, temp_log_array4
character(len=264) :: lw_gas_props_file
#ifdef MPI
integer :: mpierr
#endif

! Initialize
errmsg = ''
Expand All @@ -113,7 +119,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp
lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas)

! On master processor only...
! if (mpirank .eq. mpiroot) then
if (mpirank .eq. mpiroot) then
! Open file
status = nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid)

Expand Down Expand Up @@ -254,7 +260,60 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp

! Close file
status = nf90_close(ncid)
! endif
endif

#ifdef MPI
! Wait for processor 0 to catch up...
call MPI_BARRIER(mpicomm, mpierr)
! Broadcast data
write (*,*) 'Broadcasting RRTMGP longwave k-distribution data ... '
call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(ngpts, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(totplnk, size(totplnk), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(gas_names, size(gas_names), MPI_CHARACTER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(gas_minor, size(gas_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(identifier_minor, size(identifier_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(minor_gases_lower, size(minor_gases_lower), MPI_CHARACTER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(minor_gases_upper, size(minor_gases_upper), MPI_CHARACTER, mpiroot, mpicomm, mpierr)
call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr)
call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr)
! Don't advance until data broadcast complete on all processors
call MPI_BARRIER(mpicomm, mpierr)
#endif

! Initialize gas concentrations and gas optics class
call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array))
Expand Down

0 comments on commit 36de8f5

Please sign in to comment.