diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 821135b4f..f8849c43b 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -136,6 +136,11 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou endif endif + ! Sync processes before broadcasting +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) +#endif + ! Broadcast dimensions to all processors #ifdef MPI if (Model%rrtmgp_cld_optics .eq. 1 .or. Model%rrtmgp_cld_optics .eq. 2) then @@ -180,6 +185,7 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou if (mpirank .eq. mpiroot) then ! if (Model%rrtmgp_cld_optics .eq. 1) then + write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' ! if(nf90_open(trim(lw_cloud_props_file), NF90_WRITE, ncid_lw_clds) == NF90_NOERR) then status = nf90_inq_varid(ncid_lw_clds,'radliq_lwr',varID) @@ -213,6 +219,7 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou endif ! if (Model%rrtmgp_cld_optics .eq. 2) then + write (*,*) 'Reading RRTMGP longwave cloud data (PADE) ... ' ! if(nf90_open(trim(lw_cloud_props_file), NF90_WRITE, ncid_lw_clds) == NF90_NOERR) then status = nf90_inq_varid(ncid_lw_clds,'radliq_lwr',varID) @@ -258,9 +265,15 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou endif endif + ! Sync processes before broadcasting +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) +#endif + ! Broadcast arrays to all processors #ifdef MPI if (Model%rrtmgp_cld_optics .eq. 1) then + write (*,*) 'Broadcasting RRTMGP longwave cloud data (LUT) ... ' #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) @@ -292,6 +305,7 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou #endif endif if (Model%rrtmgp_cld_optics .eq. 2) then + write (*,*) 'Broadcasting RRTMGP longwave cloud data (PADE) ... ' #ifndef SINGLE_PREC call MPI_BCAST(pade_extliq, size(pade_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index b8e4ca145..fc4f06115 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -161,6 +161,11 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr status = nf90_close(ncid_lw) endif endif + + ! Sync processes before broadcasting +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) +#endif ! Broadcast dimensions to all processors #ifdef MPI @@ -215,6 +220,7 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr allocate(planck_frac(ngpts_lw, nmixingfracs, npress+1, ntemps)) 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 status = nf90_inq_varid(ncid_lw,'gas_names',varID) @@ -318,8 +324,14 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr endif endif + ! Sync processes before broadcasting +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) +#endif + ! Broadcast arrays to all processors #ifdef MPI + 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) diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 54696cb54..64b937b8d 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -133,6 +133,11 @@ subroutine rrtmgp_sw_cloud_optics_init(Model,mpicomm, mpirank, mpiroot, sw_cloud endif endif + ! Sync processes before broadcasting +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) +#endif + ! Broadcast dimensions to all processors #ifdef MPI if (Model%rrtmgp_cld_optics .eq. 1 .or. Model%rrtmgp_cld_optics .eq. 2) then @@ -177,6 +182,7 @@ subroutine rrtmgp_sw_cloud_optics_init(Model,mpicomm, mpirank, mpiroot, sw_cloud if (mpirank .eq. mpiroot) then ! if (Model%rrtmgp_cld_optics .eq. 1) then + write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' ! if(nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid_sw_clds) == NF90_NOERR) then status = nf90_inq_varid(ncid_sw_clds,'radliq_lwr',varID) @@ -210,6 +216,7 @@ subroutine rrtmgp_sw_cloud_optics_init(Model,mpicomm, mpirank, mpiroot, sw_cloud endif ! if (Model%rrtmgp_cld_optics .eq. 2) then + write (*,*) 'Reading RRTMGP shortwave cloud data (PADE) ... ' ! if(nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid_sw_clds) == NF90_NOERR) then status = nf90_inq_varid(ncid_sw_clds,'radliq_lwr',varID) @@ -255,9 +262,15 @@ subroutine rrtmgp_sw_cloud_optics_init(Model,mpicomm, mpirank, mpiroot, sw_cloud endif endif + ! Sync processes before broadcasting +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) +#endif + ! Broadcast arrays to all processors #ifdef MPI if (Model%rrtmgp_cld_optics .eq. 1) then + write (*,*) 'Broadcasting RRTMGP shortwave cloud data (LUT) ... ' #ifndef SINGLE_PREC call MPI_BCAST(radliq_lwr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) call MPI_BCAST(radliq_upr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) @@ -289,6 +302,7 @@ subroutine rrtmgp_sw_cloud_optics_init(Model,mpicomm, mpirank, mpiroot, sw_cloud #endif endif if (Model%rrtmgp_cld_optics .eq. 2) then + write (*,*) 'Broadcasting RRTMGP shortwave cloud data (PADE) ... ' #ifndef SINGLE_PREC call MPI_BCAST(pade_extliq_sw, size(pade_extliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) call MPI_BCAST(pade_ssaliq_sw, size(pade_ssaliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index a6a5a844b..4fa7070c9 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -153,41 +153,28 @@ subroutine rrtmgp_sw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, sw_gas_p status = nf90_close(ncid_sw) endif endif - - ! Broadcast dimensions to all processors + + ! Sync processes before broadcasting #ifdef MPI call MPI_BARRIER(mpicomm, ierr) - write(*,*) "ierr0a: ",ierr - write(*,*) "mpiroot: ",mpiroot - write(*,*) "mpicomm: ",mpicomm +#endif + + ! Broadcast dimensions to all processors +#ifdef MPI call MPI_BCAST(ntemps_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr1: ",ierr call MPI_BCAST(npress_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr2: ",ierr call MPI_BCAST(nabsorbers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr3: ",ierr call MPI_BCAST(nminorabsorbers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr4: ",ierr call MPI_BCAST(nextrabsorbers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr5: ",ierr call MPI_BCAST(nmixingfracs_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr6: ",ierr call MPI_BCAST(nlayers_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr7: ",ierr call MPI_BCAST(nbnds_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr8: ",ierr call MPI_BCAST(ngpts_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr9: ",ierr call MPI_BCAST(npairs_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr10: ",ierr call MPI_BCAST(ncontributors_lower_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr11: ",ierr call MPI_BCAST(ncontributors_upper_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr12: ",ierr call MPI_BCAST(nminor_absorber_intervals_lower_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr13: ",ierr call MPI_BCAST(nminor_absorber_intervals_upper_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr14: ",ierr #endif ! Allocate space for arrays @@ -223,6 +210,10 @@ subroutine rrtmgp_sw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, sw_gas_p allocate(temp3(nminor_absorber_intervals_lower_sw)) allocate(temp4(nminor_absorber_intervals_upper_sw)) +#ifdef MPI + call MPI_BARRIER(mpicomm, ierr) +#endif + ! On master processor, read in fields, broadcast to all processors if (mpirank .eq. mpiroot) then write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' @@ -332,114 +323,73 @@ subroutine rrtmgp_sw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, sw_gas_p endif endif - ! Broadcast arrays to all processors + ! Sync processes before broadcasting #ifdef MPI call MPI_BARRIER(mpicomm, ierr) - write(*,*) "ierr0b: ",ierr +#endif + + ! Broadcast arrays to all processors +#ifdef MPI 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) - write(*,*) "ierr15: ",ierr call MPI_BCAST(minor_limits_gpt_lower_sw, size(minor_limits_gpt_lower_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr16: ",ierr call MPI_BCAST(kminor_start_upper_sw, size(kminor_start_upper_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr17: ",ierr call MPI_BCAST(kminor_start_lower_sw, size(kminor_start_lower_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr18: ",ierr call MPI_BCAST(key_species_sw, size(key_species_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr19: ",ierr call MPI_BCAST(band2gpt_sw, size(band2gpt_sw), MPI_INTEGER, mpiroot, mpicomm, ierr) - write(*,*) "ierr20: ",ierr #ifndef SINGLE_PREC call MPI_BCAST(band_lims_sw, size(band_lims_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr21: ",ierr call MPI_BCAST(press_ref_sw, size(press_ref_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr22: ",ierr call MPI_BCAST(temp_ref_sw, size(temp_ref_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr23: ",ierr call MPI_BCAST(kminor_lower_sw, size(kminor_lower_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr24: ",ierr call MPI_BCAST(kminor_upper_sw, size(kminor_upper_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr25: ",ierr call MPI_BCAST(scaling_gas_lower_sw, size(scaling_gas_lower_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr26: ",ierr call MPI_BCAST(scaling_gas_upper_sw, size(scaling_gas_upper_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr27: ",ierr call MPI_BCAST(vmr_ref_sw, size(vmr_ref_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr28: ",ierr call MPI_BCAST(kmajor_sw, size(kmajor_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr29: ",ierr call MPI_BCAST(temp_ref_p_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr30: ",ierr call MPI_BCAST(temp_ref_t_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr31: ",ierr call MPI_BCAST(press_ref_trop_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr32: ",ierr call MPI_BCAST(solar_source_sw, size(solar_source_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr33: ",ierr call MPI_BCAST(rayl_lower_sw, size(rayl_lower_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr34: ",ierr call MPI_BCAST(rayl_upper_sw, size(rayl_upper_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - write(*,*) "ierr35: ",ierr #else call MPI_BCAST(band_lims_sw, size(band_lims_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr36: ",ierr call MPI_BCAST(press_ref_sw, size(press_ref_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr37: ",ierr call MPI_BCAST(temp_ref_sw, size(temp_ref_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr38: ",ierr call MPI_BCAST(kminor_lower_sw, size(kminor_lower_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr39: ",ierr call MPI_BCAST(kminor_upper_sw, size(kminor_upper_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr40: ",ierr call MPI_BCAST(scaling_gas_lower_sw, size(scaling_gas_lower_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr41: ",ierr call MPI_BCAST(scaling_gas_upper_sw, size(scaling_gas_upper_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr42: ",ierr call MPI_BCAST(vmr_ref_sw, size(vmr_ref_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr43: ",ierr call MPI_BCAST(kmajor_sw, size(kmajor_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr44: ",ierr call MPI_BCAST(temp_ref_p_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr45: ",ierr call MPI_BCAST(temp_ref_t_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr46: ",ierr call MPI_BCAST(press_ref_trop_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr47: ",ierr call MPI_BCAST(solar_source_sw, size(solar_source_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr48: ",ierr call MPI_BCAST(rayl_lower_sw, size(rayl_lower_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr49: ",ierr call MPI_BCAST(rayl_upper_sw, size(rayl_upper_sw), MPI_REAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr50: ",ierr #endif ! Character arrays do ij=1,nabsorbers_sw call MPI_BCAST(gas_names_sw(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) enddo - write(*,*) "ierr51: ",ierr do ij=1,nminorabsorbers_sw call MPI_BCAST(gas_minor_sw(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) call MPI_BCAST(identifier_minor_sw(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) enddo - write(*,*) "ierr52: ",ierr do ij=1,nminor_absorber_intervals_lower_sw call MPI_BCAST(minor_gases_lower_sw(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) enddo - write(*,*) "ierr53: ",ierr do ij=1,nminor_absorber_intervals_upper_sw call MPI_BCAST(minor_gases_upper_sw(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) enddo - write(*,*) "ierr54: ",ierr ! Logical arrays (First convert to integer-array, then broadcast) ! call MPI_BCAST(minor_scales_with_density_lower_sw, nminor_absorber_intervals_lower_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr55: ",ierr call MPI_BCAST(scale_by_complement_lower_sw, nminor_absorber_intervals_lower_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr56: ",ierr call MPI_BCAST(minor_scales_with_density_upper_sw, nminor_absorber_intervals_upper_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr57: ",ierr call MPI_BCAST(scale_by_complement_upper_sw, nminor_absorber_intervals_upper_sw, MPI_LOGICAL, mpiroot, mpicomm, ierr) - write(*,*) "ierr58: ",ierr #endif ! Initialize gas concentrations and gas optics class with data