Skip to content

Commit

Permalink
Removed MPI calls.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Dec 11, 2019
1 parent 6cdd545 commit b16c6c7
Show file tree
Hide file tree
Showing 4 changed files with 362 additions and 383 deletions.
192 changes: 91 additions & 101 deletions physics/rrtmgp_lw_cloud_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,9 +25,9 @@ module rrtmgp_lw_cloud_optics
! #########################################################################################
subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_cloud_props, &
errmsg, errflg)
#ifdef MPI
use mpi
#endif
!#ifdef MPI
! use mpi
!#endif

! Inputs
type(GFS_control_type), intent(in) :: &
Expand Down Expand Up @@ -93,9 +93,9 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou
integer :: dimID,varID,status,ncid_lw_clds
character(len=264) :: lw_cloud_props_file
integer,parameter :: max_strlen=256
#ifdef MPI
integer :: ierr
#endif
!#ifdef MPI
! integer :: ierr
!#endif

! Initialize
errmsg = ''
Expand All @@ -107,7 +107,7 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou
lw_cloud_props_file = trim(Model%rrtmgp_root)//trim(Model%lw_file_clouds)

! 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_cloud_props_file), NF90_WRITE, ncid_lw_clds) == NF90_NOERR) then
status = nf90_inq_dimid(ncid_lw_clds, 'nband', dimid)
status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=nbandLWcldy)
Expand All @@ -134,27 +134,22 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou
if (Model%rrtmgp_nrghice .gt. nrghice_lw) then
errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed'
endif
endif

! Sync processes before broadcasting
#ifdef MPI
call MPI_BARRIER(mpicomm, ierr)
#endif
! endif

! Broadcast dimensions to all processors
#ifdef MPI
if (Model%rrtmgp_cld_optics .eq. 1 .or. Model%rrtmgp_cld_optics .eq. 2) then
call MPI_BCAST(nbandLWcldy, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
call MPI_BCAST(nrghice_lw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
call MPI_BCAST(nsize_liq, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
call MPI_BCAST(nsize_ice, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
call MPI_BCAST(nsizereg, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
call MPI_BCAST(ncoeff_ext, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
call MPI_BCAST(ncoeff_ssa_g, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
call MPI_BCAST(nbound, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
call MPI_BCAST(npairsLWcldy, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
endif
#endif
! ! Broadcast dimensions to all processors
!#ifdef MPI
! if (Model%rrtmgp_cld_optics .eq. 1 .or. Model%rrtmgp_cld_optics .eq. 2) then
! call MPI_BCAST(nbandLWcldy, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
! call MPI_BCAST(nrghice_lw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
! call MPI_BCAST(nsize_liq, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
! call MPI_BCAST(nsize_ice, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
! call MPI_BCAST(nsizereg, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
! call MPI_BCAST(ncoeff_ext, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
! call MPI_BCAST(ncoeff_ssa_g, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
! call MPI_BCAST(nbound, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
! call MPI_BCAST(npairsLWcldy, 1, MPI_INTEGER, mpiroot, mpicomm, ierr)
! endif
!#endif

if (Model%rrtmgp_cld_optics .eq. 1) then
allocate(lut_extliq(nsize_liq, nBandLWcldy))
Expand Down Expand Up @@ -182,7 +177,7 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou
endif

! On master processor, allocate space, read in fields, broadcast to all processors
if (mpirank .eq. mpiroot) then
! if (mpirank .eq. mpiroot) then
!
if (Model%rrtmgp_cld_optics .eq. 1) then
write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... '
Expand Down Expand Up @@ -263,80 +258,75 @@ subroutine rrtmgp_lw_cloud_optics_init(Model, mpicomm, mpirank, mpiroot, lw_clou
status = nf90_close(ncid_lw_clds)
endif
endif
endif

! Sync processes before broadcasting
#ifdef MPI
call MPI_BARRIER(mpicomm, ierr)
#endif
! 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)
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)
call MPI_BCAST(lut_extice, size(lut_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
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(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)
call MPI_BCAST(lut_extice, size(lut_extice), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(lut_asyice, size(lut_asyice), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(band_lims_cldy , size(band_lims_cldy), MPI_REAL, mpiroot, mpicomm, ierr)
#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)
call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_extice, size(pade_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_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(pade_extliq, size(pade_extliq), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_extice, size(pade_extice), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_asyice), MPI_REAL, mpiroot, mpicomm, ierr)
call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_REAL, mpiroot, mpicomm, ierr)
#endif
endif
#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)
! 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)
! call MPI_BCAST(lut_extice, size(lut_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! 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(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)
! call MPI_BCAST(lut_extice, size(lut_extice), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(lut_asyice, size(lut_asyice), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(band_lims_cldy , size(band_lims_cldy), MPI_REAL, mpiroot, mpicomm, ierr)
!#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)
! call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_extice, size(pade_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_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(pade_extliq, size(pade_extliq), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_extice, size(pade_extice), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_asyice), MPI_REAL, mpiroot, mpicomm, ierr)
! call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_REAL, mpiroot, mpicomm, ierr)
!#endif
! endif
!#endif

! Load tables data for RRTMGP cloud-optics
if (Model%rrtmgp_cld_optics .eq. 1) then
Expand Down
Loading

0 comments on commit b16c6c7

Please sign in to comment.