diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index aacecd6df..56fcff2ba 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -267,12 +267,12 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (LUT) ... ' call MPI_BARRIER(mpicomm, ierr) #ifndef SINGLE_PREC - call MPI_BCAST(radliq_lwr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_upr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_fac, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_lwr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_upr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_fac, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(radliq_lwr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(radliq_upr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(radliq_fac, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(radice_lwr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(radice_upr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(radice_fac, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) call MPI_BCAST(lut_extliq, size(lut_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) call MPI_BCAST(lut_ssaliq, size(lut_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) call MPI_BCAST(lut_asyliq, size(lut_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) @@ -281,12 +281,12 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d call MPI_BCAST(lut_asyice, size(lut_asyice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) #else - call MPI_BCAST(radliq_lwr, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_upr, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_fac, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_lwr, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_upr, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_fac, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(radliq_lwr, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(radliq_upr, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(radliq_fac, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(radice_lwr, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(radice_upr, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(radice_fac, 1, MPI_REAL, mpiroot, mpicomm, ierr) call MPI_BCAST(lut_extliq, size(lut_extliq), MPI_REAL, mpiroot, mpicomm, ierr) call MPI_BCAST(lut_ssaliq, size(lut_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr) call MPI_BCAST(lut_asyliq, size(lut_asyliq), MPI_REAL, mpiroot, mpicomm, ierr) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 84cdb4837..07c6d6231 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -119,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) ! Read dimensions for k-distribution fields (only on master processor(0)) -! if (mpirank .eq. mpiroot) then + if (mpirank .eq. mpiroot) then if(nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid_lw) .eq. NF90_NOERR) then status = nf90_inq_dimid(ncid_lw, 'temperature', dimid) status = nf90_inquire_dimension(ncid_lw, dimid, len=ntemps) @@ -153,28 +153,28 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp status = nf90_inquire_dimension(ncid_lw, dimid, len=ninternalSourcetemps) status = nf90_close(ncid_lw) endif -! endif + endif ! Broadcast dimensions to all processors -!#ifdef MPI -! call MPI_BARRIER(mpicomm, ierr) -! call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ngpts_lw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BARRIER(mpicomm, ierr) -!#endif +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) + call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(ngpts_lw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BARRIER(mpicomm, ierr) +#endif ! Allocate space for arrays allocate(gas_names(nabsorbers)) @@ -208,7 +208,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp allocate(totplnk(ninternalSourcetemps, nbnds)) allocate(planck_frac(ngpts_lw, nmixingfracs, npress+1, ntemps)) -! if (mpirank .eq. mpiroot) then + if (mpirank .eq. mpiroot) then write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' ! Read in fields from file if(nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid_lw) .eq. NF90_NOERR) then @@ -311,72 +311,72 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ! Close status = nf90_close(ncid_lw) endif -! endif + endif ! Broadcast arrays to all processors -!#ifdef MPI -! call MPI_BARRIER(mpicomm, ierr) -! if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP longwave k-distribution data ... ' -! call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, ierr) -!#ifndef SINGLE_PREC -! call MPI_BCAST(band_lims, size(band_lims), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(press_ref, size(press_ref), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref, size(temp_ref), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kmajor, size(kmajor), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_p, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_t, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(press_ref_trop, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(totplnk, size(totplnk), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(planck_frac, size(planck_frac), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -!#else -! call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(totplnk, size(totplnk), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, ierr) -!#endif -! ! Character arrays -! do ij=1,nabsorbers -! call MPI_BCAST(gas_names(ij), len(gas_names(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! enddo -! do ij=1,nminorabsorbers -! call MPI_BCAST(gas_minor(ij), len(gas_minor(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! call MPI_BCAST(identifier_minor(ij), len(identifier_minor(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! enddo -! do ij=1,nminor_absorber_intervals_lower -! call MPI_BCAST(minor_gases_lower(ij), len(minor_gases_lower(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! enddo -! do ij=1,nminor_absorber_intervals_upper -! call MPI_BCAST(minor_gases_upper(ij), len(minor_gases_upper(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! enddo -! ! Logical arrays -! ! -! call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, ierr) -! call MPI_BARRIER(mpicomm, ierr) -!#endif +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) + if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP longwave k-distribution data ... ' + call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, ierr) +#ifndef SINGLE_PREC + call MPI_BCAST(band_lims, size(band_lims), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(press_ref, size(press_ref), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref, size(temp_ref), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(kmajor, size(kmajor), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_p, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_t, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(press_ref_trop, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(totplnk, size(totplnk), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(planck_frac, size(planck_frac), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +#else + call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(totplnk, size(totplnk), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, ierr) +#endif + ! Character arrays + do ij=1,nabsorbers + call MPI_BCAST(gas_names(ij), len(gas_names(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + enddo + do ij=1,nminorabsorbers + call MPI_BCAST(gas_minor(ij), len(gas_minor(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + call MPI_BCAST(identifier_minor(ij), len(identifier_minor(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + enddo + do ij=1,nminor_absorber_intervals_lower + call MPI_BCAST(minor_gases_lower(ij), len(minor_gases_lower(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + enddo + do ij=1,nminor_absorber_intervals_upper + call MPI_BCAST(minor_gases_upper(ij), len(minor_gases_upper(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + enddo + ! Logical arrays + ! + call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, ierr) + call MPI_BARRIER(mpicomm, ierr) +#endif ! Initialize gas concentrations and gas optics class with data do iGas=1,rrtmgp_nGases diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index fc6e804cb..c8f43d139 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -116,7 +116,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas) ! Read dimensions for k-distribution fields (only on master processor(0)) -! if (mpirank .eq. mpiroot) then + if (mpirank .eq. mpiroot) then if(nf90_open(trim(sw_gas_props_file), NF90_WRITE, ncid_sw) .eq. NF90_NOERR) then status = nf90_inq_dimid(ncid_sw, 'temperature', dimid) status = nf90_inquire_dimension(ncid_sw, dimid, len=ntemps_sw) @@ -148,27 +148,27 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp status = nf90_inquire_dimension(ncid_sw, dimid, len=nminor_absorber_intervals_upper_sw) status = nf90_close(ncid_sw) endif -! endif + endif ! Broadcast dimensions to all processors -!#ifdef MPI -! call MPI_BARRIER(mpicomm, ierr) -! call MPI_BCAST(ntemps_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(npress_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nabsorbers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nminorabsorbers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nextrabsorbers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nmixingfracs_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nlayers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nbnds_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ngpts_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(npairs_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ncontributors_lower_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ncontributors_upper_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nminor_absorber_intervals_lower_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nminor_absorber_intervals_upper_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BARRIER(mpicomm, ierr) -!#endif +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) + call MPI_BCAST(ntemps_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(npress_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nabsorbers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nminorabsorbers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nextrabsorbers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nmixingfracs_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nlayers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nbnds_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(ngpts_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(npairs_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(ncontributors_lower_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(ncontributors_upper_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nminor_absorber_intervals_lower_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(nminor_absorber_intervals_upper_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BARRIER(mpicomm, ierr) +#endif ! Allocate space for arrays allocate(gas_names_sw(nabsorbers_sw)) @@ -204,7 +204,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp allocate(temp4(nminor_absorber_intervals_upper_sw)) ! On master processor, read in fields, broadcast to all processors -! if (mpirank .eq. mpiroot) then + if (mpirank .eq. mpiroot) then write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' ! Read in fields from file if(nf90_open(trim(sw_gas_props_file), NF90_WRITE, ncid_sw) .eq. NF90_NOERR) then @@ -310,73 +310,73 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp ! Close status = nf90_close(ncid_sw) endif -! endif + endif ! Broadcast arrays to all processors -!#ifdef MPI -! call MPI_BARRIER(mpicomm, ierr) -! if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave k-distribution data ... ' -! call MPI_BCAST(minor_limits_gpt_upper_sw, size(minor_limits_gpt_upper_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(minor_limits_gpt_lower_sw, size(minor_limits_gpt_lower_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_start_upper_sw, size(kminor_start_upper_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_start_lower_sw, size(kminor_start_lower_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(key_species_sw, size(key_species_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(band2gpt_sw, size(band2gpt_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) -!#ifndef SINGLE_PREC -! call MPI_BCAST(band_lims_sw, size(band_lims_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(press_ref_sw, size(press_ref_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_sw, size(temp_ref_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_lower_sw, size(kminor_lower_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_upper_sw, size(kminor_upper_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scaling_gas_lower_sw, size(scaling_gas_lower_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scaling_gas_upper_sw, size(scaling_gas_upper_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(vmr_ref_sw, size(vmr_ref_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kmajor_sw, size(kmajor_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_p_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_t_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(press_ref_trop_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(solar_source_sw, size(solar_source_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(rayl_lower_sw, size(rayl_lower_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(rayl_upper_sw, size(rayl_upper_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -!#else -! call MPI_BCAST(band_lims_sw, size(band_lims_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(press_ref_sw, size(press_ref_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_sw, size(temp_ref_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_lower_sw, size(kminor_lower_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kminor_upper_sw, size(kminor_upper_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scaling_gas_lower_sw, size(scaling_gas_lower_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scaling_gas_upper_sw, size(scaling_gas_upper_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(vmr_ref_sw, size(vmr_ref_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(kmajor_sw, size(kmajor_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_p_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(temp_ref_t_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(press_ref_trop_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(solar_source_sw, size(solar_source_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(rayl_lower_sw, size(rayl_lower_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(rayl_upper_sw, size(rayl_upper_sw), MPI_REAL, mpiroot, mpicomm, ierr) -!#endif -! ! Character arrays -! do ij=1,nabsorbers_sw -! call MPI_BCAST(gas_names_sw(ij), len(gas_names_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! enddo -! do ij=1,nminorabsorbers_sw -! call MPI_BCAST(gas_minor_sw(ij), len(gas_minor_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! call MPI_BCAST(identifier_minor_sw(ij), len(identifier_minor_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! enddo -! do ij=1,nminor_absorber_intervals_lower_sw -! call MPI_BCAST(minor_gases_lower_sw(ij), len(minor_gases_lower_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! enddo -! do ij=1,nminor_absorber_intervals_upper_sw -! call MPI_BCAST(minor_gases_upper_sw(ij), len(minor_gases_upper_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) -! enddo -! -! ! Logical arrays -! call MPI_BCAST(minor_scales_with_density_lower_sw, nminor_absorber_intervals_lower_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scale_by_complement_lower_sw, nminor_absorber_intervals_lower_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(minor_scales_with_density_upper_sw, nminor_absorber_intervals_upper_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(scale_by_complement_upper_sw, nminor_absorber_intervals_upper_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) -! call MPI_BARRIER(mpicomm, ierr) -!#endif +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) + if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave k-distribution data ... ' + call MPI_BCAST(minor_limits_gpt_upper_sw, size(minor_limits_gpt_upper_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(minor_limits_gpt_lower_sw, size(minor_limits_gpt_lower_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_start_upper_sw, size(kminor_start_upper_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_start_lower_sw, size(kminor_start_lower_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(key_species_sw, size(key_species_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) + call MPI_BCAST(band2gpt_sw, size(band2gpt_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) +#ifndef SINGLE_PREC + call MPI_BCAST(band_lims_sw, size(band_lims_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(press_ref_sw, size(press_ref_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_sw, size(temp_ref_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_lower_sw, size(kminor_lower_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_upper_sw, size(kminor_upper_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(scaling_gas_lower_sw, size(scaling_gas_lower_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(scaling_gas_upper_sw, size(scaling_gas_upper_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(vmr_ref_sw, size(vmr_ref_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(kmajor_sw, size(kmajor_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_p_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_t_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(press_ref_trop_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(solar_source_sw, size(solar_source_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(rayl_lower_sw, size(rayl_lower_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) + call MPI_BCAST(rayl_upper_sw, size(rayl_upper_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +#else + call MPI_BCAST(band_lims_sw, size(band_lims_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(press_ref_sw, size(press_ref_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_sw, size(temp_ref_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_lower_sw, size(kminor_lower_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(kminor_upper_sw, size(kminor_upper_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(scaling_gas_lower_sw, size(scaling_gas_lower_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(scaling_gas_upper_sw, size(scaling_gas_upper_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(vmr_ref_sw, size(vmr_ref_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(kmajor_sw, size(kmajor_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_p_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(temp_ref_t_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(press_ref_trop_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(solar_source_sw, size(solar_source_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(rayl_lower_sw, size(rayl_lower_sw), MPI_REAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(rayl_upper_sw, size(rayl_upper_sw), MPI_REAL, mpiroot, mpicomm, ierr) +#endif + ! Character arrays + do ij=1,nabsorbers_sw + call MPI_BCAST(gas_names_sw(ij), len(gas_names_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + enddo + do ij=1,nminorabsorbers_sw + call MPI_BCAST(gas_minor_sw(ij), len(gas_minor_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + call MPI_BCAST(identifier_minor_sw(ij), len(identifier_minor_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + enddo + do ij=1,nminor_absorber_intervals_lower_sw + call MPI_BCAST(minor_gases_lower_sw(ij), len(minor_gases_lower_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + enddo + do ij=1,nminor_absorber_intervals_upper_sw + call MPI_BCAST(minor_gases_upper_sw(ij), len(minor_gases_upper_sw(ij)), MPI_CHAR, mpiroot, mpicomm, ierr) + enddo + + ! Logical arrays + call MPI_BCAST(minor_scales_with_density_lower_sw, nminor_absorber_intervals_lower_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(scale_by_complement_lower_sw, nminor_absorber_intervals_lower_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(minor_scales_with_density_upper_sw, nminor_absorber_intervals_upper_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) + call MPI_BCAST(scale_by_complement_upper_sw, nminor_absorber_intervals_upper_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) + call MPI_BARRIER(mpicomm, ierr) +#endif ! Initialize gas concentrations and gas optics class with data do iGas=1,rrtmgp_nGases