Skip to content

Commit

Permalink
Turned MPI on for rrtmgp gas-optics
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Dec 13, 2019
1 parent 1943d14 commit 9ec9667
Showing 1 changed file with 92 additions and 91 deletions.
183 changes: 92 additions & 91 deletions physics/rrtmgp_lw_gas_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,9 +21,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp
active_gases_array, mpicomm, mpirank, mpiroot, lw_gas_props, ipsdlw0, errmsg, errflg)
use netcdf

!#ifdef MPI
! use mpi
!#endif
#ifdef MPI
use mpi
#endif

! Inputs
character(len=128),intent(in) :: &
Expand Down Expand Up @@ -115,9 +115,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
integer,parameter :: max_strlen=256
!#ifdef MPI
! integer :: ierr
!#endif
#ifdef MPI
integer :: ierr
#endif

! Initialize
errmsg = ''
Expand All @@ -127,7 +127,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)
Expand Down Expand Up @@ -161,27 +161,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)
!#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))
Expand Down Expand Up @@ -215,7 +216,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
Expand Down Expand Up @@ -318,72 +319,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)
! 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
! Broadcast arrays to all processors
#ifdef MPI
call MPI_BARRIER(mpicomm, ierr)
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
Expand Down

0 comments on commit 9ec9667

Please sign in to comment.