Skip to content

Commit

Permalink
Revert to original mpi_bcast for character arrays.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Dec 9, 2019
1 parent 0a726fd commit 229ca59
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 18 deletions.
23 changes: 14 additions & 9 deletions physics/rrtmgp_lw_gas_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,6 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr

! Dimensions (to be broadcast across all processors)
integer :: &
str_len, & !
ntemps, & !
npress, & !
ngpts_lw, & !
Expand Down Expand Up @@ -298,9 +297,6 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr
!
status = nf90_inq_varid(ncid_lw,'plank_fraction',varID)
status = nf90_get_var(ncid_lw,varID,planck_frac)
!
status = nf90_inq_varid(ncid_lw,'str_len',varID)
status = nf90_get_var(ncid_lw,varID,str_len)

! Logical fields are read in as integers and then converted to logicals.
status = nf90_inq_varid(ncid_lw,'minor_scales_with_density_lower',varID)
Expand Down Expand Up @@ -374,12 +370,21 @@ subroutine rrtmgp_lw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, lw_gas_pr
call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, ierr)
#endif
! Character arrays
call MPI_BCAST(gas_names, size(gas_names)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
call MPI_BCAST(gas_minor, size(gas_minor)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
call MPI_BCAST(identifier_minor, size(identifier_minor)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
call MPI_BCAST(minor_gases_lower, size(minor_gases_lower)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
call MPI_BCAST(minor_gases_upper, size(minor_gases_upper)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
do ij=1,nabsorbers
call MPI_BCAST(gas_names(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr)
enddo
do ij=1,nminorabsorbers
call MPI_BCAST(gas_minor(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr)
call MPI_BCAST(identifier_minor(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr)
enddo
do ij=1,nminor_absorber_intervals_lower
call MPI_BCAST(minor_gases_lower(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr)
enddo
do ij=1,nminor_absorber_intervals_upper
call MPI_BCAST(minor_gases_upper(ij), 32, 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)
Expand Down
24 changes: 15 additions & 9 deletions physics/rrtmgp_sw_gas_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,6 @@ subroutine rrtmgp_sw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, sw_gas_p
scale_by_complement_upper_sw !
! Dimensions (to be broadcast across all processors)
integer :: &
str_len, & !
ntemps_sw, & !
npress_sw, & !
ngpts_sw, & !
Expand Down Expand Up @@ -151,8 +150,6 @@ subroutine rrtmgp_sw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, sw_gas_p
status = nf90_inquire_dimension(ncid_sw, dimid, len=nminor_absorber_intervals_lower_sw)
status = nf90_inq_dimid(ncid_sw, 'minor_absorber_intervals_upper', dimid)
status = nf90_inquire_dimension(ncid_sw, dimid, len=nminor_absorber_intervals_upper_sw)
status = nf90_inq_varid(ncid_lw,'str_len',varID)
status = nf90_get_var(ncid_lw,varID,str_len)
status = nf90_close(ncid_sw)
endif
endif
Expand Down Expand Up @@ -373,13 +370,22 @@ subroutine rrtmgp_sw_gas_optics_init(Model, mpicomm, mpirank, mpiroot, sw_gas_p
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
call MPI_BCAST(gas_names_sw, size(gas_names_sw)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
call MPI_BCAST(gas_minor_sw, size(gas_minor_sw)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
call MPI_BCAST(identifier_minor_sw, size(identifier_minor_sw)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
call MPI_BCAST(minor_gases_lower_sw, size(minor_gases_lower_sw)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
call MPI_BCAST(minor_gases_upper_sw, size(minor_gases_upper_sw)*str_len, MPI_CHAR, mpiroot, mpicomm, ierr)
! Character arrays
do ij=1,nabsorbers_sw
call MPI_BCAST(gas_names_sw(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr)
enddo
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
do ij=1,nminor_absorber_intervals_lower_sw
call MPI_BCAST(minor_gases_lower_sw(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr)
enddo
do ij=1,nminor_absorber_intervals_upper_sw
call MPI_BCAST(minor_gases_upper_sw(ij), 32, 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)
Expand Down

0 comments on commit 229ca59

Please sign in to comment.