From 3dfb4c9b21a9ac44e304ef8a593d1fa88846d49a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 10 Feb 2020 16:27:32 -0700 Subject: [PATCH] Cleaned up _init routines. --- physics/rrtmgp_lw_cloud_optics.F90 | 453 +++++++++++------------ physics/rrtmgp_lw_cloud_optics.meta | 2 +- physics/rrtmgp_lw_gas_optics.F90 | 261 +++++-------- physics/rrtmgp_sw_cloud_optics.F90 | 495 ++++++++++++------------- physics/rrtmgp_sw_cloud_optics.meta | 2 +- physics/rrtmgp_sw_gas_optics.F90 | 555 ++++++++++++---------------- 6 files changed, 785 insertions(+), 983 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 7e50f2a81..d12ccaa23 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -8,7 +8,7 @@ module rrtmgp_lw_cloud_optics use rrtmgp_aux, only: check_error_msg use netcdf #ifdef MPI - use mpi + use mpi #endif public rrtmgp_lw_cloud_optics_init, rrtmgp_lw_cloud_optics_run, rrtmgp_lw_cloud_optics_finalize @@ -24,8 +24,9 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) ! Inputs - integer, intent(in) :: & - nrghice, & ! Number of ice-roughness categories + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories + integer, intent(in) :: & cld_optics_scheme, & ! Cloud-optics scheme mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank @@ -55,7 +56,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d lut_extliq, & ! LUT shortwave liquid extinction coefficient lut_ssaliq, & ! LUT shortwave liquid single scattering albedo lut_asyliq, & ! LUT shortwave liquid asymmetry parameter - band_lims_cldy ! Beginning and ending wavenumber [cm -1] for each band + band_lims ! Beginning and ending wavenumber [cm -1] for each band real(kind_phys), dimension(:,:,:), allocatable :: & lut_extice, & ! LUT shortwave ice extinction coefficient lut_ssaice, & ! LUT shortwave ice single scattering albedo @@ -63,17 +64,17 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! cld_optics_scheme = 2 real(kind_phys), dimension(:), allocatable :: & pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction - ! coefficient for Pade interpolation + ! coefficient for Pade interpolation pade_sizereg_ssaliq, & ! Particle size regime boundaries for shortwave liquid single - ! scattering albedo for Pade interpolation + ! scattering albedo for Pade interpolation pade_sizereg_asyliq, & ! Particle size regime boundaries for shortwave liquid asymmetry - ! parameter for Pade interpolation + ! parameter for Pade interpolation pade_sizereg_extice, & ! Particle size regime boundaries for shortwave ice extinction - ! coefficient for Pade interpolation + ! coefficient for Pade interpolation pade_sizereg_ssaice, & ! Particle size regime boundaries for shortwave ice single - ! scattering albedo for Pade interpolation + ! scattering albedo for Pade interpolation pade_sizereg_asyice ! Particle size regime boundaries for shortwave ice asymmetry - ! parameter for Pade interpolation + ! parameter for Pade interpolation real(kind_phys), dimension(:,:,:), allocatable :: & pade_extliq, & ! PADE coefficients for shortwave liquid extinction pade_ssaliq, & ! PADE coefficients for shortwave liquid single scattering albedo @@ -84,15 +85,15 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d pade_asyice ! PADE coefficients for shortwave ice asymmetry parameter ! Dimensions integer :: & - nrghice_lw, nbandLWcldy, nsize_liq, nsize_ice, nsizereg,& - ncoeff_ext, ncoeff_ssa_g, nbound, npairsLWcldy + nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizeReg,& + nCoeff_ext, nCoeff_ssa_g, nBound, npairs ! Local variables - integer :: dimID,varID,status,ncid_lw_clds + integer :: dimID,varID,status,ncid character(len=264) :: lw_cloud_props_file integer,parameter :: max_strlen=256 #ifdef MPI - integer :: ierr + integer :: mpierr #endif ! Initialize @@ -104,247 +105,215 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! Filenames are set in the physics_nml lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) - ! Read dimensions for k-distribution fields (only on master processor(0)) -! 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) - status = nf90_inq_dimid(ncid_lw_clds, 'nrghice', dimid) - status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=nrghice_lw) - status = nf90_inq_dimid(ncid_lw_clds, 'nsize_liq', dimid) - status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=nsize_liq) - status = nf90_inq_dimid(ncid_lw_clds, 'nsize_ice', dimid) - status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=nsize_ice) - status = nf90_inq_dimid(ncid_lw_clds, 'nsizereg', dimid) - status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=nsizereg) - status = nf90_inq_dimid(ncid_lw_clds, 'ncoeff_ext', dimid) - status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=ncoeff_ext) - status = nf90_inq_dimid(ncid_lw_clds, 'ncoeff_ssa_g', dimid) - status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=ncoeff_ssa_g) - status = nf90_inq_dimid(ncid_lw_clds, 'nbound', dimid) - status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=nbound) - status = nf90_inq_dimid(ncid_lw_clds, 'pair', dimid) - status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=npairsLWcldy) - status = nf90_close(ncid_lw_clds) - endif - - ! Check to ensure that number of ice-roughness categories is feasible. - if (nrghice .gt. nrghice_lw) then - errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed' - endif -! endif + ! On master processor only... + if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(lw_cloud_props_file), NF90_WRITE, ncid) - ! Broadcast dimensions to all processors -!#ifdef MPI -! call MPI_BCAST(nbandSWcldy_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! if (cld_optics_scheme .eq. 1) then -! call MPI_BARRIER(mpicomm, ierr) -! call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nsize_liq_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nsize_ice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BARRIER(mpicomm, ierr) -! endif -! if (cld_optics_scheme .eq. 2) then -! call MPI_BARRIER(mpicomm, ierr) -! call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nsizereg_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ncoeff_ext_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ncoeff_ssa_g_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nbound_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BARRIER(mpicomm, ierr) -! endif -!#endif + ! Read dimensions + status = nf90_inq_dimid(ncid, 'nband', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBand) + status = nf90_inq_dimid(ncid, 'nrghice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfile) + status = nf90_inq_dimid(ncid, 'nsize_liq', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_liq) + status = nf90_inq_dimid(ncid, 'nsize_ice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_ice) + status = nf90_inq_dimid(ncid, 'nsizereg', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSizeReg) + status = nf90_inq_dimid(ncid, 'ncoeff_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ext) + status = nf90_inq_dimid(ncid, 'ncoeff_ssa_g', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_g) + status = nf90_inq_dimid(ncid, 'nbound', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBound) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=npairs) + status = nf90_close(ncid) - if (Cld_optics_scheme .eq. 1) then - allocate(lut_extliq(nsize_liq, nBandLWcldy)) - allocate(lut_ssaliq(nsize_liq, nBandLWcldy)) - allocate(lut_asyliq(nsize_liq, nBandLWcldy)) - allocate(lut_extice(nsize_ice, nBandLWcldy, nrghice_lw)) - allocate(lut_ssaice(nsize_ice, nBandLWcldy, nrghice_lw)) - allocate(lut_asyice(nsize_ice, nBandLWcldy, nrghice_lw)) - allocate(band_lims_cldy(2, nBandLWcldy)) - endif - if (Cld_optics_scheme .eq. 2) then - allocate(pade_extliq(nbandLWcldy, nsizereg, ncoeff_ext )) - allocate(pade_ssaliq(nbandLWcldy, nsizereg, ncoeff_ssa_g)) - allocate(pade_asyliq(nbandLWcldy, nsizereg, ncoeff_ssa_g)) - allocate(pade_extice(nbandLWcldy, nsizereg, ncoeff_ext, nrghice_lw)) - allocate(pade_ssaice(nbandLWcldy, nsizereg, ncoeff_ssa_g, nrghice_lw)) - allocate(pade_asyice(nbandLWcldy, nsizereg, ncoeff_ssa_g, nrghice_lw)) - allocate(pade_sizereg_extliq(nbound)) - allocate(pade_sizereg_ssaliq(nbound)) - allocate(pade_sizereg_asyliq(nbound)) - allocate(pade_sizereg_extice(nbound)) - allocate(pade_sizereg_ssaice(nbound)) - allocate(pade_sizereg_asyice(nbound)) - allocate(band_lims_cldy(2,nbandLWcldy)) - endif + ! Has the number of ice-roughnesses been provided from the namelist? + ! If not provided, use all categories in file (default) + if (nrghice .eq. 0) then + nrghice = nrghice_fromfile + endif + ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. + if (nrghice .gt. nrghice_fromfile) then + errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using nrghice from file...' + nrghice = nrghice_fromfile + endif - ! On master processor, allocate space, read in fields, broadcast to all processors -! if (mpirank .eq. mpiroot) then - if (Cld_optics_scheme .eq. 1) then + ! Allocate space for arrays + if (cld_optics_scheme .eq. 1) then + allocate(lut_extliq(nSize_liq, nBand)) + allocate(lut_ssaliq(nSize_liq, nBand)) + allocate(lut_asyliq(nSize_liq, nBand)) + allocate(lut_extice(nSize_ice, nBand, nrghice)) + allocate(lut_ssaice(nSize_ice, nBand, nrghice)) + allocate(lut_asyice(nSize_ice, nBand, nrghice)) + endif + if (cld_optics_scheme .eq. 2) then + allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) + allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice)) + allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_sizereg_extliq(nBound)) + allocate(pade_sizereg_ssaliq(nBound)) + allocate(pade_sizereg_asyliq(nBound)) + allocate(pade_sizereg_extice(nBound)) + allocate(pade_sizereg_ssaice(nBound)) + allocate(pade_sizereg_asyice(nBound)) + endif + allocate(band_lims(2,nBand)) + + ! Read in fields from file + if (cld_optics_scheme .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) - status = nf90_get_var(ncid_lw_clds,varID,radliq_lwr) - status = nf90_inq_varid(ncid_lw_clds,'radliq_upr',varID) - status = nf90_get_var(ncid_lw_clds,varID,radliq_upr) - status = nf90_inq_varid(ncid_lw_clds,'radliq_fac',varID) - status = nf90_get_var(ncid_lw_clds,varID,radliq_fac) - status = nf90_inq_varid(ncid_lw_clds,'radice_lwr',varID) - status = nf90_get_var(ncid_lw_clds,varID,radice_lwr) - status = nf90_inq_varid(ncid_lw_clds,'radice_upr',varID) - status = nf90_get_var(ncid_lw_clds,varID,radice_upr) - status = nf90_inq_varid(ncid_lw_clds,'radice_fac',varID) - status = nf90_get_var(ncid_lw_clds,varID,radice_fac) - status = nf90_inq_varid(ncid_lw_clds,'lut_extliq',varID) - status = nf90_get_var(ncid_lw_clds,varID,lut_extliq) - status = nf90_inq_varid(ncid_lw_clds,'lut_ssaliq',varID) - status = nf90_get_var(ncid_lw_clds,varID,lut_ssaliq) - status = nf90_inq_varid(ncid_lw_clds,'lut_asyliq',varID) - status = nf90_get_var(ncid_lw_clds,varID,lut_asyliq) - status = nf90_inq_varid(ncid_lw_clds,'lut_extice',varID) - status = nf90_get_var(ncid_lw_clds,varID,lut_extice) - status = nf90_inq_varid(ncid_lw_clds,'lut_ssaice',varID) - status = nf90_get_var(ncid_lw_clds,varID,lut_ssaice) - status = nf90_inq_varid(ncid_lw_clds,'lut_asyice',varID) - status = nf90_get_var(ncid_lw_clds,varID,lut_asyice) - status = nf90_inq_varid(ncid_lw_clds,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid_lw_clds,varID,band_lims_cldy) - status = nf90_close(ncid_lw_clds) - endif + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'lut_extliq',varID) + status = nf90_get_var(ncid,varID,lut_extliq) + status = nf90_inq_varid(ncid,'lut_ssaliq',varID) + status = nf90_get_var(ncid,varID,lut_ssaliq) + status = nf90_inq_varid(ncid,'lut_asyliq',varID) + status = nf90_get_var(ncid,varID,lut_asyliq) + status = nf90_inq_varid(ncid,'lut_extice',varID) + status = nf90_get_var(ncid,varID,lut_extice) + status = nf90_inq_varid(ncid,'lut_ssaice',varID) + status = nf90_get_var(ncid,varID,lut_ssaice) + status = nf90_inq_varid(ncid,'lut_asyice',varID) + status = nf90_get_var(ncid,varID,lut_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) endif - ! - if (Cld_optics_scheme .eq. 2) then + if (cld_optics_scheme .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) - status = nf90_get_var(ncid_lw_clds,varID,radliq_lwr) - status = nf90_inq_varid(ncid_lw_clds,'radliq_upr',varID) - status = nf90_get_var(ncid_lw_clds,varID,radliq_upr) - status = nf90_inq_varid(ncid_lw_clds,'radliq_fac',varID) - status = nf90_get_var(ncid_lw_clds,varID,radliq_fac) - status = nf90_inq_varid(ncid_lw_clds,'radice_lwr',varID) - status = nf90_get_var(ncid_lw_clds,varID,radice_lwr) - status = nf90_inq_varid(ncid_lw_clds,'radice_upr',varID) - status = nf90_get_var(ncid_lw_clds,varID,radice_upr) - status = nf90_inq_varid(ncid_lw_clds,'radice_fac',varID) - status = nf90_get_var(ncid_lw_clds,varID,radice_fac) - status = nf90_inq_varid(ncid_lw_clds,'pade_extliq',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_extliq) - status = nf90_inq_varid(ncid_lw_clds,'pade_ssaliq',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_ssaliq) - status = nf90_inq_varid(ncid_lw_clds,'pade_asyliq',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_asyliq) - status = nf90_inq_varid(ncid_lw_clds,'pade_extice',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_extice) - status = nf90_inq_varid(ncid_lw_clds,'pade_ssaice',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_ssaice) - status = nf90_inq_varid(ncid_lw_clds,'pade_asyice',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_asyice) - status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_extliq',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_extliq) - status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_ssaliq',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_ssaliq) - status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_asyliq',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_asyliq) - status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_extice',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_extice) - status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_ssaice',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_ssaice) - status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_asyice',varID) - status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_asyice) - status = nf90_inq_varid(ncid_lw_clds,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid_lw_clds,varID,band_lims_cldy) - status = nf90_close(ncid_lw_clds) - endif + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'pade_extliq',varID) + status = nf90_get_var(ncid,varID,pade_extliq) + status = nf90_inq_varid(ncid,'pade_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_ssaliq) + status = nf90_inq_varid(ncid,'pade_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_asyliq) + status = nf90_inq_varid(ncid,'pade_extice',varID) + status = nf90_get_var(ncid,varID,pade_extice) + status = nf90_inq_varid(ncid,'pade_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_ssaice) + status = nf90_inq_varid(ncid,'pade_asyice',varID) + status = nf90_get_var(ncid,varID,pade_asyice) + status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extliq) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaliq) + status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyliq) + status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extice) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaice) + status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) endif -! endif + + ! Close file + status = nf90_close(ncid) + endif + +#ifdef MPI + if (cld_optics_scheme .eq. 1) then + ! Wait for processor 0 to catch up... + call MPI_BARRIER(mpicomm, mpierr) + + ! Broadcast data + write (*,*) 'Broadcasting RRTMGP longwave cloud-optics data ... ' + call MPI_BCAST(nBand, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nrghice, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nSize_liq, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nSize_ice, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radliq_lwr, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radliq_upr, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radliq_fac, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radice_lwr, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radice_upr, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radice_fac, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_extliq, size(lut_extliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_ssaliq, size(lut_ssaliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_asyliq, size(lut_asyliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_extice, size(lut_extice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_asyice, size(lut_asyice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) - ! Broadcast arrays to all processors -!#ifdef MPI -! if (cld_optics_scheme .eq. 1) then -! 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(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 -! call MPI_BARRIER(mpicomm, ierr) -! endif -! if (cld_optics_scheme .eq. 2) then -! if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (PADE) ... ' -! call MPI_BARRIER(mpicomm, ierr) -!#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 -! call MPI_BARRIER(mpicomm, ierr) -! endif -!#endif + ! Don't advance until data broadcast complete on all processors + call MPI_BARRIER(mpicomm, mpierr) + endif + if (cld_optics_scheme .eq. 2) then + ! Wait for processor 0 to catch up... + call MPI_BARRIER(mpicomm, mpierr) + + ! Broadcast data + write (*,*) 'Broadcasting RRTMGP longwave cloud-optics data ... ' + call MPI_BCAST(nBand, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nrghice, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nSizeReg, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nCoeff_ext, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nCoeff_ssa_g, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nBound, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_extliq, size(pade_extliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_extice, size(pade_extice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_asyice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) + + ! Don't advance until data broadcast complete on all processors + call MPI_BARRIER(mpicomm, mpierr) + endif +#endif ! Load tables data for RRTMGP cloud-optics if (cld_optics_scheme .eq. 1) then call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) - call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims_cldy, & + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, & radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) endif if (cld_optics_scheme .eq. 2) then - call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) - call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims_cldy, & - pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, & - pade_asyice, pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq,& + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%set_ice_roughness(nrghice)) + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, & + pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& + pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) endif end subroutine rrtmgp_lw_cloud_optics_init @@ -463,12 +432,6 @@ subroutine rrtmgp_lw_cloud_optics_finalize(mpicomm, mpirank, mpiroot) mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank - ! Local variables - integer :: ierr - -#ifdef MPI - call MPI_BARRIER(mpicomm, ierr) -#endif end subroutine rrtmgp_lw_cloud_optics_finalize end module rrtmgp_lw_cloud_optics diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 47fb602c0..bae5ef74f 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -15,7 +15,7 @@ units = count dimensions = () type = integer - intent = in + intent = inout optional = F [rrtmgp_root_dir] standard_name = directory_for_rte_rrtmgp_source_code diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 3a528ef25..440b40242 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -95,7 +95,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ! Dimensions integer :: & - ntemps, npress, ngpts_lw, nabsorbers, nextrabsorbers, nminorabsorbers,& + ntemps, npress, ngpts, nabsorbers, nextrabsorbers, nminorabsorbers,& nmixingfracs, nlayers, nbnds, npairs, ninternalSourcetemps, & nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & ncontributors_lower, ncontributors_upper @@ -113,46 +113,46 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp errmsg = '' errflg = 0 - write(*,"(a19,3i20)") 'RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm + write(*,"(a52,3i20)") 'rrtmgp_lw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm ! Filenames are set in the physics_nml lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) ! On master processor only... if (mpirank .eq. mpiroot) then - ! Opne file + ! Open file status = nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid) ! Read dimensions for k-distribution fields - status = nf90_inq_dimid( ncid, 'temperature', dimid) + status = nf90_inq_dimid(ncid, 'temperature', dimid) status = nf90_inquire_dimension(ncid, dimid, len = ntemps) - status = nf90_inq_dimid( ncid, 'pressure', dimid) + status = nf90_inq_dimid(ncid, 'pressure', dimid) status = nf90_inquire_dimension(ncid, dimid, len = npress) - status = nf90_inq_dimid( ncid, 'absorber', dimid) + status = nf90_inq_dimid(ncid, 'absorber', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nabsorbers) - status = nf90_inq_dimid( ncid, 'minor_absorber', dimid) + status = nf90_inq_dimid(ncid, 'minor_absorber', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nminorabsorbers) - status = nf90_inq_dimid( ncid, 'absorber_ext', dimid) + status = nf90_inq_dimid(ncid, 'absorber_ext', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nextrabsorbers) - status = nf90_inq_dimid( ncid, 'mixing_fraction', dimid) + status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nmixingfracs) - status = nf90_inq_dimid( ncid, 'atmos_layer', dimid) + status = nf90_inq_dimid(ncid, 'atmos_layer', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nlayers) - status = nf90_inq_dimid( ncid, 'bnd', dimid) + status = nf90_inq_dimid(ncid, 'bnd', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nbnds) - status = nf90_inq_dimid( ncid, 'gpt', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = ngpts_lw) - status = nf90_inq_dimid( ncid, 'pair', dimid) + status = nf90_inq_dimid(ncid, 'gpt', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ngpts) + status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len = npairs) - status = nf90_inq_dimid( ncid, 'contributors_lower', dimid) + status = nf90_inq_dimid(ncid, 'contributors_lower', dimid) status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_lower) - status = nf90_inq_dimid( ncid, 'contributors_upper', dimid) + status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_upper) - status = nf90_inq_dimid( ncid, 'minor_absorber_intervals_lower', dimid) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_lower) - status = nf90_inq_dimid( ncid, 'minor_absorber_intervals_upper', dimid) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_upper) - status = nf90_inq_dimid( ncid, 'temperature_Planck', dimid) + status = nf90_inq_dimid(ncid, 'temperature_Planck', dimid) status = nf90_inquire_dimension(ncid, dimid, len = ninternalSourcetemps) ! Allocate space for arrays @@ -172,7 +172,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp allocate(temp_ref(ntemps)) allocate(vmr_ref(nlayers, nextrabsorbers, ntemps)) allocate(kminor_lower(ncontributors_lower, nmixingfracs, ntemps)) - allocate(kmajor(ngpts_lw, nmixingfracs, npress+1, ntemps)) + allocate(kmajor(ngpts, nmixingfracs, npress+1, ntemps)) allocate(kminor_start_lower(nminor_absorber_intervals_lower)) allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) allocate(kminor_start_upper(nminor_absorber_intervals_upper)) @@ -185,75 +185,75 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp allocate(temp3(nminor_absorber_intervals_lower)) allocate(temp4(nminor_absorber_intervals_upper)) allocate(totplnk(ninternalSourcetemps, nbnds)) - allocate(planck_frac(ngpts_lw, nmixingfracs, npress+1, ntemps)) + allocate(planck_frac(ngpts, nmixingfracs, npress+1, ntemps)) ! Read in fields from file write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' - status = nf90_inq_varid(ncid, 'gas_names', varID) + status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_names) - status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) + status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) status = nf90_get_var( ncid, varID, scaling_gas_lower) - status = nf90_inq_varid(ncid, 'scaling_gas_upper', varID) + status = nf90_inq_varid(ncid, 'scaling_gas_upper', varID) status = nf90_get_var( ncid, varID, scaling_gas_upper) - status = nf90_inq_varid(ncid, 'gas_minor', varID) + status = nf90_inq_varid(ncid, 'gas_minor', varID) status = nf90_get_var( ncid, varID, gas_minor) - status = nf90_inq_varid(ncid, 'identifier_minor', varID) + status = nf90_inq_varid(ncid, 'identifier_minor', varID) status = nf90_get_var( ncid, varID, identifier_minor) - status = nf90_inq_varid(ncid, 'minor_gases_lower', varID) + status = nf90_inq_varid(ncid, 'minor_gases_lower', varID) status = nf90_get_var( ncid, varID, minor_gases_lower) - status = nf90_inq_varid(ncid, 'minor_gases_upper', varID) + status = nf90_inq_varid(ncid, 'minor_gases_upper', varID) status = nf90_get_var( ncid, varID, minor_gases_upper) - status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varID) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varID) status = nf90_get_var( ncid, varID, minor_limits_gpt_lower) - status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varID) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varID) status = nf90_get_var( ncid, varID, minor_limits_gpt_upper) - status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varID) + status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varID) status = nf90_get_var( ncid, varID, band2gpt) - status = nf90_inq_varid(ncid, 'key_species', varID) + status = nf90_inq_varid(ncid, 'key_species', varID) status = nf90_get_var( ncid, varID, key_species) - status = nf90_inq_varid(ncid, 'bnd_limits_wavenumber', varID) + status = nf90_inq_varid(ncid, 'bnd_limits_wavenumber', varID) status = nf90_get_var( ncid, varID, band_lims) - status = nf90_inq_varid(ncid, 'press_ref', varID) + status = nf90_inq_varid(ncid, 'press_ref', varID) status = nf90_get_var( ncid, varID, press_ref) - status = nf90_inq_varid(ncid, 'temp_ref', varID) + status = nf90_inq_varid(ncid, 'temp_ref', varID) status = nf90_get_var( ncid, varID, temp_ref) - status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P',varID) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) status = nf90_get_var( ncid, varID, temp_ref_p) - status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T',varID) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) status = nf90_get_var( ncid, varID, temp_ref_t) - status = nf90_inq_varid(ncid, 'press_ref_trop', varID) + status = nf90_inq_varid(ncid, 'press_ref_trop', varID) status = nf90_get_var( ncid, varID, press_ref_trop) - status = nf90_inq_varid(ncid, 'kminor_lower', varID) + status = nf90_inq_varid(ncid, 'kminor_lower', varID) status = nf90_get_var( ncid, varID, kminor_lower) - status = nf90_inq_varid(ncid, 'kminor_upper', varID) + status = nf90_inq_varid(ncid, 'kminor_upper', varID) status = nf90_get_var( ncid, varID, kminor_upper) - status = nf90_inq_varid(ncid, 'vmr_ref', varID) + status = nf90_inq_varid(ncid, 'vmr_ref', varID) status = nf90_get_var( ncid, varID, vmr_ref) - status = nf90_inq_varid(ncid, 'kmajor', varID) + status = nf90_inq_varid(ncid, 'kmajor', varID) status = nf90_get_var( ncid, varID, kmajor) - status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) + status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) status = nf90_get_var( ncid, varID, kminor_start_lower) - status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) + status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) status = nf90_get_var( ncid, varID, kminor_start_upper) - status = nf90_inq_varid(ncid, 'totplnk', varID) + status = nf90_inq_varid(ncid, 'totplnk', varID) status = nf90_get_var( ncid, varID, totplnk) - status = nf90_inq_varid(ncid, 'plank_fraction', varID) + status = nf90_inq_varid(ncid, 'plank_fraction', varID) status = nf90_get_var( ncid, varID, planck_frac) ! Logical fields are read in as integers and then converted to logicals. - status = nf90_inq_varid(ncid, 'minor_scales_with_density_lower',varID) + status = nf90_inq_varid(ncid, 'minor_scales_with_density_lower', varID) status = nf90_get_var( ncid, varID,temp1) minor_scales_with_density_lower(:) = .false. where(temp1 .eq. 1) minor_scales_with_density_lower(:) = .true. - status = nf90_inq_varid(ncid, 'minor_scales_with_density_upper',varID) + status = nf90_inq_varid(ncid, 'minor_scales_with_density_upper', varID) status = nf90_get_var( ncid, varID,temp2) minor_scales_with_density_upper(:) = .false. where(temp2 .eq. 1) minor_scales_with_density_upper(:) = .true. - status = nf90_inq_varid(ncid, 'scale_by_complement_lower', varID) + status = nf90_inq_varid(ncid, 'scale_by_complement_lower', varID) status = nf90_get_var( ncid, varID,temp3) scale_by_complement_lower(:) = .false. where(temp3 .eq. 1) scale_by_complement_lower(:) = .true. - status = nf90_inq_varid(ncid, 'scale_by_complement_upper', varID) + status = nf90_inq_varid(ncid, 'scale_by_complement_upper', varID) status = nf90_get_var( ncid, varID,temp4) scale_by_complement_upper(:) = .false. where(temp4 .eq. 1) scale_by_complement_upper(:) = .true. @@ -263,128 +263,66 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp endif #ifdef MPI -! if (mpirank .ne. mpiroot) then ! Wait for processor 0 to catch up... call MPI_BARRIER(mpicomm, mpierr) ! Broadcast data write (*,*) 'Broadcasting RRTMGP longwave k-distribution data ... ' - call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 1 ',mpierr, mpicomm - call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 2 ',mpierr, mpicomm - call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 3 ',mpierr, mpicomm - call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 4 ',mpierr, mpicomm - call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 5 ',mpierr, mpicomm - call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 6 ',mpierr, mpicomm - call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 7 ',mpierr, mpicomm - call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 8 ',mpierr, mpicomm - call MPI_BCAST(ngpts_lw, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 9 ',mpierr, mpicomm - call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 10 ',mpierr, mpicomm - call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 11 ',mpierr, mpicomm - call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 12 ',mpierr, mpicomm - call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 13 ',mpierr, mpicomm - call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 14 ',mpierr, mpicomm - call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 15 ',mpierr, mpicomm - call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 16 ',mpierr, mpicomm - call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 17 ',mpierr, mpicomm - call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 18 ',mpierr, mpicomm - call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 19 ',mpierr, mpicomm - call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 20 ',mpierr, mpicomm - call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 21 ',mpierr, mpicomm - call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 22 ',mpierr, mpicomm - call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 23 ',mpierr, mpicomm - call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 24 ',mpierr, mpicomm - call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 25 ',mpierr, mpicomm - call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 26 ',mpierr, mpicomm - call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 27 ',mpierr, mpicomm - call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 28 ',mpierr, mpicomm - call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 29 ',mpierr, mpicomm - call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 30 ',mpierr, mpicomm - call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 31 ',mpierr, mpicomm - call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 32 ',mpierr, mpicomm - call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 33 ',mpierr, mpicomm - call MPI_BCAST(totplnk, size(totplnk), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 34 ',mpierr, mpicomm - call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 35 ',mpierr, mpicomm - ! Character arrays - !do ij=1,nabsorbers - ! call MPI_BCAST(gas_names(ij), len(gas_names(ij)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - !enddo - call MPI_BCAST(gas_names, size(gas_names), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 36 ',mpierr, mpicomm - !do ij=1,nminorabsorbers - ! call MPI_BCAST(gas_minor(ij), len(gas_minor(ij)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - !enddo - call MPI_BCAST(gas_minor, size(gas_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 37 ',mpierr, mpicomm - !do ij=1,nminorabsorbers - ! call MPI_BCAST(identifier_minor(ij), len(identifier_minor(ij)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - !enddo - call MPI_BCAST(identifier_minor, size(identifier_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 38 ',mpierr, mpicomm - !do ij=1,nminor_absorber_intervals_lower - ! call MPI_BCAST(minor_gases_lower(ij), len(minor_gases_lower(ij)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - !enddo - call MPI_BCAST(minor_gases_lower, size(minor_gases_lower), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 39 ',mpierr, mpicomm - !do ij=1,nminor_absorber_intervals_upper - ! call MPI_BCAST(minor_gases_upper(ij), len(minor_gases_upper(ij)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - !enddo - call MPI_BCAST(minor_gases_upper, size(minor_gases_upper), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 40 ',mpierr, mpicomm - ! Logical arrays - call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 41 ',mpierr, mpicomm - call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 42 ',mpierr, mpicomm - call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 43 ',mpierr, mpicomm - call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - write(*,*) 'Broadcasting 44 ',mpierr, mpicomm + call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ngpts, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(totplnk, size(totplnk), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(gas_names, size(gas_names), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(gas_minor, size(gas_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(identifier_minor, size(identifier_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_gases_lower, size(minor_gases_lower), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_gases_upper, size(minor_gases_upper), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + ! Don't advance until data broadcast complete on all processors call MPI_BARRIER(mpicomm, mpierr) - write(*,*) 'Broadcasting 45 ',mpierr, mpicomm #endif - ! Initialize gas concentrations and gas optics class with data + ! Initialize gas concentrations and gas optics class do iGas=1,rrtmgp_nGases call check_error_msg('lw_gas_optics_init',gas_concentrations%set_vmr(active_gases_array(iGas), 0._kind_phys)) enddo call check_error_msg('lw_gas_optics_init',lw_gas_props%load(gas_concentrations, gas_names, & key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & - temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor,identifier_minor, & + temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & @@ -436,10 +374,9 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ if (.not. doLWrad) return - ! Allocate space + ! Allocate and initialize call check_error_msg('rrtmgp_lw_gas_optics_run',lw_optical_props_clrsky%alloc_1scl(ncol, nLev, lw_gas_props)) - call check_error_msg('rrtmgp_lw_gas_optics_run',sources%init(lw_gas_props)) - call check_error_msg('rrtmgp_lw_gas_optics_run',sources%alloc(ncol, nLev)) + call check_error_msg('rrtmgp_lw_gas_optics_run',sources%alloc(ncol, nLev, lw_gas_props)) ! Gas-optics call check_error_msg('rrtmgp_lw_gas_optics_run',lw_gas_props%gas_optics(& diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index ab0ad497b..87aa27df9 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -8,9 +8,12 @@ module rrtmgp_sw_cloud_optics use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics use rrtmgp_aux, only: check_error_msg use netcdf +#ifdef MPI + use mpi +#endif + public rrtmgp_sw_cloud_optics_init, rrtmgp_sw_cloud_optics_run, rrtmgp_sw_cloud_optics_finalize contains - ! ######################################################################################### ! SUBROUTINE sw_cloud_optics_init ! ######################################################################################### @@ -19,14 +22,11 @@ module rrtmgp_sw_cloud_optics !! subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props, errmsg, errflg) - use netcdf -!#ifdef MPI -! use mpi -!#endif ! Inputs + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories integer, intent(in) :: & - nrghice, & ! Number of ice-roughness categories cld_optics_scheme, & ! Cloud-optics scheme mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank @@ -46,53 +46,53 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! Variables that will be passed to cloud_optics%load() ! cld_optics_scheme = 1 real(kind_phys) :: & - radliq_lwr_sw, & ! Liquid particle size lower bound for LUT interpolation - radliq_upr_sw, & ! Liquid particle size upper bound for LUT interpolation - radliq_fac_sw, & ! Factor for calculating LUT interpolation indices for liquid - radice_lwr_sw, & ! Ice particle size upper bound for LUT interpolation - radice_upr_sw, & ! Ice particle size lower bound for LUT interpolation - radice_fac_sw ! Factor for calculating LUT interpolation indices for ice + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr, & ! Ice particle size lower bound for LUT interpolation + radice_fac ! Factor for calculating LUT interpolation indices for ice real(kind_phys), dimension(:,:), allocatable :: & - lut_extliq_sw, & ! LUT shortwave liquid extinction coefficient - lut_ssaliq_sw, & ! LUT shortwave liquid single scattering albedo - lut_asyliq_sw, & ! LUT shortwave liquid asymmetry parameter - band_lims_cldy_sw ! Beginning and ending wavenumber [cm -1] for each band + lut_extliq, & ! LUT shortwave liquid extinction coefficient + lut_ssaliq, & ! LUT shortwave liquid single scattering albedo + lut_asyliq, & ! LUT shortwave liquid asymmetry parameter + band_lims ! Beginning and ending wavenumber [cm -1] for each band real(kind_phys), dimension(:,:,:), allocatable :: & - lut_extice_sw, & ! LUT shortwave ice extinction coefficient - lut_ssaice_sw, & ! LUT shortwave ice single scattering albedo - lut_asyice_sw ! LUT shortwave ice asymmetry parameter + lut_extice, & ! LUT shortwave ice extinction coefficient + lut_ssaice, & ! LUT shortwave ice single scattering albedo + lut_asyice ! LUT shortwave ice asymmetry parameter ! cld_optics_scheme = 2 real(kind_phys), dimension(:), allocatable :: & - pade_sizereg_extliq_sw, & ! Particle size regime boundaries for shortwave liquid extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaliq_sw, & ! Particle size regime boundaries for shortwave liquid single - ! scattering albedo for Pade interpolation - pade_sizereg_asyliq_sw, & ! Particle size regime boundaries for shortwave liquid asymmetry - ! parameter for Pade interpolation - pade_sizereg_extice_sw, & ! Particle size regime boundaries for shortwave ice extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaice_sw, & ! Particle size regime boundaries for shortwave ice single - ! scattering albedo for Pade interpolation - pade_sizereg_asyice_sw ! Particle size regime boundaries for shortwave ice asymmetry - ! parameter for Pade interpolation + pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaliq, & ! Particle size regime boundaries for shortwave liquid single + ! scattering albedo for Pade interpolation + pade_sizereg_asyliq, & ! Particle size regime boundaries for shortwave liquid asymmetry + ! parameter for Pade interpolation + pade_sizereg_extice, & ! Particle size regime boundaries for shortwave ice extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaice, & ! Particle size regime boundaries for shortwave ice single + ! scattering albedo for Pade interpolation + pade_sizereg_asyice ! Particle size regime boundaries for shortwave ice asymmetry + ! parameter for Pade interpolation real(kind_phys), dimension(:,:,:), allocatable :: & - pade_extliq_sw, & ! PADE coefficients for shortwave liquid extinction - pade_ssaliq_sw, & ! PADE coefficients for shortwave liquid single scattering albedo - pade_asyliq_sw ! PADE coefficients for shortwave liquid asymmetry parameter + pade_extliq, & ! PADE coefficients for shortwave liquid extinction + pade_ssaliq, & ! PADE coefficients for shortwave liquid single scattering albedo + pade_asyliq ! PADE coefficients for shortwave liquid asymmetry parameter real(kind_phys), dimension(:,:,:,:), allocatable :: & - pade_extice_sw, & ! PADE coefficients for shortwave ice extinction - pade_ssaice_sw, & ! PADE coefficients for shortwave ice single scattering albedo - pade_asyice_sw ! PADE coefficients for shortwave ice asymmetry parameter + pade_extice, & ! PADE coefficients for shortwave ice extinction + pade_ssaice, & ! PADE coefficients for shortwave ice single scattering albedo + pade_asyice ! PADE coefficients for shortwave ice asymmetry parameter ! Dimensions integer :: & - nrghice_sw, nbandSWcldy_sw, nsize_liq_sw, nsize_ice_sw, nsizereg_sw,& - ncoeff_ext_sw, ncoeff_ssa_g_sw, nbound_sw, npairsSWcldy_sw + nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizereg,& + nCoeff_ext, nCoeff_ssa_g, nBound, nPairs ! Local variables - integer :: status,ncid_sw_clds,dimid,varID + integer :: status,ncid,dimid,varID character(len=264) :: sw_cloud_props_file #ifdef MPI - integer :: ierr + integer :: mpierr #endif ! Initialize errmsg = '' @@ -103,248 +103,215 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d ! Filenames are set in the physics_nml sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) - ! Read dimensions for k-distribution fields (only on master processor(0)) -! if (mpirank .eq. mpiroot) then - if(nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid_sw_clds) == NF90_NOERR) then - status = nf90_inq_dimid(ncid_sw_clds, 'nband', dimid) - status = nf90_inquire_dimension(ncid_sw_clds, dimid, len=nbandSWcldy_sw) - status = nf90_inq_dimid(ncid_sw_clds, 'nrghice', dimid) - status = nf90_inquire_dimension(ncid_sw_clds, dimid, len=nrghice_sw) - status = nf90_inq_dimid(ncid_sw_clds, 'nsize_liq', dimid) - status = nf90_inquire_dimension(ncid_sw_clds, dimid, len=nsize_liq_sw) - status = nf90_inq_dimid(ncid_sw_clds, 'nsize_ice', dimid) - status = nf90_inquire_dimension(ncid_sw_clds, dimid, len=nsize_ice_sw) - status = nf90_inq_dimid(ncid_sw_clds, 'nsizereg', dimid) - status = nf90_inquire_dimension(ncid_sw_clds, dimid, len=nsizereg_sw) - status = nf90_inq_dimid(ncid_sw_clds, 'ncoeff_ext', dimid) - status = nf90_inquire_dimension(ncid_sw_clds, dimid, len=ncoeff_ext_sw) - status = nf90_inq_dimid(ncid_sw_clds, 'ncoeff_ssa_g', dimid) - status = nf90_inquire_dimension(ncid_sw_clds, dimid, len=ncoeff_ssa_g_sw) - status = nf90_inq_dimid(ncid_sw_clds, 'nbound', dimid) - status = nf90_inquire_dimension(ncid_sw_clds, dimid, len=nbound_sw) - status = nf90_inq_dimid(ncid_sw_clds, 'pair', dimid) + ! On master processor only... + if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid) - endif + ! Read dimensions + status = nf90_inq_dimid(ncid, 'nband', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBand) + status = nf90_inq_dimid(ncid, 'nrghice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfile) + status = nf90_inq_dimid(ncid, 'nsize_liq', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_liq) + status = nf90_inq_dimid(ncid, 'nsize_ice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_ice) + status = nf90_inq_dimid(ncid, 'nsizereg', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSizereg) + status = nf90_inq_dimid(ncid, 'ncoeff_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ext) + status = nf90_inq_dimid(ncid, 'ncoeff_ssa_g', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_g) + status = nf90_inq_dimid(ncid, 'nbound', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBound) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nPairs) - ! Check to ensure that number of ice-roughness categories is feasible. - if (nrghice .gt. nrghice_sw) then - errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed' + ! Has the number of ice-roughnesses been provided from the namelist? + ! If not provided, use all categories in file (default) + if (nrghice .eq. 0) then + nrghice = nrghice_fromfile + endif + ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. + if (nrghice .gt. nrghice_fromfile) then + errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using nrghice from file...' + nrghice = nrghice_fromfile endif -! endif - - ! Broadcast dimensions to all processors -!#ifdef MPI -! call MPI_BCAST(nbandSWcldy_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! if (cld_optics_scheme .eq. 1) then -! call MPI_BARRIER(mpicomm, ierr) -! call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nsize_liq_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nsize_ice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BARRIER(mpicomm, ierr) -! endif -! if (cld_optics_scheme .eq. 2) then -! call MPI_BARRIER(mpicomm, ierr) -! call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nsizereg_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ncoeff_ext_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(ncoeff_ssa_g_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BCAST(nbound_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -! call MPI_BARRIER(mpicomm, ierr) -! endif -!#endif - if (cld_optics_scheme .eq. 1) then - allocate(lut_extliq_sw(nsize_liq_sw, nBandSWcldy_sw)) - allocate(lut_ssaliq_sw(nsize_liq_sw, nBandSWcldy_sw)) - allocate(lut_asyliq_sw(nsize_liq_sw, nBandSWcldy_sw)) - allocate(lut_extice_sw(nsize_ice_sw, nBandSWcldy_sw, nrghice_sw)) - allocate(lut_ssaice_sw(nsize_ice_sw, nBandSWcldy_sw, nrghice_sw)) - allocate(lut_asyice_sw(nsize_ice_sw, nBandSWcldy_sw, nrghice_sw)) - endif - if (cld_optics_scheme .eq. 2) then - allocate(pade_extliq_sw(nbandSWcldy_sw, nsizereg_sw, ncoeff_ext_sw )) - allocate(pade_ssaliq_sw(nbandSWcldy_sw, nsizereg_sw, ncoeff_ssa_g_sw)) - allocate(pade_asyliq_sw(nbandSWcldy_sw, nsizereg_sw, ncoeff_ssa_g_sw)) - allocate(pade_extice_sw(nbandSWcldy_sw, nsizereg_sw, ncoeff_ext_sw, nrghice_sw)) - allocate(pade_ssaice_sw(nbandSWcldy_sw, nsizereg_sw, ncoeff_ssa_g_sw, nrghice_sw)) - allocate(pade_asyice_sw(nbandSWcldy_sw, nsizereg_sw, ncoeff_ssa_g_sw, nrghice_sw)) - allocate(pade_sizereg_extliq_sw(nbound_sw)) - allocate(pade_sizereg_ssaliq_sw(nbound_sw)) - allocate(pade_sizereg_asyliq_sw(nbound_sw)) - allocate(pade_sizereg_extice_sw(nbound_sw)) - allocate(pade_sizereg_ssaice_sw(nbound_sw)) - allocate(pade_sizereg_asyice_sw(nbound_sw)) - endif - allocate(band_lims_cldy_sw(2,nbandSWcldy_sw)) + ! Allocate space for arrays + if (cld_optics_scheme .eq. 1) then + allocate(lut_extliq(nSize_liq, nBand)) + allocate(lut_ssaliq(nSize_liq, nBand)) + allocate(lut_asyliq(nSize_liq, nBand)) + allocate(lut_extice(nSize_ice, nBand, nrghice)) + allocate(lut_ssaice(nSize_ice, nBand, nrghice)) + allocate(lut_asyice(nSize_ice, nBand, nrghice)) + endif + if (cld_optics_scheme .eq. 2) then + allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) + allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice)) + allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_sizereg_extliq(nBound)) + allocate(pade_sizereg_ssaliq(nBound)) + allocate(pade_sizereg_asyliq(nBound)) + allocate(pade_sizereg_extice(nBound)) + allocate(pade_sizereg_ssaice(nBound)) + allocate(pade_sizereg_asyice(nBound)) + endif + allocate(band_lims(2,nBand)) - ! On master processor, allocate space, read in fields, broadcast to all processors -! if (mpirank .eq. mpiroot) then + ! Read in fields from file if (cld_optics_scheme .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) - status = nf90_get_var(ncid_sw_clds,varID,radliq_lwr_sw) - status = nf90_inq_varid(ncid_sw_clds,'radliq_upr',varID) - status = nf90_get_var(ncid_sw_clds,varID,radliq_upr_sw) - status = nf90_inq_varid(ncid_sw_clds,'radliq_fac',varID) - status = nf90_get_var(ncid_sw_clds,varID,radliq_fac_sw) - status = nf90_inq_varid(ncid_sw_clds,'radice_lwr',varID) - status = nf90_get_var(ncid_sw_clds,varID,radice_lwr_sw) - status = nf90_inq_varid(ncid_sw_clds,'radice_upr',varID) - status = nf90_get_var(ncid_sw_clds,varID,radice_upr_sw) - status = nf90_inq_varid(ncid_sw_clds,'radice_fac',varID) - status = nf90_get_var(ncid_sw_clds,varID,radice_fac_sw) - status = nf90_inq_varid(ncid_sw_clds,'lut_extliq',varID) - status = nf90_get_var(ncid_sw_clds,varID,lut_extliq_sw) - status = nf90_inq_varid(ncid_sw_clds,'lut_ssaliq',varID) - status = nf90_get_var(ncid_sw_clds,varID,lut_ssaliq_sw) - status = nf90_inq_varid(ncid_sw_clds,'lut_asyliq',varID) - status = nf90_get_var(ncid_sw_clds,varID,lut_asyliq_sw) - status = nf90_inq_varid(ncid_sw_clds,'lut_extice',varID) - status = nf90_get_var(ncid_sw_clds,varID,lut_extice_sw) - status = nf90_inq_varid(ncid_sw_clds,'lut_ssaice',varID) - status = nf90_get_var(ncid_sw_clds,varID,lut_ssaice_sw) - status = nf90_inq_varid(ncid_sw_clds,'lut_asyice',varID) - status = nf90_get_var(ncid_sw_clds,varID,lut_asyice_sw) - status = nf90_inq_varid(ncid_sw_clds,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid_sw_clds,varID,band_lims_cldy_sw) - status = nf90_close(ncid_sw_clds) - endif + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'lut_extliq',varID) + status = nf90_get_var(ncid,varID,lut_extliq) + status = nf90_inq_varid(ncid,'lut_ssaliq',varID) + status = nf90_get_var(ncid,varID,lut_ssaliq) + status = nf90_inq_varid(ncid,'lut_asyliq',varID) + status = nf90_get_var(ncid,varID,lut_asyliq) + status = nf90_inq_varid(ncid,'lut_extice',varID) + status = nf90_get_var(ncid,varID,lut_extice) + status = nf90_inq_varid(ncid,'lut_ssaice',varID) + status = nf90_get_var(ncid,varID,lut_ssaice) + status = nf90_inq_varid(ncid,'lut_asyice',varID) + status = nf90_get_var(ncid,varID,lut_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) endif - ! if (cld_optics_scheme .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) - status = nf90_get_var(ncid_sw_clds,varID,radliq_lwr_sw) - status = nf90_inq_varid(ncid_sw_clds,'radliq_upr',varID) - status = nf90_get_var(ncid_sw_clds,varID,radliq_upr_sw) - status = nf90_inq_varid(ncid_sw_clds,'radliq_fac',varID) - status = nf90_get_var(ncid_sw_clds,varID,radliq_fac_sw) - status = nf90_inq_varid(ncid_sw_clds,'radice_lwr',varID) - status = nf90_get_var(ncid_sw_clds,varID,radice_lwr_sw) - status = nf90_inq_varid(ncid_sw_clds,'radice_upr',varID) - status = nf90_get_var(ncid_sw_clds,varID,radice_upr_sw) - status = nf90_inq_varid(ncid_sw_clds,'radice_fac',varID) - status = nf90_get_var(ncid_sw_clds,varID,radice_fac_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_extliq',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_extliq_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_ssaliq',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_ssaliq_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_asyliq',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_asyliq_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_extice',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_extice_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_ssaice',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_ssaice_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_asyice',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_asyice_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_sizreg_extliq',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_sizereg_extliq_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_sizreg_ssaliq',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_sizereg_ssaliq_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_sizreg_asyliq',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_sizereg_asyliq_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_sizreg_extice',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_sizereg_extice_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_sizreg_ssaice',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_sizereg_ssaice_sw) - status = nf90_inq_varid(ncid_sw_clds,'pade_sizreg_asyice',varID) - status = nf90_get_var(ncid_sw_clds,varID,pade_sizereg_asyice_sw) - status = nf90_inq_varid(ncid_sw_clds,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid_sw_clds,varID,band_lims_cldy_sw) - status = nf90_close(ncid_sw_clds) - endif + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'pade_extliq',varID) + status = nf90_get_var(ncid,varID,pade_extliq) + status = nf90_inq_varid(ncid,'pade_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_ssaliq) + status = nf90_inq_varid(ncid,'pade_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_asyliq) + status = nf90_inq_varid(ncid,'pade_extice',varID) + status = nf90_get_var(ncid,varID,pade_extice) + status = nf90_inq_varid(ncid,'pade_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_ssaice) + status = nf90_inq_varid(ncid,'pade_asyice',varID) + status = nf90_get_var(ncid,varID,pade_asyice) + status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extliq) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaliq) + status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyliq) + status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extice) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaice) + status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) endif -! endif - ! Broadcast arrays to all processors -!#ifdef MPI -! if (cld_optics_scheme .eq. 1) then -! if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (LUT) ... ' -! call MPI_BARRIER(mpicomm, ierr) -!#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) -! call MPI_BCAST(radliq_fac_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(radice_lwr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(radice_upr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(radice_fac_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_extliq_sw, size(lut_extliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_ssaliq_sw, size(lut_ssaliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_asyliq_sw, size(lut_asyliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_extice_sw, size(lut_extice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_ssaice_sw, size(lut_ssaice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_asyice_sw, size(lut_asyice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -!#else -! call MPI_BCAST(radliq_lwr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(radliq_upr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(radliq_fac_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(radice_lwr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(radice_upr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(radice_fac_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_extliq_sw, size(lut_extliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_ssaliq_sw, size(lut_ssaliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_asyliq_sw, size(lut_asyliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_extice_sw, size(lut_extice_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_ssaice_sw, size(lut_ssaice_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(lut_asyice_sw, size(lut_asyice_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_REAL, mpiroot, mpicomm, ierr) -!#endif -! call MPI_BARRIER(mpicomm, ierr) -! endif -! if (cld_optics_scheme .eq. 2) then -! if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (PADE) ... ' -! call MPI_BARRIER(mpicomm, ierr) -!#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) -! call MPI_BCAST(pade_asyliq_sw, size(pade_asyliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_extice_sw, size(pade_extice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_ssaice_sw, size(pade_ssaice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_asyice_sw, size(pade_asyice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_extliq_sw, size(pade_sizereg_extliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_ssaliq_sw, size(pade_sizereg_ssaliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_asyliq_sw, size(pade_sizereg_asyliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_extice_sw, size(pade_sizereg_extice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_ssaice_sw, size(pade_sizereg_ssaice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_asyice_sw, size(pade_sizereg_asyice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -! call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -!#else -! call MPI_BCAST(pade_extliq_sw, size(pade_extliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_ssaliq_sw, size(pade_ssaliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_asyliq_sw, size(pade_asyliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_extice_sw, size(pade_extice_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_ssaice_sw, size(pade_ssaice_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_asyice_sw, size(pade_asyice_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_extliq_sw, size(pade_sizereg_extliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_ssaliq_sw, size(pade_sizereg_ssaliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_asyliq_sw, size(pade_sizereg_asyliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_extice_sw, size(pade_sizereg_extice_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_ssaice_sw, size(pade_sizereg_ssaice_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(pade_sizereg_asyice_sw, size(pade_sizereg_asyice_sw), MPI_REAL, mpiroot, mpicomm, ierr) -! call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_REAL, mpiroot, mpicomm, ierr) -!#endif -! call MPI_BARRIER(mpicomm, ierr) -! endif -!#endif + ! Close file + status = nf90_close(ncid) + endif + +#ifdef MPI + if (cld_optics_scheme .eq. 1) then + ! Wait for processor 0 to catch up... + call MPI_BARRIER(mpicomm, mpierr) + + ! Broadcast data + write (*,*) 'Broadcasting RRTMGP shortwave cloud-optics data ... ' + call MPI_BCAST(nBand, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nrghice, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nSize_liq, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nSize_ice, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radliq_lwr, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radliq_upr, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radliq_fac, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radice_lwr, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radice_upr, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(radice_fac, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_extliq, size(lut_extliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_ssaliq, size(lut_ssaliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_asyliq, size(lut_asyliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_extice, size(lut_extice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(lut_asyice, size(lut_asyice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) + + ! Don't advance until data broadcast complete on all processors + call MPI_BARRIER(mpicomm, mpierr) + endif + if (cld_optics_scheme .eq. 2) then + ! Wait for processor 0 to catch up... + call MPI_BARRIER(mpicomm, mpierr) + + ! Broadcast data + write (*,*) 'Broadcasting RRTMGP shortwave cloud-optics data ... ' + call MPI_BCAST(nBand, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nrghice, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nSizeReg, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nCoeff_ext, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nCoeff_ssa_g, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nBound, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_extliq, size(pade_extliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_extice, size(pade_extice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_asyice), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) + + ! Don't advance until data broadcast complete on all processors + call MPI_BARRIER(mpicomm, mpierr) + endif +#endif ! Load tables data for RRTMGP cloud-optics if (cld_optics_scheme .eq. 1) then call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) - call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_lims_cldy_sw, & - radliq_lwr_sw, radliq_upr_sw, radliq_fac_sw, radice_lwr_sw, radice_upr_sw, & - radice_fac_sw, lut_extliq_sw, lut_ssaliq_sw, lut_asyliq_sw, lut_extice_sw, & - lut_ssaice_sw, lut_asyice_sw)) + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_lims, & + radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & + lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) endif if (cld_optics_scheme .eq. 2) then call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) - call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_lims_cldy_sw, & - pade_extliq_sw, pade_ssaliq_sw, pade_asyliq_sw, pade_extice_sw, pade_ssaice_sw, & - pade_asyice_sw, pade_sizereg_extliq_sw, pade_sizereg_ssaliq_sw, & - pade_sizereg_asyliq_sw, pade_sizereg_extice_sw, pade_sizereg_ssaice_sw, & - pade_sizereg_asyice_sw)) + call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_lims, & + pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& + pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & + pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) endif end subroutine rrtmgp_sw_cloud_optics_init diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index e9450eb77..c60ae90d6 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -15,7 +15,7 @@ units = count dimensions = () type = integer - intent = in + intent = inout optional = F [rrtmgp_root_dir] standard_name = directory_for_rte_rrtmgp_source_code diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index fc6e804cb..1b1ca8409 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -8,6 +8,9 @@ module rrtmgp_sw_gas_optics use mo_optical_props, only: ty_optical_props_2str use mo_compute_bc, only: compute_bc use netcdf +#ifdef MPI + use mpi +#endif contains @@ -19,10 +22,6 @@ module rrtmgp_sw_gas_optics !! subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_nGases, & active_gases_array, mpicomm, mpirank, mpiroot, sw_gas_props, errmsg, errflg) - use netcdf -#ifdef MPI - use mpi -#endif ! Inputs character(len=128),intent(in) :: & @@ -49,348 +48,284 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp type(ty_gas_concs) :: & gas_concentrations integer, dimension(:), allocatable :: & - kminor_start_lower_sw, & ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_lower\" (lower atmosphere) - kminor_start_upper_sw ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_upper\" (upper atmosphere) + kminor_start_lower, & ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_lower\" (lower atmosphere) + kminor_start_upper ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_upper\" (upper atmosphere) integer, dimension(:,:), allocatable :: & - band2gpt_sw, & ! Beginning and ending gpoint for each band - minor_limits_gpt_lower_sw, & ! Beginning and ending gpoint for each minor interval in lower atmosphere - minor_limits_gpt_upper_sw ! Beginning and ending gpoint for each minor interval in upper atmosphere + band2gpt, & ! Beginning and ending gpoint for each band + minor_limits_gpt_lower, & ! Beginning and ending gpoint for each minor interval in lower atmosphere + minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere integer, dimension(:,:,:), allocatable :: & - key_species_sw ! Key species pair for each band + key_species ! Key species pair for each band real(kind_phys) :: & - press_ref_trop_sw, & ! Reference pressure separating the lower and upper atmosphere [Pa] - temp_ref_p_sw, & ! Standard spectroscopic reference pressure [Pa] - temp_ref_t_sw ! Standard spectroscopic reference temperature [K] + press_ref_trop, & ! Reference pressure separating the lower and upper atmosphere [Pa] + temp_ref_p, & ! Standard spectroscopic reference pressure [Pa] + temp_ref_t ! Standard spectroscopic reference temperature [K] real(kind_phys), dimension(:), allocatable :: & - press_ref_sw, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] - temp_ref_sw, & ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] - solar_source_sw ! Stored solar source function from original RRTM + press_ref, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] + temp_ref, & ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] + solar_source ! Stored solar source function from original RRTM real(kind_phys), dimension(:,:), allocatable :: & - band_lims_sw ! Beginning and ending wavenumber [cm -1] for each band + band_lims ! Beginning and ending wavenumber [cm -1] for each band real(kind_phys), dimension(:,:,:), allocatable :: & - vmr_ref_sw, & ! Volume mixing ratios for reference atmosphere - kminor_lower_sw, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - kminor_upper_sw, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - rayl_lower_sw, & ! Stored coefficients due to rayleigh scattering contribution - rayl_upper_sw ! Stored coefficients due to rayleigh scattering contribution + vmr_ref, & ! Volume mixing ratios for reference atmosphere + kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + kminor_upper, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + rayl_lower, & ! Stored coefficients due to rayleigh scattering contribution + rayl_upper ! Stored coefficients due to rayleigh scattering contribution real(kind_phys), dimension(:,:,:,:), allocatable :: & - kmajor_sw ! Stored absorption coefficients due to major absorbing gases + kmajor ! Stored absorption coefficients due to major absorbing gases character(len=32), dimension(:), allocatable :: & - gas_names_sw, & ! Names of absorbing gases - gas_minor_sw, & ! Name of absorbing minor gas - identifier_minor_sw, & ! Unique string identifying minor gas - minor_gases_lower_sw, & ! Names of minor absorbing gases in lower atmosphere - minor_gases_upper_sw, & ! Names of minor absorbing gases in upper atmosphere - scaling_gas_lower_sw, & ! Absorption also depends on the concentration of this gas - scaling_gas_upper_sw ! Absorption also depends on the concentration of this gas + gas_names, & ! Names of absorbing gases + gas_minor, & ! Name of absorbing minor gas + identifier_minor, & ! Unique string identifying minor gas + minor_gases_lower, & ! Names of minor absorbing gases in lower atmosphere + minor_gases_upper, & ! Names of minor absorbing gases in upper atmosphere + scaling_gas_lower, & ! Absorption also depends on the concentration of this gas + scaling_gas_upper ! Absorption also depends on the concentration of this gas logical(wl), dimension(:), allocatable :: & - minor_scales_with_density_lower_sw, & ! Density scaling is applied to minor absorption coefficients - minor_scales_with_density_upper_sw, & ! Density scaling is applied to minor absorption coefficients - scale_by_complement_lower_sw, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) - scale_by_complement_upper_sw ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + minor_scales_with_density_lower, & ! Density scaling is applied to minor absorption coefficients + minor_scales_with_density_upper, & ! Density scaling is applied to minor absorption coefficients + scale_by_complement_lower, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) ! Dimensions integer :: & - ntemps_sw, npress_sw, ngpts_sw, nabsorbers_sw, nextrabsorbers_sw, & - nminorabsorbers_sw, nmixingfracs_sw, nlayers_sw, nbnds_sw, npairs_sw, & - nminor_absorber_intervals_lower_sw, nminor_absorber_intervals_upper_sw, & - ncontributors_lower_sw, ncontributors_upper_sw + ntemps, npress, ngpts, nabsorbers, nextrabsorbers, & + nminorabsorbers, nmixingfracs, nlayers, nbnds, npairs, & + nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & + ncontributors_lower, ncontributors_upper ! Local variables - integer :: status, ncid_sw, dimid, varID, iGas + integer :: status, ncid, dimid, varID, iGas integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 character(len=264) :: sw_gas_props_file #ifdef MPI - integer :: ierr + integer :: mpierr #endif ! Initialize errmsg = '' errflg = 0 + write(*,"(a52,3i20)") 'rrtmgp_sw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm + ! Filenames are set in the gphysics_nml 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(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) - status = nf90_inq_dimid(ncid_sw, 'pressure', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=npress_sw) - status = nf90_inq_dimid(ncid_sw, 'absorber', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=nabsorbers_sw) - status = nf90_inq_dimid(ncid_sw, 'minor_absorber', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=nminorabsorbers_sw) - status = nf90_inq_dimid(ncid_sw, 'absorber_ext', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=nextrabsorbers_sw) - status = nf90_inq_dimid(ncid_sw, 'mixing_fraction', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=nmixingfracs_sw) - status = nf90_inq_dimid(ncid_sw, 'atmos_layer', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=nlayers_sw) - status = nf90_inq_dimid(ncid_sw, 'bnd', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=nbnds_sw) - status = nf90_inq_dimid(ncid_sw, 'gpt', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=ngpts_sw) - status = nf90_inq_dimid(ncid_sw, 'pair', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=npairs_sw) - status = nf90_inq_dimid(ncid_sw, 'contributors_lower', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=ncontributors_lower_sw) - status = nf90_inq_dimid(ncid_sw, 'contributors_upper', dimid) - status = nf90_inquire_dimension(ncid_sw, dimid, len=ncontributors_upper_sw) - status = nf90_inq_dimid(ncid_sw, 'minor_absorber_intervals_lower', dimid) - 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_close(ncid_sw) - 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 + if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(sw_gas_props_file), NF90_WRITE, ncid) - ! Allocate space for arrays - allocate(gas_names_sw(nabsorbers_sw)) - allocate(scaling_gas_lower_sw(nminor_absorber_intervals_lower_sw)) - allocate(scaling_gas_upper_sw(nminor_absorber_intervals_upper_sw)) - allocate(gas_minor_sw(nminorabsorbers_sw)) - allocate(identifier_minor_sw(nminorabsorbers_sw)) - allocate(minor_gases_lower_sw(nminor_absorber_intervals_lower_sw)) - allocate(minor_gases_upper_sw(nminor_absorber_intervals_upper_sw)) - allocate(minor_limits_gpt_lower_sw(npairs_sw,nminor_absorber_intervals_lower_sw)) - allocate(minor_limits_gpt_upper_sw(npairs_sw,nminor_absorber_intervals_upper_sw)) - allocate(band2gpt_sw(2,nbnds_sw)) - allocate(key_species_sw(2,nlayers_sw,nbnds_sw)) - allocate(band_lims_sw(2,nbnds_sw)) - allocate(press_ref_sw(npress_sw)) - allocate(temp_ref_sw(ntemps_sw)) - allocate(vmr_ref_sw(nlayers_sw, nextrabsorbers_sw, ntemps_sw)) - allocate(kminor_lower_sw(ncontributors_lower_sw, nmixingfracs_sw, ntemps_sw)) - allocate(kmajor_sw(ngpts_sw, nmixingfracs_sw, npress_sw+1, ntemps_sw)) - allocate(kminor_start_lower_sw(nminor_absorber_intervals_lower_sw)) - allocate(kminor_upper_sw(ncontributors_upper_sw, nmixingfracs_sw, ntemps_sw)) - allocate(kminor_start_upper_sw(nminor_absorber_intervals_upper_sw)) - allocate(minor_scales_with_density_lower_sw(nminor_absorber_intervals_lower_sw)) - allocate(minor_scales_with_density_upper_sw(nminor_absorber_intervals_upper_sw)) - allocate(scale_by_complement_lower_sw(nminor_absorber_intervals_lower_sw)) - allocate(scale_by_complement_upper_sw(nminor_absorber_intervals_upper_sw)) - allocate(rayl_upper_sw(ngpts_sw, nmixingfracs_sw, ntemps_sw)) - allocate(rayl_lower_sw(ngpts_sw, nmixingfracs_sw, ntemps_sw)) - allocate(solar_source_sw(ngpts_sw)) - allocate(temp1(nminor_absorber_intervals_lower_sw)) - allocate(temp2(nminor_absorber_intervals_upper_sw)) - allocate(temp3(nminor_absorber_intervals_lower_sw)) - allocate(temp4(nminor_absorber_intervals_upper_sw)) + ! Read dimensions for k-distribution fields + status = nf90_inq_dimid(ncid, 'temperature', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ntemps) + status = nf90_inq_dimid(ncid, 'pressure', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=npress) + status = nf90_inq_dimid(ncid, 'absorber', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nabsorbers) + status = nf90_inq_dimid(ncid, 'minor_absorber',dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nminorabsorbers) + status = nf90_inq_dimid(ncid, 'absorber_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nextrabsorbers) + status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nmixingfracs) + status = nf90_inq_dimid(ncid, 'atmos_layer', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nlayers) + status = nf90_inq_dimid(ncid, 'bnd', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nbnds) + status = nf90_inq_dimid(ncid, 'gpt', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ngpts) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=npairs) + status = nf90_inq_dimid(ncid, 'contributors_lower',dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_lower) + status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_upper) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_lower) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upper) + + ! Allocate space for arrays + allocate(gas_names(nabsorbers)) + allocate(scaling_gas_lower(nminor_absorber_intervals_lower)) + allocate(scaling_gas_upper(nminor_absorber_intervals_upper)) + allocate(gas_minor(nminorabsorbers)) + allocate(identifier_minor(nminorabsorbers)) + allocate(minor_gases_lower(nminor_absorber_intervals_lower)) + allocate(minor_gases_upper(nminor_absorber_intervals_upper)) + allocate(minor_limits_gpt_lower(npairs,nminor_absorber_intervals_lower)) + allocate(minor_limits_gpt_upper(npairs,nminor_absorber_intervals_upper)) + allocate(band2gpt(2,nbnds)) + allocate(key_species(2,nlayers,nbnds)) + allocate(band_lims(2,nbnds)) + allocate(press_ref(npress)) + allocate(temp_ref(ntemps)) + allocate(vmr_ref(nlayers, nextrabsorbers, ntemps)) + allocate(kminor_lower(ncontributors_lower, nmixingfracs, ntemps)) + allocate(kmajor(ngpts, nmixingfracs, npress+1, ntemps)) + allocate(kminor_start_lower(nminor_absorber_intervals_lower)) + allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) + allocate(kminor_start_upper(nminor_absorber_intervals_upper)) + allocate(minor_scales_with_density_lower(nminor_absorber_intervals_lower)) + allocate(minor_scales_with_density_upper(nminor_absorber_intervals_upper)) + allocate(scale_by_complement_lower(nminor_absorber_intervals_lower)) + allocate(scale_by_complement_upper(nminor_absorber_intervals_upper)) + allocate(rayl_upper(ngpts, nmixingfracs, ntemps)) + allocate(rayl_lower(ngpts, nmixingfracs, ntemps)) + allocate(solar_source(ngpts)) + allocate(temp1(nminor_absorber_intervals_lower)) + allocate(temp2(nminor_absorber_intervals_upper)) + allocate(temp3(nminor_absorber_intervals_lower)) + allocate(temp4(nminor_absorber_intervals_upper)) - ! On master processor, read in fields, broadcast to all processors -! 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 - status = nf90_inq_varid(ncid_sw,'gas_names',varID) - status = nf90_get_var(ncid_sw,varID,gas_names_sw) - ! - status = nf90_inq_varid(ncid_sw,'scaling_gas_lower',varID) - status = nf90_get_var(ncid_sw,varID,scaling_gas_lower_sw) - ! - status = nf90_inq_varid(ncid_sw,'scaling_gas_upper',varID) - status = nf90_get_var(ncid_sw,varID,scaling_gas_upper_sw) - ! - status = nf90_inq_varid(ncid_sw,'gas_minor',varID) - status = nf90_get_var(ncid_sw,varID,gas_minor_sw) - ! - status = nf90_inq_varid(ncid_sw,'identifier_minor',varID) - status = nf90_get_var(ncid_sw,varID,identifier_minor_sw) - ! - status = nf90_inq_varid(ncid_sw,'minor_gases_lower',varID) - status = nf90_get_var(ncid_sw,varID,minor_gases_lower_sw) - ! - status = nf90_inq_varid(ncid_sw,'minor_gases_upper',varID) - status = nf90_get_var(ncid_sw,varID,minor_gases_upper_sw) - ! - status = nf90_inq_varid(ncid_sw,'minor_limits_gpt_lower',varID) - status = nf90_get_var(ncid_sw,varID,minor_limits_gpt_lower_sw) - ! - status = nf90_inq_varid(ncid_sw,'minor_limits_gpt_upper',varID) - status = nf90_get_var(ncid_sw,varID,minor_limits_gpt_upper_sw) - ! - status = nf90_inq_varid(ncid_sw,'bnd_limits_gpt',varID) - status = nf90_get_var(ncid_sw,varID,band2gpt_sw) - ! - status = nf90_inq_varid(ncid_sw,'key_species',varID) - status = nf90_get_var(ncid_sw,varID,key_species_sw) - ! - status = nf90_inq_varid(ncid_sw,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid_sw,varID,band_lims_sw) - ! - status = nf90_inq_varid(ncid_sw,'press_ref',varID) - status = nf90_get_var(ncid_sw,varID,press_ref_sw) - ! - status = nf90_inq_varid(ncid_sw,'temp_ref',varID) - status = nf90_get_var(ncid_sw,varID,temp_ref_sw) - ! - status = nf90_inq_varid(ncid_sw,'absorption_coefficient_ref_P',varID) - status = nf90_get_var(ncid_sw,varID,temp_ref_p_sw) - ! - status = nf90_inq_varid(ncid_sw,'absorption_coefficient_ref_T',varID) - status = nf90_get_var(ncid_sw,varID,temp_ref_t_sw) - ! - status = nf90_inq_varid(ncid_sw,'press_ref_trop',varID) - status = nf90_get_var(ncid_sw,varID,press_ref_trop_sw) - ! - status = nf90_inq_varid(ncid_sw,'kminor_lower',varID) - status = nf90_get_var(ncid_sw,varID,kminor_lower_sw) - ! - status = nf90_inq_varid(ncid_sw,'kminor_upper',varID) - status = nf90_get_var(ncid_sw,varID,kminor_upper_sw) - ! - status = nf90_inq_varid(ncid_sw,'vmr_ref',varID) - status = nf90_get_var(ncid_sw,varID,vmr_ref_sw) - ! - status = nf90_inq_varid(ncid_sw,'kmajor',varID) - status = nf90_get_var(ncid_sw,varID,kmajor_sw) - ! - status = nf90_inq_varid(ncid_sw,'kminor_start_lower',varID) - status = nf90_get_var(ncid_sw,varID,kminor_start_lower_sw) - ! - status = nf90_inq_varid(ncid_sw,'kminor_start_upper',varID) - status = nf90_get_var(ncid_sw,varID,kminor_start_upper_sw) - ! - status = nf90_inq_varid(ncid_sw,'solar_source',varID) - status = nf90_get_var(ncid_sw,varID,solar_source_sw) - ! - status = nf90_inq_varid(ncid_sw,'rayl_lower',varID) - status = nf90_get_var(ncid_sw,varID,rayl_lower_sw) - - status = nf90_inq_varid(ncid_sw,'rayl_upper',varID) - status = nf90_get_var(ncid_sw,varID,rayl_upper_sw) + write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' + status = nf90_inq_varid(ncid, 'gas_names', varID) + status = nf90_get_var( ncid, varID, gas_names) + status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) + status = nf90_get_var( ncid, varID, scaling_gas_lower) + status = nf90_inq_varid(ncid, 'scaling_gas_upper', varID) + status = nf90_get_var( ncid, varID, scaling_gas_upper) + status = nf90_inq_varid(ncid, 'gas_minor', varID) + status = nf90_get_var( ncid, varID, gas_minor) + status = nf90_inq_varid(ncid, 'identifier_minor', varID) + status = nf90_get_var( ncid, varID, identifier_minor) + status = nf90_inq_varid(ncid, 'minor_gases_lower', varID) + status = nf90_get_var( ncid, varID, minor_gases_lower) + status = nf90_inq_varid(ncid, 'minor_gases_upper', varID) + status = nf90_get_var( ncid, varID, minor_gases_upper) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_lower) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_upper) + status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varID) + status = nf90_get_var( ncid, varID, band2gpt) + status = nf90_inq_varid(ncid, 'key_species', varID) + status = nf90_get_var( ncid, varID, key_species) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber', varID) + status = nf90_get_var( ncid, varID, band_lims) + status = nf90_inq_varid(ncid, 'press_ref', varID) + status = nf90_get_var( ncid, varID, press_ref) + status = nf90_inq_varid(ncid, 'temp_ref', varID) + status = nf90_get_var( ncid, varID, temp_ref) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) + status = nf90_get_var( ncid, varID, temp_ref_p) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) + status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_inq_varid(ncid, 'press_ref_trop', varID) + status = nf90_get_var( ncid, varID, press_ref_trop) + status = nf90_inq_varid(ncid, 'kminor_lower', varID) + status = nf90_get_var( ncid, varID, kminor_lower) + status = nf90_inq_varid(ncid, 'kminor_upper', varID) + status = nf90_get_var( ncid, varID, kminor_upper) + status = nf90_inq_varid(ncid, 'vmr_ref', varID) + status = nf90_get_var( ncid, varID, vmr_ref) + status = nf90_inq_varid(ncid, 'kmajor', varID) + status = nf90_get_var( ncid, varID, kmajor) + status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) + status = nf90_get_var( ncid, varID, kminor_start_lower) + status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) + status = nf90_get_var( ncid, varID, kminor_start_upper) + status = nf90_inq_varid(ncid, 'solar_source', varID) + status = nf90_get_var( ncid, varID, solar_source) + status = nf90_inq_varid(ncid, 'rayl_lower', varID) + status = nf90_get_var( ncid, varID, rayl_lower) + status = nf90_inq_varid(ncid, 'rayl_upper', varID) + status = nf90_get_var( ncid, varID, rayl_upper) - ! Logical fields are read in as integers and then converted to logicals. - status = nf90_inq_varid(ncid_sw,'minor_scales_with_density_lower',varID) - status = nf90_get_var(ncid_sw,varID,temp1) - minor_scales_with_density_lower_sw(:) = .false. - where(temp1 .eq. 1) minor_scales_with_density_lower_sw(:) = .true. - ! - status = nf90_inq_varid(ncid_sw,'minor_scales_with_density_upper',varID) - status = nf90_get_var(ncid_sw,varID,temp2) - minor_scales_with_density_upper_sw(:) = .false. - where(temp2 .eq. 1) minor_scales_with_density_upper_sw(:) = .true. - ! - status = nf90_inq_varid(ncid_sw,'scale_by_complement_lower',varID) - status = nf90_get_var(ncid_sw,varID,temp3) - scale_by_complement_lower_sw(:) = .false. - where(temp3 .eq. 1) scale_by_complement_lower_sw(:) = .true. - ! - status = nf90_inq_varid(ncid_sw,'scale_by_complement_upper',varID) - status = nf90_get_var(ncid_sw,varID,temp4) - scale_by_complement_upper_sw(:) = .false. - where(temp4 .eq. 1) scale_by_complement_upper_sw(:) = .true. - - ! Close - status = nf90_close(ncid_sw) - endif -! endif + ! Logical fields are read in as integers and then converted to logicals. + status = nf90_inq_varid(ncid,'minor_scales_with_density_lower', varID) + status = nf90_get_var( ncid, varID,temp1) + minor_scales_with_density_lower(:) = .false. + where(temp1 .eq. 1) minor_scales_with_density_lower(:) = .true. + status = nf90_inq_varid(ncid,'minor_scales_with_density_upper', varID) + status = nf90_get_var( ncid, varID,temp2) + minor_scales_with_density_upper(:) = .false. + where(temp2 .eq. 1) minor_scales_with_density_upper(:) = .true. + status = nf90_inq_varid(ncid,'scale_by_complement_lower', varID) + status = nf90_get_var( ncid, varID,temp3) + scale_by_complement_lower(:) = .false. + where(temp3 .eq. 1) scale_by_complement_lower(:) = .true. + status = nf90_inq_varid(ncid,'scale_by_complement_upper', varID) + status = nf90_get_var( ncid, varID,temp4) + scale_by_complement_upper(:) = .false. + where(temp4 .eq. 1) scale_by_complement_upper(:) = .true. + + ! Close + status = nf90_close(ncid) + 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 + ! Wait for processor 0 to catch up... + call MPI_BARRIER(mpicomm, mpierr) + + ! Broadcast data + write (*,*) 'Broadcasting RRTMGP shortwave k-distribution data ... ' + call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ngpts, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(solar_source, size(solar_source), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(rayl_lower, size(rayl_lower), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(rayl_upper, size(rayl_upper), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(gas_names, size(gas_names), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(gas_minor, size(gas_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(identifier_minor, size(identifier_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_gases_lower, size(minor_gases_lower), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_gases_upper, size(minor_gases_upper), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + ! Don't advance until data broadcast complete on all processors + call MPI_BARRIER(mpicomm, mpierr) +#endif - ! Initialize gas concentrations and gas optics class with data + ! Initialize gas concentrations and gas optics class do iGas=1,rrtmgp_nGases call check_error_msg('sw_gas_optics_init',gas_concentrations%set_vmr(active_gases_array(iGas), 0._kind_phys)) enddo - call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, gas_names_sw, & - key_species_sw, band2gpt_sw, band_lims_sw, press_ref_sw, press_ref_trop_sw, temp_ref_sw, & - temp_ref_p_sw, temp_ref_t_sw, vmr_ref_sw, kmajor_sw, kminor_lower_sw, kminor_upper_sw, & - gas_minor_sw,identifier_minor_sw, minor_gases_lower_sw, minor_gases_upper_sw, & - minor_limits_gpt_lower_sw,minor_limits_gpt_upper_sw, minor_scales_with_density_lower_sw, & - minor_scales_with_density_upper_sw, scaling_gas_lower_sw, & - scaling_gas_upper_sw, scale_by_complement_lower_sw, & - scale_by_complement_upper_sw, kminor_start_lower_sw, kminor_start_upper_sw, & - solar_source_sw, rayl_lower_sw, rayl_upper_sw)) + call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, gas_names, & + key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & + temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower,minor_limits_gpt_upper, & + minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & + scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, solar_source, rayl_lower, rayl_upper)) end subroutine rrtmgp_sw_gas_optics_init