diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 8797973f3..d9ff2c572 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -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 @@ -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 = '' @@ -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) @@ -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))