diff --git a/physics/GFS_rrtmgp_lw.F90 b/physics/GFS_rrtmgp_lw.F90 deleted file mode 100644 index 7c88c20c3..000000000 --- a/physics/GFS_rrtmgp_lw.F90 +++ /dev/null @@ -1,1039 +0,0 @@ -! ########################################################################################### -! ########################################################################################### -module GFS_rrtmgp_lw - use mo_gas_concentrations, only: ty_gas_concs - use mo_fluxes, only: ty_fluxes_broadband - use mo_fluxes_byband, only: ty_fluxes_byband - use mo_optical_props, only: ty_optical_props_1scl,ty_optical_props_2str - use mo_source_functions, only: ty_source_func_lw - use mo_rte_kind, only: wl - use mo_heating_rates, only: compute_heating_rate - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_cloud_optics, only: ty_cloud_optics - use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples - use machine, only: kind_phys - use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type - use physparam, only: ilwcliq,isubclw,iovrlw,ilwrgas,icldflg,ilwrate - use GFS_typedefs, only: GFS_control_type - use mo_rrtmgp_constants, only: grav, avogad - use mo_rrtmgp_lw_cloud_optics, only: rrtmgp_lw_cloud_optics - use mersenne_twister, only: random_setseed, random_number, random_stat - use mo_rrtmgp_clr_all_sky, only: rte_lw - - implicit none - - ! Parameters - integer,parameter :: nGases = 6 - real(kind_phys),parameter :: epsilon=1.0e-6 - character(len=3),parameter, dimension(nGases) :: & - active_gases = (/ 'h2o', 'co2', 'o3 ', 'n2o', 'ch4', 'o2 '/) - - ! Molecular weight ratios (for converting mmr to vmr) - real(kind_phys), parameter :: & - amd = 28.9644_kind_phys, & ! Molecular weight of dry-air (g/mol) - amw = 18.0154_kind_phys, & ! Molecular weight of water vapor (g/mol) - amo3 = 47.9982_kind_phys, & ! Modelular weight of ozone (g/mol) - amdw = amd/amw, & ! Molecular weight of dry air / water vapor - amdo3 = amd/amo3 ! Molecular weight of dry air / ozone - - ! Module parameters (set during rrtmgp_lw_init()) - integer :: & - rrtmgp_lw_cld_phys, & ! RRTMGP cloud-physics (0-RRTMG, 1-RRTGMP(LUT), 2-RRTMGP(Pade)) - nGptsLW, & ! Number of LW spectral g-points - nBandsLW, & ! Number of LW bands - nrghice, & ! Number of ice roughness categories - ipsdlw0 ! Initial see for McICA - - integer,allocatable,dimension(:) :: & - ngb_LW ! Band index for each g-points - - public GFS_rrtmgp_lw_init, GFS_rrtmgp_lw_run, GFS_rrtmgp_lw_finalize -contains - ! ######################################################################################### - ! GFS_rrtmgp_lw_init - ! ######################################################################################### -!! \section arg_table_GFS_rrtmgp_lw_init Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |--------------------|-------------------------------------------------|---------------------------------------------------------------------------|-------|------|----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | mpirank | mpi_rank | current MPI rank | index | 0 | integer | | in | F | -!! | mpiroot | mpi_root | master MPI rank | index | 0 | integer | | in | F | -!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! | kdist_lw | K_distribution_file_for_RRTMGP_LW_scheme | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | inout | F | -!! | kdist_lw_cldy | K_distribution_file_for_cloudy_RRTMGP_LW_scheme | DDT containing spectral information for cloudy RRTMGP LW radiation scheme | DDT | 0 | ty_cloud_optics | | inout | F | -!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | inout | F | -!! - ! ######################################################################################### - subroutine GFS_rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, kdist_lw, kdist_lw_cldy, & - gas_concentrations, errmsg, errflg) - use netcdf - -#ifdef MPI - use mpi -#endif - - ! Inputs - type(GFS_control_type), intent(in) :: & - Model ! DDT containing model control parameters - integer,intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank - type(ty_gas_optics_rrtmgp),intent(inout) :: & - kdist_lw - type(ty_cloud_optics),intent(inout) :: & - kdist_lw_cldy - type(ty_gas_concs),intent(inout) :: & - gas_concentrations - - ! Outputs - character(len=*), intent(out) :: & - errmsg ! Error message - integer, intent(out) :: & - errflg ! Error code - - ! Variables that will be passed to gas_optics%load() - integer, dimension(:), allocatable :: & - kminor_start_lower, & ! used by RRTGMP gas optics - kminor_start_upper ! used by RRTGMP gas optics - integer, dimension(:,:), allocatable :: & - band2gpt, & ! used by RRTGMP gas optics - minor_limits_gpt_lower, & ! used by RRTGMP gas optics - minor_limits_gpt_upper ! used by RRTGMP gas optics - integer, dimension(:,:,:), allocatable :: & - key_species ! used by RRTGMP gas optics - real(kind_phys) :: & - press_ref_trop, & ! used by RRTGMP gas optics - temp_ref_p, & ! used by RRTGMP gas optics - temp_ref_t, & ! used by RRTGMP gas optics - radliq_lwr, & ! used by RRTGMP cloud optics - radliq_upr, & ! used by RRTGMP cloud optics - radliq_fac, & ! used by RRTGMP cloud optics - radice_lwr, & ! used by RRTGMP cloud optics - radice_upr, & ! used by RRTGMP cloud optics - radice_fac ! used by RRTGMP cloud optics - real(kind_phys), dimension(:), allocatable :: & - press_ref, & ! used by RRTGMP gas optics - temp_ref, & ! used by RRTGMP gas optics - pade_sizereg_extliq, & ! used by RRTGMP cloud optics - pade_sizereg_ssaliq, & ! used by RRTGMP cloud optics - pade_sizereg_asyliq, & ! used by RRTGMP cloud optics - pade_sizereg_extice, & ! used by RRTGMP cloud optics - pade_sizereg_ssaice, & ! used by RRTGMP cloud optics - pade_sizereg_asyice ! used by RRTGMP cloud optics - real(kind_phys), dimension(:,:), allocatable :: & - band_lims, & ! used by RRTGMP gas optics - totplnk, & ! used by RRTGMP gas optics - lut_extliq, & ! used by RRTGMP cloud optics - lut_ssaliq, & ! used by RRTGMP cloud optics - lut_asyliq, & ! used by RRTGMP cloud optics - band_lims_cldy ! used by RRTGMP cloud optics - - real(kind_phys), dimension(:,:,:), allocatable :: & - vmr_ref, & ! used by RRTGMP gas optics - kminor_lower, & ! used by RRTGMP gas optics - kminor_upper, & ! used by RRTGMP gas optics - rayl_lower, & ! used by RRTGMP gas optics - rayl_upper, & ! used by RRTGMP gas optics - lut_extice, & ! used by RRTGMP cloud optics - lut_ssaice, & ! used by RRTGMP cloud optics - lut_asyice, & ! used by RRTGMP cloud optics - pade_extliq, & ! used by RRTGMP cloud optics - pade_ssaliq, & ! used by RRTGMP cloud optics - pade_asyliq ! used by RRTGMP cloud optics - real(kind_phys), dimension(:,:,:,:), allocatable :: & - kmajor, & ! used by RRTGMP gas optics - planck_frac, & ! used by RRTGMP gas optics - pade_extice, & ! used by RRTGMP cloud optics - pade_ssaice, & ! used by RRTGMP cloud optics - pade_asyice ! used by RRTGMP cloud optics - character(len=32), dimension(:), allocatable :: & - gas_names, & ! used by RRTGMP gas optics - gas_minor, & ! used by RRTGMP gas optics - identifier_minor, & ! used by RRTGMP gas optics - minor_gases_lower, & ! used by RRTGMP gas optics - minor_gases_upper, & ! used by RRTGMP gas optics - scaling_gas_lower, & ! used by RRTGMP gas optics - scaling_gas_upper ! used by RRTGMP gas optics - logical(wl), dimension(:), allocatable :: & - minor_scales_with_density_lower, & ! used by RRTGMP gas optics - minor_scales_with_density_upper, & ! used by RRTGMP gas optics - scale_by_complement_lower, & ! used by RRTGMP gas optics - scale_by_complement_upper ! used by RRTGMP gas optics - - ! Dimensions (to be broadcast across all processors) - integer :: & - ntemps, & ! used by RRTGMP gas optics - npress, & ! used by RRTGMP gas optics - nabsorbers, & ! used by RRTGMP gas optics - nextrabsorbers, & ! used by RRTGMP gas optics - nminorabsorbers, & ! used by RRTGMP gas optics - nmixingfracs, & ! used by RRTGMP gas optics - nlayers, & ! used by RRTGMP gas optics - nbnds, & ! used by RRTGMP gas optics - ngpts, & ! used by RRTGMP gas optics - npairs, & ! used by RRTGMP gas optics - ninternalSourcetemps, & ! used by RRTGMP gas optics - nminor_absorber_intervals_lower, & ! used by RRTGMP gas optics - nminor_absorber_intervals_upper, & ! used by RRTGMP gas optics - ncontributors_lower, & ! used by RRTGMP gas optics - ncontributors_upper, & ! used by RRTGMP gas optics - nbandLWcldy, & ! used by RRTGMP cloud optics - nsize_liq, & ! used by RRTGMP cloud optics - nsize_ice, & ! used by RRTGMP cloud optics - nsizereg, & ! used by RRTGMP cloud optics - ncoeff_ext, & ! used by RRTGMP cloud optics - ncoeff_ssa_g, & ! used by RRTGMP cloud optics - nbound, & ! used by RRTGMP cloud optics - npairsLWcldy ! used by RRTGMP cloud optics - - ! Local variables - integer :: ncid_lw,dimID,varID,status,igpt,iGas,ij,ierr,ncid_lw_clds - integer,dimension(:),allocatable :: temp1,temp2,temp3,temp4,temp_log_array1,& - temp_log_array2, temp_log_array3, temp_log_array4 - character(len=264) :: kdist_file,kdist_cldy_file - integer,parameter :: max_strlen=256 - - ! Initialize - errmsg = '' - errflg = 0 - - ! Ensure that requested cloud overlap is reasonable. - if ( iovrlw .lt. 0 .or. iovrlw .gt. 3 ) then - print *,' *** Error in specification of cloud overlap flag', & - ' IOVRLW=',iovrlw,' in RLWINIT !!' - stop - elseif ( iovrlw .ge. 2 .and. isubclw .eq. 0 ) then - print *,' *** IOVRLW=',iovrlw,' is not available for', & - ' ISUBCLW=0 setting!!' - print *,' The program uses maximum/random overlap', & - ' instead.' - iovrlw = 1 - endif - - ! Check cloud flags for consistency. - if ((icldflg .eq. 0 .and. ilwcliq .ne. 0) .or. & - (icldflg .eq. 1 .and. ilwcliq .eq. 0)) then - print *,' *** Model cloud scheme inconsistent with LW', & - ' radiation cloud radiative property setup !!' - stop - endif - - ! How are we handling cloud-optics? - rrtmgp_lw_cld_phys = Model%rrtmgp_cld_phys - - ! Filenames are set in the gfs_physics_nml (scm/src/GFS_typedefs.F90) - kdist_file = trim(Model%rrtmgp_root)//trim(Model%kdist_lw_file_gas) - kdist_cldy_file = trim(Model%rrtmgp_root)//trim(Model%kdist_lw_file_clouds) - - ! Read dimensions for k-distribution fields (only on master processor(0)) - if (mpirank .eq. mpiroot) then - if(nf90_open(trim(kdist_file), NF90_WRITE, ncid_lw) .eq. NF90_NOERR) then - status = nf90_inq_dimid(ncid_lw, 'temperature', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=ntemps) - status = nf90_inq_dimid(ncid_lw, 'pressure', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=npress) - status = nf90_inq_dimid(ncid_lw, 'absorber', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=nabsorbers) - status = nf90_inq_dimid(ncid_lw, 'minor_absorber', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=nminorabsorbers) - status = nf90_inq_dimid(ncid_lw, 'absorber_ext', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=nextrabsorbers) - status = nf90_inq_dimid(ncid_lw, 'mixing_fraction', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=nmixingfracs) - status = nf90_inq_dimid(ncid_lw, 'atmos_layer', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=nlayers) - status = nf90_inq_dimid(ncid_lw, 'bnd', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=nbnds) - status = nf90_inq_dimid(ncid_lw, 'gpt', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=ngpts) - status = nf90_inq_dimid(ncid_lw, 'pair', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=npairs) - status = nf90_inq_dimid(ncid_lw, 'contributors_lower', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=ncontributors_lower) - status = nf90_inq_dimid(ncid_lw, 'contributors_upper', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=ncontributors_upper) - status = nf90_inq_dimid(ncid_lw, 'minor_absorber_intervals_lower', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=nminor_absorber_intervals_lower) - status = nf90_inq_dimid(ncid_lw, 'minor_absorber_intervals_upper', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=nminor_absorber_intervals_upper) - status = nf90_inq_dimid(ncid_lw, 'temperature_Planck', dimid) - status = nf90_inquire_dimension(ncid_lw, dimid, len=ninternalSourcetemps) - status = nf90_close(ncid_lw) - endif - endif - - ! Broadcast dimensions to all processors -#ifdef MPI - call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nextraabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ngpts, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) -#endif - - !if (mpirank .eq. mpiroot) then - ! 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(temp1(nminor_absorber_intervals_lower)) - allocate(temp2(nminor_absorber_intervals_upper)) - allocate(temp3(nminor_absorber_intervals_lower)) - allocate(temp4(nminor_absorber_intervals_upper)) - allocate(totplnk(ninternalSourcetemps, nbnds)) - allocate(planck_frac(ngpts, nmixingfracs, npress+1, ntemps)) - - if (mpirank .eq. mpiroot) then - ! Read in fields from file - if(nf90_open(trim(kdist_file), NF90_WRITE, ncid_lw) .eq. NF90_NOERR) then - status = nf90_inq_varid(ncid_lw,'gas_names',varID) - status = nf90_get_var(ncid_lw,varID,gas_names) - ! - status = nf90_inq_varid(ncid_lw,'scaling_gas_lower',varID) - status = nf90_get_var(ncid_lw,varID,scaling_gas_lower) - ! - status = nf90_inq_varid(ncid_lw,'scaling_gas_upper',varID) - status = nf90_get_var(ncid_lw,varID,scaling_gas_upper) - ! - status = nf90_inq_varid(ncid_lw,'gas_minor',varID) - status = nf90_get_var(ncid_lw,varID,gas_minor) - ! - status = nf90_inq_varid(ncid_lw,'identifier_minor',varID) - status = nf90_get_var(ncid_lw,varID,identifier_minor) - ! - status = nf90_inq_varid(ncid_lw,'minor_gases_lower',varID) - status = nf90_get_var(ncid_lw,varID,minor_gases_lower) - ! - status = nf90_inq_varid(ncid_lw,'minor_gases_upper',varID) - status = nf90_get_var(ncid_lw,varID,minor_gases_upper) - ! - status = nf90_inq_varid(ncid_lw,'minor_limits_gpt_lower',varID) - status = nf90_get_var(ncid_lw,varID,minor_limits_gpt_lower) - ! - status = nf90_inq_varid(ncid_lw,'minor_limits_gpt_upper',varID) - status = nf90_get_var(ncid_lw,varID,minor_limits_gpt_upper) - ! - status = nf90_inq_varid(ncid_lw,'bnd_limits_gpt',varID) - status = nf90_get_var(ncid_lw,varID,band2gpt) - ! - status = nf90_inq_varid(ncid_lw,'key_species',varID) - status = nf90_get_var(ncid_lw,varID,key_species) - ! - status = nf90_inq_varid(ncid_lw,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid_lw,varID,band_lims) - ! - status = nf90_inq_varid(ncid_lw,'press_ref',varID) - status = nf90_get_var(ncid_lw,varID,press_ref) - ! - status = nf90_inq_varid(ncid_lw,'temp_ref',varID) - status = nf90_get_var(ncid_lw,varID,temp_ref) - ! - status = nf90_inq_varid(ncid_lw,'absorption_coefficient_ref_P',varID) - status = nf90_get_var(ncid_lw,varID,temp_ref_p) - ! - status = nf90_inq_varid(ncid_lw,'absorption_coefficient_ref_T',varID) - status = nf90_get_var(ncid_lw,varID,temp_ref_t) - ! - status = nf90_inq_varid(ncid_lw,'press_ref_trop',varID) - status = nf90_get_var(ncid_lw,varID,press_ref_trop) - ! - status = nf90_inq_varid(ncid_lw,'kminor_lower',varID) - status = nf90_get_var(ncid_lw,varID,kminor_lower) - ! - status = nf90_inq_varid(ncid_lw,'kminor_upper',varID) - status = nf90_get_var(ncid_lw,varID,kminor_upper) - ! - status = nf90_inq_varid(ncid_lw,'vmr_ref',varID) - status = nf90_get_var(ncid_lw,varID,vmr_ref) - ! - status = nf90_inq_varid(ncid_lw,'kmajor',varID) - status = nf90_get_var(ncid_lw,varID,kmajor) - ! - status = nf90_inq_varid(ncid_lw,'kminor_start_lower',varID) - status = nf90_get_var(ncid_lw,varID,kminor_start_lower) - ! - status = nf90_inq_varid(ncid_lw,'kminor_start_upper',varID) - status = nf90_get_var(ncid_lw,varID,kminor_start_upper) - ! - status = nf90_inq_varid(ncid_lw,'totplnk',varID) - status = nf90_get_var(ncid_lw,varID,totplnk) - ! - status = nf90_inq_varid(ncid_lw,'plank_fraction',varID) - status = nf90_get_var(ncid_lw,varID,planck_frac) - - ! Logical fields are read in as integers and then converted to logicals. - status = nf90_inq_varid(ncid_lw,'minor_scales_with_density_lower',varID) - status = nf90_get_var(ncid_lw,varID,temp1) - minor_scales_with_density_lower(:) = .false. - where(temp1 .eq. 1) minor_scales_with_density_lower(:) = .true. - ! - status = nf90_inq_varid(ncid_lw,'minor_scales_with_density_upper',varID) - status = nf90_get_var(ncid_lw,varID,temp2) - minor_scales_with_density_upper(:) = .false. - where(temp2 .eq. 1) minor_scales_with_density_upper(:) = .true. - ! - status = nf90_inq_varid(ncid_lw,'scale_by_complement_lower',varID) - status = nf90_get_var(ncid_lw,varID,temp3) - scale_by_complement_lower(:) = .false. - where(temp3 .eq. 1) scale_by_complement_lower(:) = .true. - ! - status = nf90_inq_varid(ncid_lw,'scale_by_complement_upper',varID) - status = nf90_get_var(ncid_lw,varID,temp4) - scale_by_complement_upper(:) = .false. - where(temp4 .eq. 1) scale_by_complement_upper(:) = .true. - - ! Close - status = nf90_close(ncid_lw) - endif - endif - - ! Broadcast arrays to all processors -#ifdef MPI - call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims, size(band_lims), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(press_ref, size(press_ref), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(temp_ref, size(temp_ref), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(kminor_lower, size(kminor_lower), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(kminor_upper, size(kminor_upper), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(vmr_ref, size(vmr_ref), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(kmajor, size(kmajor), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(temp_ref_p, 1, kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(temp_ref_t, 1, kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(press_ref_trop, 1, kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(totplnk, size(totplnk), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(planck_frac, size(planck_frac), kind_phys, mpiroot, mpicomm, ierr) - ! Character arrays - do ij=1,nabsorbers - call MPI_BCAST(gas_names(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) - enddo - do ij=1,nminorabsorbers - call MPI_BCAST(gas_minor(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) - call MPI_BCAST(identifier_minor(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) - enddo - do ij=1,nminor_absorber_intervals_lower - call MPI_BCAST(minor_gases_lower(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) - enddo - do ij=1,nminor_absorber_intervals_upper - call MPI_BCAST(minor_gases_upper(ij), 32, MPI_CHAR, mpiroot, mpicomm, ierr) - enddo - ! Logical arrays (First convert to integer-array, then broadcast) - ! - allocate(temp_log_array1(nminor_absorber_intervals_lower)) - where(minor_scales_with_density_lower) - temp_log_array1 = 1 - elsewhere - temp_log_array1 = 0 - end where - call MPI_BCAST(temp_log_array1, size(temp_log_array1), MPI_INTEGER, mpiroot, mpicomm, ierr) - ! - allocate(temp_log_array2(nminor_absorber_intervals_lower)) - where(scale_by_complement_lower) - temp_log_array2 = 1 - elsewhere - temp_log_array2 = 0 - end where - call MPI_BCAST(temp_log_array2, size(temp_log_array2), MPI_INTEGER, mpiroot, mpicomm, ierr) - ! - allocate(temp_log_array3(nminor_absorber_intervals_upper)) - where(minor_scales_with_density_upper) - temp_log_array3 = 1 - elsewhere - temp_log_array3 = 0 - end where - call MPI_BCAST(temp_log_array3, size(temp_log_array3), MPI_INTEGER, mpiroot, mpicomm, ierr) - ! - allocate(temp_log_array4(nminor_absorber_intervals_upper)) - where(scale_by_complement_upper) - temp_log_array4 = 1 - elsewhere - temp_log_array4 = 0 - end where - call MPI_BCAST(temp_log_array4, size(temp_log_array4), MPI_INTEGER, mpiroot, mpicomm, ierr) -#endif - - ! Initialize gas concentrations and gas optics class with data - do iGas=1,nGases - call check_error_msg(gas_concentrations%set_vmr(active_gases(iGas), 0._kind_phys)) - enddo - call check_error_msg(kdist_lw%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, & - totplnk, planck_frac, rayl_lower, rayl_upper)) - - ! Set band index by g-point array - nBandsLW = kdist_lw%get_nband() - nGptsLW = kdist_lw%get_ngpt() - ngb_LW = kdist_lw%get_gpoint_bands() - - ! Set initial permutation seed for McICA, initially set to number of G-points - ipsdlw0 = kdist_lw%get_ngpt() - - ! ####################################################################################### - ! If RRTMGP cloud-optics are requested, read tables and broadcast. - ! ####################################################################################### - ! Read dimensions for k-distribution fields (only on master processor(0)) - if (mpirank .eq. mpiroot) then - if(nf90_open(trim(kdist_cldy_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) - 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 - endif - - ! Broadcast dimensions to all processors -#ifdef MPI - if (rrtmgp_lw_cld_phys .eq. 1 .or. rrtmgp_lw_cld_phys .eq. 2) then - call MPI_BCAST(nbandLWcldy, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nrghice, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nsize_liq, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nsize_ice, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nsizereg, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ncoeff_ext, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ncoeff_ssa_g, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nbound, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(npairsLWcldy, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - endif -#endif - - if (rrtmgp_lw_cld_phys .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)) - allocate(lut_ssaice(nsize_ice, nBandLWcldy, nrghice)) - allocate(lut_asyice(nsize_ice, nBandLWcldy, nrghice)) - allocate(band_lims_cldy(2, nBandLWcldy)) - endif - if (rrtmgp_lw_cld_phys .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)) - allocate(pade_ssaice(nbandLWcldy, nsizereg, ncoeff_ssa_g, nrghice)) - allocate(pade_asyice(nbandLWcldy, 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)) - allocate(band_lims_cldy(2,nbandLWcldy)) - endif - - ! On master processor, allocate space, read in fields, broadcast to all processors - if (mpirank .eq. mpiroot) then - ! - if (rrtmgp_lw_cld_phys .eq. 1) then - ! - if(nf90_open(trim(kdist_cldy_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 - endif - ! - if (rrtmgp_lw_cld_phys .eq. 2) then - ! - if(nf90_open(trim(kdist_cldy_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 - endif - endif - - ! Broadcast arrays to all processors -#ifdef MPI - if (rrtmgp_lw_cld_phys .eq. 1) then - call MPI_BCAST(radliq_lwr, size(radliq_lwr), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_upr, size(radliq_upr), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_fac, size(radliq_fac), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_lwr, size(radice_lwr), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_upr, size(radice_upr), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_fac, size(radice_fac), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extliq, size(lut_extliq), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaliq, size(lut_ssaliq), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyliq, size(lut_asyliq), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extice, size(lut_extice), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaice, size(lut_ssaice), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyice, size(lut_asyice), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy), size(band_lims_cldy), kind_phys, mpiroot, mpicomm, ierr) - endif - if (rrtmgp_lw_cld_phys .eq. 2) then - call MPI_BCAST(pade_extliq, size(pade_extliq), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyliq, size(pade_asyliq), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_extice, size(pade_extice), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaice, size(pade_ssaice), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyice, size(pade_asyice), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extliq), size(pade_sizereg_extliq), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaliq), size(pade_sizereg_ssaliq), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyliq), size(pade_sizereg_asyliq), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extice), size(pade_sizereg_extice), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaice), size(pade_sizereg_ssaice), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyice), size(pade_sizereg_asyice), kind_phys, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy), size(band_lims_cldy), kind_phys, mpiroot, mpicomm, ierr) - endif -#endif - - ! Load tables data for RRTGMP cloud-optics - if (rrtmgp_lw_cld_phys .eq. 1) then - call check_error_msg(kdist_lw_cldy%set_ice_roughness(nrghice)) - call check_error_msg(kdist_lw_cldy%load(band_lims_cldy, 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 (rrtmgp_lw_cld_phys .eq. 2) then - call check_error_msg(kdist_lw_cldy%set_ice_roughness(nrghice)) - call check_error_msg(kdist_lw_cldy%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, & - pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) - endif - - end subroutine GFS_rrtmgp_lw_init - - ! ######################################################################################### - ! rrtmg_lw_run - ! ######################################################################################### -!! \section arg_table_GFS_rrtmgp_lw_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |--------------------|-----------------------------------------------------------------------------------------------|---------------------------------------------------------------------------|---------|------|----------------------|-----------|--------|----------| -!! | p_lay | air_pressure_at_layer_for_radiation_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | -!! | p_lev | air_pressure_at_interface_for_radiation_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | t_lay | air_temperature_at_layer_for_radiation | air temperature layer | K | 2 | real | kind_phys | in | F | -!! | t_lev | air_temperature_at_interface_for_radiation | air temperature level | K | 2 | real | kind_phys | in | F | -!! | q_lay | water_vapor_specific_humidity_at_layer_for_radiation | specific humidity layer | kg kg-1 | 2 | real | kind_phys | in | F | -!! | o3_lay | ozone_concentration_at_layer_for_radiation | ozone concentration layer | kg kg-1 | 2 | real | kind_phys | in | F | -!! | vmr_co2 | volume_mixing_ratio_co2 | volume mixing ratio co2 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | vmr_n2o | volume_mixing_ratio_n2o | volume mixing ratio no2 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | vmr_ch4 | volume_mixing_ratio_ch4 | volume mixing ratio ch4 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | vmr_o2 | volume_mixing_ratio_o2 | volume mixing ratio o2 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | vmr_co | volume_mixing_ratio_co | volume mixing ratio co | kg kg-1 | 2 | real | kind_phys | in | F | -!! | vmr_cfc11 | volume_mixing_ratio_cfc11 | volume mixing ratio cfc11 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | vmr_cfc12 | volume_mixing_ratio_cfc12 | volume mixing ratio cfc12 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | vmr_cfc22 | volume_mixing_ratio_cfc22 | volume mixing ratio cfc22 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | vmr_ccl4 | volume_mixing_ratio_ccl4 | volume mixing ratio ccl4 | kg kg-1 | 2 | real | kind_phys | in | F | -!! | icseed | seed_random_numbers_lw | seed for random number generation for longwave radiation | none | 1 | integer | | in | F | -!! | tau_aer | aerosol_optical_depth_for_longwave_bands_01-16 | aerosol optical depth for longwave bands 01-16 | none | 3 | real | kind_phys | in | F | -!! | ssa_aer | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | frac | 3 | real | kind_phys | in | F | -!! | sfc_emiss | surface_longwave_emissivity | surface emissivity | frac | 1 | real | kind_phys | in | F | -!! | skt | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | dzlyr | layer_thickness_for_radiation | layer thickness | km | 2 | real | kind_phys | in | F | -!! | delpin | layer_pressure_thickness_for_radiation | layer pressure thickness | hPa | 2 | real | kind_phys | in | F | -!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | in | F | -!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | -!! | nlay | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F | -!! | lprint | flag_print | flag to print | flag | 0 | logical | | in | F | -!! | cldfrac | total_cloud_fraction | total cloud fraction | frac | 2 | real | kind_phys | in | F | -!! | lslwr | flag_to_calc_lw | flag to calculate LW irradiances | flag | 0 | logical | | in | F | -!! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_liq | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | in | T | -!! | cld_iwp | cloud_ice_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_ice | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | in | T | -!! | cld_rwp | cloud_rain_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_rain | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | in | T | -!! | cld_swp | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | in | T | -!! | cld_ref_snow | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | in | T | -!! | cld_od | cloud_optical_depth | cloud optical depth | none | 2 | real | kind_phys | in | T | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! | kdist_lw | K_distribution_file_for_RRTMGP_LW_scheme | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | -!! | kdist_lw_cldy | K_distribution_file_for_cloudy_RRTMGP_LW_scheme | DDT containing spectral information for cloudy RRTMGP LW radiation scheme | DDT | 0 | ty_cloud_optics | | in | F | -!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | inout | F | -!! - ! ######################################################################################### - subroutine GFS_rrtmgp_lw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr_n2o, & ! IN - vmr_ch4, vmr_o2, vmr_co, vmr_cfc11, vmr_cfc12, vmr_cfc22, vmr_ccl4, icseed, tau_aer, & ! IN - ssa_aer, sfc_emiss, skt, dzlyr, delpin, de_lgth, ncol, nlay, lprint, cldfrac, lslwr, & ! IN - kdist_lw, kdist_lw_cldy, gas_concentrations, & ! OUT - cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, & ! OPT(in) - cld_ref_snow, cld_od, errmsg, errflg) ! OPT(in) - - ! Inputs - integer,intent(in) :: & - ncol, & ! Number of horizontal grid-points - nlay ! Number of vertical layers - integer,intent(in),dimension(ncol) :: & - icseed ! auxiliary special cloud related array when module - ! variable isubclw=2, it provides permutation seed - ! for each column profile that are used for generating - ! random numbers. when isubclw /=2, it will not be used. - logical,intent(in) :: & - lprint, & ! Control flag for diagnostics - lslwr ! Flag to calculate RRTMGP LW? (1) - type(ty_gas_optics_rrtmgp),intent(in) :: & - kdist_lw ! DDT containing LW spectral information - type(ty_cloud_optics),intent(in) :: & - kdist_lw_cldy - type(ty_gas_concs),intent(inout) :: & - gas_concentrations - real(kind_phys), dimension(ncol), intent(in) :: & - sfc_emiss, & ! Surface emissivity (1) - skt, & ! Surface(skin) temperature (K) - de_lgth ! Cloud decorrelation length (km) - real(kind_phys), dimension(ncol,nlay), intent(in) :: & - dzlyr, & ! layer thinkness (km) - delpin, & ! layer thickness (mb) - cldfrac, & ! Cloud-fraction (1) - p_lay, & ! Pressure @ model layer-centers (mb) - t_lay, & ! Temperature (K) - q_lay, & ! Specific humidity (kg/kg) - o3_lay, & ! O3 mass mixing-ratio (kg/kg) - vmr_co2, & ! Co2 volume-mixing ratio (kg/kg) - vmr_n2o, & ! N2o volume-mixing ratio (kg/kg) - vmr_ch4, & ! Ch4 volume-mixing ratio (kg/kg) - vmr_o2, & ! O2 volume-mixing ratio (kg/kg) - vmr_co, & ! Co volume-mixing ratio (kg/kg) - vmr_cfc11, & ! CFC11 volume-mixing ratio (kg/kg) - vmr_cfc12, & ! CFC12 volume-mixing ratio (kg/kg) - vmr_cfc22, & ! CFC22 volume-mixing ratio (kg/kg) - vmr_ccl4 ! CCl4 volume-mixing ratio (kg/kg) - real(kind_phys), dimension(ncol,nlay+1), intent(in) :: & - p_lev, & ! Pressure @ model layer-interfaces (mb) - t_lev ! Temperature (K) - real(kind_phys), dimension(ncol,nlay,nbandsLW),intent(in) :: & - tau_aer, & ! Aerosol optical depth (1) - ssa_aer ! Aerosol single-scattering albedo (1) - ! Inputs (optional) - real(kind_phys), dimension(ncol,nlay), intent(in), optional:: & - cld_lwp, & ! Cloud liquid water path (g/m2) - cld_ref_liq, & ! Effective radius (liquid) (micron) - cld_iwp, & ! Cloud ice water path (g/m2) - cld_ref_ice, & ! Effective radius (ice) (micron) - cld_rwp, & ! Cloud rain water path (g/m2) - cld_ref_rain, & ! Effective radius (rain-drop) (micron) - cld_swp, & ! Cloud snow-water path (g/m2) - cld_ref_snow, & ! Effective radius (snow-flake) (micron) - cld_od ! Cloud optical-depth (1) - - ! Outputs (mandatory) - character(len=*), intent(out) :: & - errmsg ! Error message - integer, intent(out) :: & - errflg ! Error code - - ! Local variables - integer :: iGpt,iCol,iLay,iBand,iTOA,iSFC - integer,dimension(ncol) :: ipseed - real(kind_phys), dimension(ncol,nlay+1),target :: & - flux_up_allSky, flux_up_clrSky, flux_dn_allSky, flux_dn_clrSky - real(kind_phys), dimension(ncol,nlay+1,nBandsLW),target :: & - fluxBB_up_allSky, fluxBB_dn_allSky - real(kind_phys), dimension(ncol,nlay) :: & - vmr_o3, vmr_h2o, thetaTendClrSky,thetaTendAllSky, cld_ref_liq2, & - cld_ref_ice2,tau_snow,tau_rain - real(kind_phys), dimension(ncol,nlay,nBandsLW) :: & - tau_cld,thetaTendByBandAllSky - real(kind_phys), dimension(nGptsLW,nlay,ncol) :: & - rng3D - real(kind_phys), dimension(nGptsLW*nLay) :: & - rng1D - logical,dimension(ncol,nlay) :: & - liqmask,icemask - logical, dimension(ncol,nlay,nGptsLW) :: & - cldfracMCICA - logical :: & - top_at_1=.false. - - ! Types used by Random Number Generator - type(random_stat) :: rng_stat - - ! RTE+RRTMGP classes - type(ty_optical_props_1scl) :: & - optical_props_clr, & ! Optical properties for gaseous atmosphere - optical_props_cldy, & ! Optical properties for clouds (by band) - optical_props_mcica,& ! Optical properties for clouds (sampled) - optical_props_aer ! Optical properties for aerosols - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - if (.not. lslwr) return - - ! Some consistency checks... - - ! Check for optional input arguments, this depends on cloud method - if (ilwcliq > 0) then ! use prognostic cloud method - if (.not. present(cld_lwp) .or. .not. present(cld_ref_liq) .or. & - .not. present(cld_iwp) .or. .not. present(cld_ref_ice) .or. & - .not. present(cld_rwp) .or. .not. present(cld_ref_rain) .or. & - .not. present(cld_swp) .or. .not. present(cld_ref_snow)) then - write(errmsg,'(*(a))') & - 'Logic error: ilwcliq>0 requires the following', & - ' optional arguments to be present:', & - ' cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice,', & - ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow' - errflg = 1 - return - end if - else ! use diagnostic cloud method - if (.not. present(cld_od) ) then - write(errmsg,'(*(a))') & - 'Logic error: ilwcliq<=0 requires the following', & - ' optional argument to be present: cld_od' - errflg = 1 - return - end if - end if - - ! Change random number seed value for each radiation invocation (isubclw =1 or 2). - if(isubclw == 1) then ! advance prescribed permutation seed - do iCol = 1, ncol - ipseed(iCol) = ipsdlw0 + iCol - enddo - elseif (isubclw == 2) then ! use input array of permutaion seeds - do iCol = 1, ncol - ipseed(iCol) = icseed(iCol) - enddo - endif - - ! Compute volume mixing-ratios for ozone (mmr) and specific-humidity. - vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) - vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) - - ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics - liqmask = (cldfrac .gt. 0 .and. cld_lwp .gt. 0) - icemask = (cldfrac .gt. 0 .and. cld_iwp .gt. 0) - - ! RRTMGP cloud_optics expects particle size to be in a certain range. bound here - if (rrtmgp_lw_cld_phys .gt. 0) then - cld_ref_ice2 = cld_ref_ice - where(cld_ref_ice2 .gt. kdist_lw_cldy%get_max_radius_ice()) cld_ref_ice2=kdist_lw_cldy%get_max_radius_ice() - where(cld_ref_ice2 .lt. kdist_lw_cldy%get_min_radius_ice()) cld_ref_ice2=kdist_lw_cldy%get_min_radius_ice() - cld_ref_liq2 = cld_ref_liq - where(cld_ref_liq2 .gt. kdist_lw_cldy%get_max_radius_liq()) cld_ref_liq2=kdist_lw_cldy%get_max_radius_liq() - where(cld_ref_liq2 .lt. kdist_lw_cldy%get_min_radius_liq()) cld_ref_liq2=kdist_lw_cldy%get_min_radius_liq() - endif - - ! ####################################################################################### - ! Call RRTMGP - ! ####################################################################################### - ! Allocate space for source functions and gas optical properties [ncol,nlay,ngpts] - call check_error_msg(optical_props_clr%alloc_1scl( nCol, nLay, kdist_lw)) - call check_error_msg(optical_props_mcica%alloc_1scl(nCol, nLay, kdist_lw)) - ! Cloud optics [nCol,nLay,nBands] - call check_error_msg(optical_props_cldy%init(optical_props_clr%get_band_lims_wavenumber())) - call check_error_msg(optical_props_cldy%alloc_1scl(ncol,nlay)) - ! Aerosol optics [Ccol,nLay,nBands] - call check_error_msg(optical_props_aer%init(optical_props_clr%get_band_lims_wavenumber())) - call check_error_msg(optical_props_aer%alloc_1scl(ncol,nlay)) - - ! ####################################################################################### - ! Set gas concentrations - ! ####################################################################################### - call gas_concentrations%reset() - call check_error_msg(gas_concentrations%set_vmr('o2', vmr_o2)) - call check_error_msg(gas_concentrations%set_vmr('co2', vmr_co2)) - call check_error_msg(gas_concentrations%set_vmr('ch4', vmr_ch4)) - call check_error_msg(gas_concentrations%set_vmr('n2o', vmr_n2o)) - call check_error_msg(gas_concentrations%set_vmr('h2o', vmr_h2o)) - call check_error_msg(gas_concentrations%set_vmr('o3', vmr_o3)) - - ! ####################################################################################### - ! Copy aerosol to RRTMGP DDT - ! ####################################################################################### - optical_props_aer%tau = tau_aer * (1. - ssa_aer) - - ! ####################################################################################### - ! Compute cloud-optics for RTE. - ! ####################################################################################### - - ! Compute in-cloud radiative properties - if (any(cldfrac .gt. 0)) then - ! i) RRTMG cloud optics. - ! If using RRTMG cloud-physics. Model can provide either cloud-optics (cld_od) or - ! cloud-properties by type (cloud LWP,snow effective radius, etc...) - if (rrtmgp_lw_cld_phys .eq. 0) then - ! Cloud-optical properties by type provided. - if (.not. present(cld_od)) then - call rrtmgp_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld_iwp, & - cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cldfrac, tau_cld) - optical_props_cldy%tau = tau_cld - else - ! Cloud-optical depth provided. - do iCol=1,ncol - do iLay=1,nlay - if (cldfrac(iCol,iLay) .gt. 1e-20_kind_phys) then - optical_props_cldy%tau(iCol,iLay,:) = cld_od(iCol,iLay) - else - optical_props_cldy%tau(iCol,iLay,:) = 0._kind_phys - endif - end do - end do - endif - endif - - ! ii) Use RRTMGP cloud-optics. - if (rrtmgp_lw_cld_phys .gt. 0) then - call check_error_msg(kdist_lw_cldy%cloud_optics(ncol, nlay, nBandsLW, nrghice, & - liqmask, icemask, cld_lwp, cld_iwp, cld_ref_liq2, cld_ref_ice2, optical_props_cldy)) - end if - endif - - ! ####################################################################################### - ! Call McICA to generate subcolumns. - ! ####################################################################################### - if (isubclw .gt. 0) then - - ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points - ! and layers. ([nGpts,nLayer,nColumn]-> [nGpts*nLayer]*nColumn) - do iCol=1,nCol - call random_setseed(ipseed(icol),rng_stat) - call random_number(rng1D,rng_stat) - rng3D(:,:,iCol) = reshape(source = rng1D,shape=[nGptsLW,nLay]) - enddo - - ! Call McICA - select case ( iovrlw ) - ! Maximumn-random - case(1) - call check_error_msg(sampled_mask_max_ran(rng3D,cldfrac,cldfracMCICA)) - end select - - ! Map band optical depth to each g-point using McICA - call check_error_msg(draw_samples(cldfracMCICA,optical_props_cldy,optical_props_mcica)) - endif - - end subroutine GFS_rrtmgp_lw_run - ! - subroutine GFS_rrtmgp_lw_finalize() - end subroutine GFS_rrtmgp_lw_finalize - - ! ######################################################################################### - ! Ancillary functions - ! ######################################################################################### - subroutine check_error_msg(error_msg) - character(len=*), intent(in) :: error_msg - - if(error_msg /= "") then - print*,"ERROR(GFS_rrtmgp_lw_main.F90): " - print*,trim(error_msg) - return - end if - end subroutine check_error_msg - - -end module GFS_rrtmgp_lw diff --git a/physics/GFS_rrtmgp_lw.xml b/physics/GFS_rrtmgp_lw.xml deleted file mode 100644 index 6016a67a1..000000000 --- a/physics/GFS_rrtmgp_lw.xml +++ /dev/null @@ -1,470 +0,0 @@ - - - - - - GFS_control_type_instance - Fortran DDT containing FV3-GFS model control parameters - DDT - Model - GFS_control_type - - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_init - - - mpi_rank - current MPI rank - index - mpirank - integer - - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_init - - - mpi_root - master MPI rank - index - mpiroot - integer - - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_init - - - mpi_comm - MPI communicator - index - mpicomm - integer - - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_init - - - ccpp_error_message - error message for error handling in CCPP - none - errmsg - character - - out - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_init - - - ccpp_error_flag - error flag for error handling in CCPP - flag - errflg - integer - - out - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_init - - - - - air_pressure_at_layer_for_radiation_in_hPa - air pressure layer - hPa - p_lay - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - air_pressure_at_interface_for_radiation_in_hPa - air pressure level - hPa - p_lev - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - air_temperature_at_layer_for_radiation - air temperature layer - K - t_lay - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - air_temperature_at_interface_for_radiation - air temperature level - K - t_lev - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - water_vapor_specific_humidity_at_layer_for_radiation - specific humidity layer - kg kg-1 - q_lay - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - ozone_concentration_at_layer_for_radiation - ozone concentration layer - kg kg-1 - o3_lay - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - volume_mixing_ratio_co2 - volume mixing ratio co2 - kg kg-1 - vmr_co2 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - volume_mixing_ratio_n2o - volume mixing ratio no2 - kg kg-1 - vmr_n2o - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - volume_mixing_ratio_ch4 - volume mixing ratio ch4 - kg kg-1 - vmr_ch4 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - volume_mixing_ratio_o2 - volume mixing ratio o2 - kg kg-1 - vmr_o2 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - volume_mixing_ratio_co - volume mixing ratio co - kg kg-1 - vmr_co - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - volume_mixing_ratio_cfc11 - volume mixing ratio cfc11 - kg kg-1 - vmr_cfc11 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - volume_mixing_ratio_cfc12 - volume mixing ratio cfc12 - kg kg-1 - vmr_cfc12 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - volume_mixing_ratio_cfc22 - volume mixing ratio cfc22 - kg kg-1 - vmr_cfc22 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - volume_mixing_ratio_ccl4 - volume mixing ratio ccl4 - kg kg-1 - vmr_ccl4 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - seed_random_numbers_lw - seed for random number generation for longwave radiation - none - icseed - integer - (:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - aerosol_optical_depth_for_longwave_bands_01-16 - aerosol optical depth for longwave bands 01-16 - none - tau_aer - real - (:,:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - aerosol_single_scattering_albedo_for_longwave_bands_01-16 - aerosol single scattering albedo for longwave bands 01-16 - frac - ssa_aer - real - (:,:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - surface_longwave_emissivity - surface emissivity - frac - sfc_emiss - real - (:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - surface_ground_temperature_for_radiation - surface ground temperature for radiation - K - skt - real - (:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - horizontal_loop_extent - horizontal dimension - count - ncol - integer - - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - adjusted_vertical_layer_dimension_for_radiation - number of vertical layers for radiation - count - nlay - integer - - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - flag_print - flag to print - flag - lprint - logical - - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - total_cloud_fraction - total cloud fraction - frac - cldfrac - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - flag_to_calc_lw - flag to calculate LW irradiances - flag - lslwr - logical - - in - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - ccpp_error_message - error message for error handling in CCPP - none - errmsg - character - - out - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - ccpp_error_flag - error flag for error handling in CCPP - flag - errflg - integer - - out - F - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - cloud_liquid_water_path - cloud liquid water path - g m-2 - cld_lwp - real - (:,:) - in - T - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - mean_effective_radius_for_liquid_cloud - mean effective radius for liquid cloud - micron - cld_ref_liq - real - (:,:) - in - T - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - cloud_ice_water_path - cloud ice water path - g m-2 - cld_iwp - real - (:,:) - in - T - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - mean_effective_radius_for_ice_cloud - mean effective radius for ice cloud - micron - cld_ref_ice - real - (:,:) - in - T - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - cloud_rain_water_path - cloud ice water path - g m-2 - cld_rwp - real - (:,:) - in - T - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - mean_effective_radius_for_rain_drop - mean effective radius for rain drop - micron - cld_ref_rain - real - (:,:) - in - T - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - cloud_snow_water_path - cloud snow water path - g m-2 - cld_swp - real - (:,:) - in - T - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - mean_effective_radius_for_snow_flake - mean effective radius for snow flake - micron - cld_ref_snow - real - (:,:) - in - T - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - cloud_optical_depth - cloud optical depth - none - cld_od - real - (:,:) - in - T - MODULE_GFS_rrtmgp_lw SCHEME_GFS_rrtmgp_lw SUBROUTINE_GFS_rrtmgp_lw_run - - - diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 deleted file mode 100644 index 65b761089..000000000 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ /dev/null @@ -1,102 +0,0 @@ -!>\file GFS_rrtmgp_lw_post -!!This file contains - module GFS_rrtmgp_lw_post - contains - -!>\defgroup GFS_rrtmgp_lw_post GFS RRTMGP scheme post -!! @{ -!> \section arg_table_GFS_rrtmgp_lw_post_init Argument Table -!! - subroutine GFS_rrtmgp_lw_post_init() - end subroutine GFS_rrtmgp_lw_post_init - -! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing -#ifndef __PGI -!> \section arg_table_GFS_rrtmgp_lw_post_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |-----------------|-----------------------------------------------------------------------------------------------|------------------------------------------------------------------------------|----------|------|-----------------------|-----------|-----------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS fields targetted for diagnostic output | DDT | 0 | GFS_radtend_type | | inout | F | -!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_coupling_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | -!! | lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | count | 0 | integer | | in | F | -!! | kd | vertical_index_difference_between_inout_and_local | vertical index difference between in/out and local | index | 0 | integer | | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | htlwc | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | total sky heating rate due to longwave radiation | K s-1 | 2 | real | kind_phys | in | F | -!! | htlw0 | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step | clear sky heating rate due to longwave radiation | K s-1 | 2 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! -#endif - subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, & - im, ltp, lm, kd, tsfa, htlwc, htlw0, errmsg, errflg) - - use machine, only: kind_phys - use GFS_typedefs, only: GFS_coupling_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type - implicit none - type(GFS_control_type), intent(in) :: Model - type(GFS_coupling_type), intent(inout) :: Coupling - type(GFS_grid_type), intent(in) :: Grid - type(GFS_radtend_type), intent(inout) :: Radtend - integer, intent(in) :: im, ltp, LM, kd - real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htlwc - real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htlw0 - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - ! local variables - integer :: k1, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (Model%lslwr) then -!> -# Save calculation results -!> - Save surface air temp for diurnal adjustment at model t-steps - - Radtend%tsflw (:) = tsfa(:) - - do k = 1, LM - k1 = k + kd - Radtend%htrlw(1:im,k) = htlwc(1:im,k1) - enddo - ! --- repopulate the points above levr - if (lm < Model%levs) then - do k = lm,Model%levs - Radtend%htrlw (1:im,k) = Radtend%htrlw (1:im,LM) - enddo - endif - - if (Model%lwhtr) then - do k = 1, lm - k1 = k + kd - Radtend%lwhc(1:im,k) = htlw0(1:im,k1) - enddo - ! --- repopulate the points above levr - if (lm < Model%levs) then - do k = lm,Model%levs - Radtend%lwhc(1:im,k) = Radtend%lwhc(1:im,LM) - enddo - endif - endif - -! --- radiation fluxes for other physics processes - Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc - - endif ! end_if_lslwr - - end subroutine GFS_rrtmgp_lw_post_run - -!> \section arg_table_GFS_rrtmgp_lw_post_finalize Argument Table -!! - subroutine GFS_rrtmgp_lw_post_finalize () - end subroutine GFS_rrtmgp_lw_post_finalize - -!! @} - end module GFS_rrtmgp_lw_post diff --git a/physics/GFS_rrtmgp_lw_post.xml b/physics/GFS_rrtmgp_lw_post.xml deleted file mode 100644 index ee9de302d..000000000 --- a/physics/GFS_rrtmgp_lw_post.xml +++ /dev/null @@ -1,150 +0,0 @@ - - - - - - - GFS_control_type_instance - Fortran DDT containing FV3-GFS model control parameters - DDT - Model - GFS_control_type - - in - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - GFS_grid_type_instance - Fortran DDT containing FV3-GFS grid and interpolation related data - DDT - Grid - GFS_grid_type - - in - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - GFS_radtend_type_instance - Fortran DDT containing FV3-GFS fields targetted for diagnostic output - DDT - Radtend - GFS_radtend_type - - inout - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - GFS_coupling_type_instance - Fortran DDT containing FV3-GFS fields to/from coupling with other components - DDT - Coupling - GFS_coupling_type - - inout - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - horizontal_loop_extent - horizontal loop extent - count - im - integer - - in - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - extra_top_layer - extra top layers - none - ltp - integer - - in - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - vertical_layer_dimension_for_radiation - number of vertical layers for radiation calculation - count - lm - integer - - in - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - vertical_index_difference_between_inout_and_local - vertical index difference between in/out and local - index - kd - integer - - in - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - surface_air_temperature_for_radiation - lowest model layer air temperature for radiation - K - tsfa - real - (:) - in - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step - total sky heating rate due to longwave radiation - K s-1 - htlwc - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step - clear sky heating rate due to longwave radiation - K s-1 - htlw0 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - ccpp_error_message - error message for error handling in CCPP - none - errmsg - character - - out - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - ccpp_error_flag - error flag for error handling in CCPP - flag - errflg - integer - - out - F - MODULE_GFS_rrtmgp_lw_post SCHEME_GFS_rrtmgp_lw_post SUBROUTINE_GFS_rrtmgp_lw_post_run - - - diff --git a/physics/GFS_rrtmgp_lw_pre.F90 b/physics/GFS_rrtmgp_lw_pre.F90 deleted file mode 100644 index 95ffc41a7..000000000 --- a/physics/GFS_rrtmgp_lw_pre.F90 +++ /dev/null @@ -1,67 +0,0 @@ -!>\file GFS_rrtmgp_lw_pre.f90 -!! This file contains a call to module_radiation_surface::setemis() to -!! setup surface emissivity for LW radiation. - module GFS_rrtmgp_lw_pre - contains - -!>\defgroup GFS_rrtmgp_lw_pre GFS RRTMGP scheme pre -!! @{ -!> \section arg_table_GFS_rrtmgp_lw_pre_init Argument Table -!! - subroutine GFS_rrtmgp_lw_pre_init () - end subroutine GFS_rrtmgp_lw_pre_init - -!> \section arg_table_GFS_rrtmgp_lw_pre_run Argument Table -!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| -!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | -!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | -!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | -!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | -!! - subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errmsg, errflg) - - use machine, only: kind_phys - - use GFS_typedefs, only: GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type, & - GFS_sfcprop_type - use module_radiation_surface, only: setemis - - implicit none - type(GFS_control_type), intent(in) :: Model - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_grid_type), intent(in) :: Grid - integer, intent(in) :: im - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (Model%lslwr) then -!> - Call module_radiation_surface::setemis(),to setup surface -!! emissivity for LW radiation. - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs - Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, IM, & - Radtend%semis) ! --- outputs - endif - - end subroutine GFS_rrtmgp_lw_pre_run - -!> \section arg_table_GFS_rrtmgp_lw_pre_finalize Argument Table -!! - subroutine GFS_rrtmgp_lw_pre_finalize () - end subroutine GFS_rrtmgp_lw_pre_finalize -!! @} - end module GFS_rrtmgp_lw_pre diff --git a/physics/GFS_rrtmgp_sw.xml b/physics/GFS_rrtmgp_sw.xml deleted file mode 100644 index de4025645..000000000 --- a/physics/GFS_rrtmgp_sw.xml +++ /dev/null @@ -1,623 +0,0 @@ - - - - - - air_pressure_at_layer_for_radiation_in_hPa - air pressure layer - hPa - p_lay - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - air_pressure_at_interface_for_radiation_in_hPa - air pressure level - hPa - p_lev - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - air_temperature_at_layer_for_radiation - air temperature layer - K - t_lay - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - air_temperature_at_interface_for_radiation - air temperature level - K - t_lev - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - water_vapor_specific_humidity_at_layer_for_radiation - specific humidity layer - kg kg-1 - q_lay - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - ozone_concentration_at_layer_for_radiation - ozone concentration layer - kg kg-1 - o3_lay - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - volume_mixing_ratio_co2 - volume mixing ratio co2 - kg kg-1 - vmr_co2 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - volume_mixing_ratio_n2o - volume mixing ratio no2 - kg kg-1 - vmr_n2o - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - volume_mixing_ratio_ch4 - volume mixing ratio ch4 - kg kg-1 - vmr_ch4 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - volume_mixing_ratio_o2 - volume mixing ratio o2 - kg kg-1 - vmr_o2 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - volume_mixing_ratio_co - volume mixing ratio co - kg kg-1 - vmr_co - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - volume_mixing_ratio_cfc11 - volume mixing ratio cfc11 - kg kg-1 - vmr_cfc11 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - volume_mixing_ratio_cfc12 - volume mixing ratio cfc12 - kg kg-1 - vmr_cfc12 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - volume_mixing_ratio_cfc22 - volume mixing ratio cfc22 - kg kg-1 - vmr_cfc22 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - volume_mixing_ratio_ccl4 - volume mixing ratio ccl4 - kg kg-1 - vmr_ccl4 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - seed_random_numbers_sw - seed for random number generation for shortwave radiation - none - icseed - integer - (:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - aerosol_optical_depth_for_shortwave_bands_01-16 - aerosol optical depth for shortwave bands 01-16 - none - tau_aer - real - (:,:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - aerosol_single_scattering_albedo_for_shortwave_bands_01-16 - aerosol single scattering albedo for shortwave bands 01-16 - frac - ssa_aer - real - (:,:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - aerosol_asymmetry_parameter_for_shortwave_bands_01-16 - aerosol asymmetry paramter for shortwave bands 01-16 - none - asy_aer - real - (:,:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - surface_albedo_due_to_near_IR_direct - surface albedo due to near IR direct beam - frac - sfcalb_nir_dir - real - (:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - surface_albedo_due_to_near_IR_diffused - surface albedo due to near IR diffused beam - frac - sfcalb_nir_dif - real - (:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - surface_albedo_due_to_UV_and_VIS_direct - surface albedo due to UV+VIS direct beam - frac - sfcalb_uvis_dir - real - (:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - surface_albedo_due_to_UV_and_VIS_diffused - surface albedo due to UV+VIS diffused beam - frac - sfcalb_uvis_dif - real - (:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - layer_thickness_for_radiation - layer thickness - km - dzlyr - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - layer_pressure_thickness_for_radiation - layer pressure thickness - hPa - delpin - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cloud_decorrelation_length - cloud decorrelation length - km - de_lgth - real - (:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cosine_of_zenith_angle - cosine of the solar zenit angle - none - cossza - real - (:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - solar_constant - solar constant - W m-2 - solcon - real - - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - daytime_points_dimension - daytime points dimension - nday - nday - integer - - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - daytime_points - daytime points - index - idxday - integer - (:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - horizontal_loop_extent - horizontal dimension - count - ncol - integer - - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - adjusted_vertical_layer_dimension_for_radiation - number of vertical layers for radiation - count - nlay - integer - - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - flag_print - flag to print - flag - lprnt - logical - - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - total_cloud_fraction - total cloud fraction - frac - cldfrac - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - flag_to_calc_sw - flag to calculate SW irradiances - flag - lsswr - logical - - in - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step - shortwave total sky heating rate - K s-1 - hswc - real - (:,:) - inout - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - sw_fluxes_top_atmosphere - shortwave total sky fluxes at the top of the atm - W m-2 - topflx - topfsw_type - (:) - inout - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - sw_fluxes_sfc - shortwave total sky fluxes at the Earth surface - W m-2 - sfcflx - sfcfsw_type - (:) - inout - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cloud_optical_depth_layers_at_0.55mu_band - approx .55mu band layer cloud optical depth - none - cldtau - real - (:,:) - inout - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step - shortwave clear sky heating rate - K s-1 - hsw0 - real - (:,:) - inout - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - sw_heating_rate_spectral - shortwave total sky heating rate (spectral) - K s-1 - hswb - real - (:,:,:) - inout - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - sw_fluxes - sw fluxes total sky / csk and up / down at levels - W m-2 - flxprf - profsw_type - (:,:) - inout - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - components_of_surface_downward_shortwave_fluxes - derived type for special components of surface downward shortwave fluxes - W m-2 - fdncmp - cmpfsw_type - (:) - inout - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cloud_liquid_water_path - cloud liquid water path - g m-2 - cld_lwp - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - mean_effective_radius_for_liquid_cloud - mean effective radius for liquid cloud - micron - cld_ref_liq - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cloud_ice_water_path - cloud ice water path - g m-2 - cld_iwp - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - mean_effective_radius_for_ice_cloud - mean effective radius for ice cloud - micron - cld_ref_ice - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cloud_rain_water_path - cloud rain water path - g m-2 - cld_rwp - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - mean_effective_radius_for_rain_drop - mean effective radius for rain drop - micron - cld_ref_rain - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cloud_snow_water_path - cloud snow water path - g m-2 - cld_swp - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - mean_effective_radius_for_snow_flake - mean effective radius for snow flake - micron - cld_ref_snow - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cloud_optical_depth - cloud optical depth - none - cld_od - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cloud_single_scattering_albedo - cloud single scattering albedo - frac - cld_ssa - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - cloud_asymmetry_parameter - cloud asymmetry parameter - none - cld_asy - real - (:,:) - in - T - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - ccpp_error_message - error message for error handling in CCPP - none - errmsg - character - - out - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - ccpp_error_flag - error flag for error handling in CCPP - flag - errflg - integer - - out - F - MODULE_GFS_rrtmgp_sw SCHEME_GFS_rrtmgp_sw SUBROUTINE_GFS_rrtmgp_sw_run - - - - diff --git a/physics/GFS_rrtmgp_sw_post.xml b/physics/GFS_rrtmgp_sw_post.xml deleted file mode 100644 index 695ab6d73..000000000 --- a/physics/GFS_rrtmgp_sw_post.xml +++ /dev/null @@ -1,216 +0,0 @@ - - - - - - - GFS_control_type_instance - Fortran DDT containing FV3-GFS model control parameters - DDT - Model - GFS_control_type - - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - GFS_grid_type_instance - Fortran DDT containing FV3-GFS grid and interpolation related data - DDT - Grid - GFS_grid_type - - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - GFS_diag_type_instance - Fortran DDT containing FV3-GFS diagnotics data - DDT - Diag - GFS_diag_type - - inout - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - GFS_radtend_type_instance - Fortran DDT containing FV3-GFS fields targetted for diagnostic output - DDT - Radtend - GFS_radtend_type - - inout - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - GFS_coupling_type_instance - Fortran DDT containing FV3-GFS fields to/from coupling with other components - DDT - Coupling - GFS_coupling_type - - inout - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - horizontal_loop_extent - horizontal loop extent - count - im - integer - - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - extra_top_layer - extra top layers - none - ltp - integer - - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - daytime_points_dimension - daytime points dimension - count - nday - integer - - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - vertical_layer_dimension_for_radiation - number of vertical layers for radiation calculation - count - lm - integer - - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - vertical_index_difference_between_inout_and_local - vertical index difference between in/out and local - index - kd - integer - - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step - total sky heating rate due to shortwave radiation - K s-1 - htswc - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step - clear sky heating rates due to shortwave radiation - K s-1 - htsw0 - real - (:,:) - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - surface_albedo_due_to_near_IR_direct - surface albedo due to near IR direct beam - frac - sfcalb1 - real - (:) - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - surface_albedo_due_to_near_IR_diffused - surface albedo due to near IR diffused beam - frac - sfcalb2 - real - (:) - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - surface_albedo_due_to_UV_and_VIS_direct - surface albedo due to UV+VIS direct beam - frac - sfcalb3 - real - (:) - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - surface_albedo_due_to_UV_and_VIS_diffused - surface albedo due to UV+VIS diffused beam - frac - sfcalb4 - real - (:) - in - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - components_of_surface_downward_shortwave_fluxes - derived type for special components of surface downward shortwave fluxes - W m-2 - scmpsw - cmpfsw_type - (:) - inout - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - ccpp_error_message - error message for error handling in CCPP - none - errmsg - character - - out - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - ccpp_error_flag - error flag for error handling in CCPP - flag - errflg - integer - - out - F - MODULE_GFS_rrtmgp_sw_post SCHEME_GFS_rrtmgp_sw_post SUBROUTINE_GFS_rrtmgp_sw_post_run - - - diff --git a/physics/GFS_rrtmgp_sw_pre.xml b/physics/GFS_rrtmgp_sw_pre.xml deleted file mode 100644 index 00f2a3164..000000000 --- a/physics/GFS_rrtmgp_sw_pre.xml +++ /dev/null @@ -1,183 +0,0 @@ - - - - - - - GFS_control_type_instance - Fortran DDT containing FV3-GFS model control parameters - DDT - Model - GFS_control_type - - in - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - GFS_grid_type_instance - Fortran DDT containing FV3-GFS grid and interpolation related data - DDT - Grid - GFS_grid_type - - in - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - GFS_sfcprop_type_instance - Fortran DDT containing FV3-GFS surface fields - DDT - Sfcprop - GFS_sfcprop_type - - in - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - GFS_radtend_type_instance - Fortran DDT containing FV3-GFS radiation tendencies - DDT - Radtend - GFS_radtend_type - - inout - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - horizontal_loop_extent - horizontal loop extent - count - im - integer - - in - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - daytime_points_dimension - daytime points dimension - count - nday - integer - - out - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - daytime_points - daytime points - index - idxday - integer - (:) - out - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - surface_ground_temperature_for_radiation - surface ground temperature for radiation - K - tsfg - real - (:) - in - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - surface_air_temperature_for_radiation - lowest model layer air temperature for radiation - K - tsfa - real - (:) - in - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - surface_albedo_due_to_near_IR_direct - surface albedo due to near IR direct beam - frac - sfcalb1 - real - (:) - out - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - surface_albedo_due_to_near_IR_diffused - surface albedo due to near IR diffused beam - frac - sfcalb2 - real - (:) - out - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - surface_albedo_due_to_UV_and_VIS_direct - surface albedo due to UV+VIS direct beam - frac - sfcalb3 - real - (:) - out - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - surface_albedo_due_to_UV_and_VIS_diffused - surface albedo due to UV+VIS diffused beam - frac - sfcalb4 - real - (:) - out - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - surface_albedo_perturbation - surface albedo perturbation - frac - alb1d - real - (:) - in - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - ccpp_error_message - error message for error handling in CCPP - none - errmsg - character - - out - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - ccpp_error_flag - error flag for error handling in CCPP - flag - errflg - integer - - out - F - MODULE_GFS_rrtmgp_sw_pre SCHEME_GFS_rrtmgp_sw_pre SUBROUTINE_GFS_rrtmgp_sw_pre_run - - - diff --git a/physics/rrtmgp_lw.F90 b/physics/rrtmgp_lw.F90 new file mode 100644 index 000000000..6140924fe --- /dev/null +++ b/physics/rrtmgp_lw.F90 @@ -0,0 +1,104 @@ +! ########################################################################################### +! ########################################################################################### +module rrtmgp_lw + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_cloud_optics, only: ty_cloud_optics + use mo_optical_props, only: ty_optical_props_1scl + use mo_rrtmgp_clr_all_sky, only: rte_lw + use mo_gas_concentrations, only: ty_gas_concs + use mo_fluxes_byband, only: ty_fluxes_byband + + public rrtmgp_lw_init, rrtmgp_lw_run, rrtmgp_lw_finalize +contains + + subroutine rrtmgp_lw_init() + end subroutine rrtmgp_lw_init + + ! ######################################################################################### + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |-----------------------|-------------------------------------------------|--------------------------------------------------------------------|-------|------|-----------------------|-----------|--------|----------| +!! | ncol | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | +!! | nlay | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F | +!! | p_lay | air_pressure_at_layer_for_radiation_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | +!! | p_lev | air_pressure_at_interface_for_radiation_in_hPa | air pressure level | hPa | 2 | real | kind_phys | in | F | +!! | t_lay | air_temperature_at_layer_for_radiation | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | skt | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | sfc_emiss | surface_longwave_emissivity_in_each_band | surface lw emissivity in fraction in each LW band | frac | 2 | real | kind_phys | in | F | +!! | kdist_lw | K_distribution_file_for_RRTMGP_LW_scheme | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | +!! | optical_props_clds | optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | in | F | +!! | optical_props_aerosol | optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | in | F | +!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | in | F | +!! | fluxLW_allsky | lw_flux_profiles_byband_allsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | F | +!! | fluxLW_clrsky | lw_flux_profiles_byband_clrsky | Fortran DDT containing RRTMGP 3D fluxes | DDT | 0 | ty_fluxes_byband | | out | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! + subroutine rrtmgp_lw_run(ncol, nlay, kdist_lw, p_lay, t_lay, p_lev, skt, & + sfc_emiss, gas_concentrations, optical_props_clds, optical_props_aerosol,& + fluxLW_allsky, fluxLW_clrsky, errmsg, errflg) + + ! Inputs + integer, intent(in) :: & + ncol, & ! Number of horizontal gridpoints + nlay ! Number of vertical layers + real(kind_phys), dimension(ncol,nlay), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,nlay+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (hPa) + real(kind_phys), dimension(ncol), intent(in) :: & + skt ! Surface(skin) temperature (K) + type(ty_gas_optics_rrtmgp),intent(in) :: & + kdist_lw ! DDT containing LW spectral information + real(kind_phys), dimension(kdist_lw%get_nband(),ncol) :: & + sfc_emiss ! Surface emissivity (1) + type(ty_optical_props_1scl),intent(in) :: & + optical_props_clds, & + optical_props_aerosol + type(ty_gas_concs),intent(in) :: & + gas_concentrations + type(ty_fluxes_byband),intent(out) :: & + fluxLW_allsky, & ! All-sky flux (W/m2) + fluxLW_clrsky ! Clear-sky flux (W/m2) + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Call RRTMGP LW scheme + call check_error_msg(rte_lw( & + kdist_lw, & ! IN - spectral information + gas_concentrations, & ! IN - gas concentrations (vmr) + p_lay, & ! IN - pressure at layer interfaces (Pa) + t_lay, & ! IN - temperature at layer interfaes (K) + p_lev, & ! IN - pressure at layer centers (Pa) + skt, & ! IN - skin temperature (K) + sfc_emiss, & ! IN - surface emissivity in each LW band + optical_props_clds, & ! IN - DDT containing cloud optical information + fluxLW_allsky, & ! OUT - Fluxes, all-sky, 3D (nCol,nLay,nBand) + fluxLW_clrsky, & ! OUT - Fluxes, clear-sky, 3D (nCol,nLay,nBand) + aer_props = optical_props_aerosol)) ! IN(optional) - DDT containing aerosol optical information + + end subroutine rrtmgp_lw_run + + subroutine rrtmgp_lw_finalize() + end subroutine rrtmgp_lw_finalize + subroutine check_error_msg(error_msg) + character(len=*), intent(in) :: error_msg + + if(error_msg /= "") then + print*,"ERROR(rrtmgp_sw_main.F90): " + print*,trim(error_msg) + return + end if + end subroutine check_error_msg + + +end module rrtmgp_lw diff --git a/physics/rrtmgp_lw_main.xml b/physics/rrtmgp_lw_main.xml deleted file mode 100644 index 04ac5c73e..000000000 --- a/physics/rrtmgp_lw_main.xml +++ /dev/null @@ -1,173 +0,0 @@ - - - - - - - horizontal_loop_extent - horizontal dimension - count - ncol - integer - - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - adjusted_vertical_layer_dimension_for_radiation - number of vertical layers for radiation - count - nlay - integer - - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - - air_pressure_at_layer_for_radiation_in_hPa - air pressure layer - hPa - p_lay - real - (:,:) - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - air_pressure_at_interface_for_radiation_in_hPa - air pressure level - hPa - p_lev - real - (:,:) - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - air_temperature_at_layer_for_radiation - air temperature layer - K - t_lay - real - (:,:) - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - surface_ground_temperature_for_radiation - surface ground temperature for radiation - K - skt - real - (:) - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - surface_longwave_emissivity - surface emissivity - frac - sfc_emiss - real - (:) - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - K_distribution_file_for_RRTMGP_LW_scheme - DDT containing spectral information for RRTMGP LW radiation scheme - DDT - kdist_lw - ty_gas_optics_rrtmgp_type - - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - optical_properties_for_cloudy_atmosphere - Fortran DDT containing RRTMGP optical properties - DDT - optical_props_clds - ty_optical_props_1scl - - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - optical_properties_for_aerosols - Fortran DDT containing RRTMGP optical properties - DDT - optical_props_aerosol - ty_optical_props_1scl - - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - Gas_concentrations_for_RRTMGP_suite - Fortran DDT containing gas concentrations for RRTMGP radiation scheme - DDT - gas_concentrations - ty_gas_concs - - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - lw_flux_profiles_byband_allsky - Fortran DDT containing RRTMGP 3D fluxes - DDT - fluxLW_allsky - ty_fluxes_byband - - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - lw_flux_profiles_byband_clrsky - Fortran DDT containing RRTMGP 3D fluxes - DDT - fluxLW_clrsky - ty_fluxes_byband - - in - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - ccpp_error_message - error message for error handling in CCPP - none - errmsg - character - - out - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - ccpp_error_flag - error flag for error handling in CCPP - flag - errflg - integer - - out - F - MODULE_rrtmgp_lw SCHEME_rrtmgp_lw SUBROUTINE_rrtmgp_lw_main_run - - - diff --git a/physics/rrtmgp_lw_post.F90 b/physics/rrtmgp_lw_post.F90 index 9743b5b22..797c28de5 100644 --- a/physics/rrtmgp_lw_post.F90 +++ b/physics/rrtmgp_lw_post.F90 @@ -5,7 +5,7 @@ module rrtmgp_lw_post use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_fluxes_byband, only: ty_fluxes_byband use mo_heating_rates, only: compute_heating_rate - use GFS_rrtmgp_lw, only: check_error_msg + use rrtmgp_lw, only: check_error_msg use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type implicit none diff --git a/physics/GFS_rrtmgp_sw.F90 b/physics/rrtmgp_sw.F90 similarity index 99% rename from physics/GFS_rrtmgp_sw.F90 rename to physics/rrtmgp_sw.F90 index b0cc94e32..9b1d66a42 100644 --- a/physics/GFS_rrtmgp_sw.F90 +++ b/physics/rrtmgp_sw.F90 @@ -1,6 +1,6 @@ ! ########################################################################################### ! ########################################################################################### -module GFS_rrtmgp_sw +module rrtmgp_sw use GFS_typedefs, only: GFS_control_type use physparam, only: iovrsw, icldflg, iswcliq, isubcsw use machine, only: kind_phys @@ -39,14 +39,14 @@ module GFS_rrtmgp_sw real (kind_phys), parameter :: & s0 = 1368.22 ! Solar constant (W/m2) - ! Logical flags for optional output fields in GFS_rrtmgp_sw_run(), default=.false. + ! Logical flags for optional output fields in rrtmgp_sw_run(), default=.false. logical :: & l_AllSky_HR_byband = .false., & ! 2D [ncol,nlay] all-sky heating rates, in each band [ncol,nlay,nBandsSW]? l_ClrSky_HR = .false., & ! 2D [ncol,nlay] clear-sky heating rate? l_fluxes2D = .false., & ! 2D [ncol,nlay] radiative fluxes *Note* fluxes is a DDT w/ 4 fields. l_sfcFluxes1D = .false. ! 1D [ncol] surface fluxes *Note* fluxes is a DDT w/ 6 fields. - ! Module parameters (set during GFS_rrtmgp_sw_init()) + ! Module parameters (set during rrtmgp_sw_init()) integer :: & rrtmgp_sw_cld_phys, & ! RRTMGP cloud-physics (0-RRTMG, 1-RRTGMP(LUT), 2-RRTMGP(Pade)) nGptsSW, & ! Number of SW spectral g-points @@ -62,12 +62,12 @@ module GFS_rrtmgp_sw type(ty_gas_concs) :: & gas_concentrations - public GFS_rrtmgp_sw_init, GFS_rrtmgp_sw_run, GFS_rrtmgp_sw_finalize + public rrtmgp_sw_init, rrtmgp_sw_run, rrtmgp_sw_finalize contains ! ######################################################################################### - ! GFS_rrtmgp_sw_init + ! rrtmgp_sw_init ! ######################################################################################### -!! \section arg_table_GFS_rrtmgp_sw_init Argument Table +!! \section arg_table_rrtmgp_sw_init Argument Table !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | !! |-----------------|-------------------------------------------------|---------------------------------------------------------------------------|-------|------|----------------------|-----------|--------|----------| !! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | @@ -80,7 +80,7 @@ module GFS_rrtmgp_sw !! | kdist_sw_cldy | K_distribution_file_for_cloudy_RRTMGP_SW_scheme | DDT containing spectral information for cloudy RRTMGP SW radiation scheme | DDT | 0 | ty_cloud_optics | | inout | F | !! ! ######################################################################################### - subroutine GFS_rrtmgp_sw_init(Model,mpicomm, mpirank, mpiroot, kdist_sw, kdist_sw_cldy, & + subroutine rrtmgp_sw_init(Model,mpicomm, mpirank, mpiroot, kdist_sw, kdist_sw_cldy, & errmsg, errflg) use netcdf #ifdef MPI @@ -723,11 +723,11 @@ subroutine GFS_rrtmgp_sw_init(Model,mpicomm, mpirank, mpiroot, kdist_sw, kdist_s pade_sizereg_extice_sw, pade_sizereg_ssaice_sw, pade_sizereg_asyice_sw)) endif - end subroutine GFS_rrtmgp_sw_init + end subroutine rrtmgp_sw_init ! ######################################################################################### ! GFS_RRTMGP_SW_RUN ! ######################################################################################### -!! \section arg_table_GFS_rrtmgp_sw_run Argument Table +!! \section arg_table_rrtmgp_sw_run Argument Table !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | !! |-----------------|------------------------------------------------------------------------------------------------|---------------------------------------------------------------------------|---------|------|---------------------------|-----------|--------|----------| !! | p_lay | air_pressure_at_layer_for_radiation_in_hPa | air pressure layer | hPa | 2 | real | kind_phys | in | F | @@ -789,7 +789,7 @@ end subroutine GFS_rrtmgp_sw_init !! | kdist_sw | K_distribution_file_for_RRTMGP_SW_scheme | DDT containing spectral information for RRTMGP SW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp | | in | F | !! | kdist_sw_cldy | K_distribution_file_for_cloudy_RRTMGP_SW_scheme | DDT containing spectral information for cloudy RRTMGP SW radiation scheme | DDT | 0 | ty_cloud_optics | | inout | F | !! - subroutine GFS_rrtmgp_sw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr_n2o, & ! IN + subroutine rrtmgp_sw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr_n2o, & ! IN vmr_ch4, vmr_o2, vmr_co, vmr_cfc11, vmr_cfc12, vmr_cfc22, vmr_ccl4, icseed, tau_aer, & ! IN ssa_aer, asy_aer, sfcalb_nir_dir, sfcalb_nir_dif, sfcalb_uvis_dir, sfcalb_uvis_dif, & ! IN dzlyr, delpin, de_lgth, cossza, solcon, nday, idxday, ncol, nlay, lprint, cldfrac, & ! IN @@ -1258,11 +1258,11 @@ subroutine GFS_rrtmgp_sw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, if (l_ClrSky_HR) then hsw0(idxday,:) = thetaTendClrSky endif - end subroutine GFS_rrtmgp_sw_run + end subroutine rrtmgp_sw_run ! ######################################################################################### ! ######################################################################################### - subroutine GFS_rrtmgp_sw_finalize() - end subroutine GFS_rrtmgp_sw_finalize + subroutine rrtmgp_sw_finalize() + end subroutine rrtmgp_sw_finalize ! ######################################################################################### ! Ancillary functions @@ -1271,11 +1271,11 @@ subroutine check_error_msg(error_msg) character(len=*), intent(in) :: error_msg if(error_msg /= "") then - print*,"ERROR(GFS_rrtmgp_sw_main.F90): " + print*,"ERROR(rrtmgp_sw_main.F90): " print*,trim(error_msg) return end if end subroutine check_error_msg ! ######################################################################################### ! ######################################################################################### -end module GFS_rrtmgp_sw +end module rrtmgp_sw diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/rrtmgp_sw_post.F90 similarity index 93% rename from physics/GFS_rrtmgp_sw_post.F90 rename to physics/rrtmgp_sw_post.F90 index 44508e697..d5bc2692e 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/rrtmgp_sw_post.F90 @@ -1,17 +1,17 @@ -!>\file GFS_rrtmgp_sw_post +!>\file rrtmgp_sw_post !! This file contains - module GFS_rrtmgp_sw_post - contains + module rrtmgp_sw_post + contains -!>\defgroup GFS_rrtmgp_sw_post GFS RRTMGP scheme post +!>\defgroup rrtmgp_sw_post GFS RRTMGP scheme post !! @{ -!> \section arg_table_GFS_rrtmgp_sw_post_init Argument Table +!> \section arg_table_rrtmgp_sw_post_init Argument Table !! - subroutine GFS_rrtmgp_sw_post_init () - end subroutine GFS_rrtmgp_sw_post_init + subroutine rrtmgp_sw_post_init () + end subroutine rrtmgp_sw_post_init ! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing #ifndef __PGI -!> \section arg_table_GFS_rrtmgp_sw_post_run Argument Table +!> \section arg_table_rrtmgp_sw_post_run Argument Table !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | !! |----------------|------------------------------------------------------------------------------------------------|------------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------| !! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | @@ -35,7 +35,7 @@ end subroutine GFS_rrtmgp_sw_post_init !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! #endif - subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & + subroutine rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & im, ltp, nday, lm, kd, htswc, htsw0, & sfcalb1, sfcalb2, sfcalb3, sfcalb4, scmpsw, errmsg, errflg) @@ -144,11 +144,11 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & endif ! end_if_lsswr - end subroutine GFS_rrtmgp_sw_post_run + end subroutine rrtmgp_sw_post_run -!> \section arg_table_GFS_rrtmgp_sw_post_finalize Argument Table +!> \section arg_table_rrtmgp_sw_post_finalize Argument Table !! - subroutine GFS_rrtmgp_sw_post_finalize () - end subroutine GFS_rrtmgp_sw_post_finalize + subroutine rrtmgp_sw_post_finalize () + end subroutine rrtmgp_sw_post_finalize !! @} - end module GFS_rrtmgp_sw_post + end module rrtmgp_sw_post diff --git a/physics/rrtmgp_sw_pre.F90 b/physics/rrtmgp_sw_pre.F90 new file mode 100644 index 000000000..ba9b1d054 --- /dev/null +++ b/physics/rrtmgp_sw_pre.F90 @@ -0,0 +1,118 @@ +!>\file rrtmgp_sw_pre.f90 +!! This file contains a subroutine to module_radiation_surface::setalb() to +!! setup surface albedo for SW radiation. + module rrtmgp_sw_pre + contains + +!>\defgroup rrtmgp_sw_pre GFS RRTMGP scheme Pre +!! @{ +!> \section arg_table_rrtmgp_sw_pre_init Argument Table +!! + subroutine rrtmgp_sw_pre_init () + end subroutine rrtmgp_sw_pre_init + +!> \section arg_table_rrtmgp_sw_pre_run Argument Table +!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------|--------------------------------------------------------------------|----------|------|------------------|-----------|--------|----------| +!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | +!! | Grid | GFS_grid_type_instance | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F | +!! | Sfcprop | GFS_sfcprop_type_instance | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | +!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | +!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | out | F | +!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | in | F | +!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | +!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | +!! + subroutine rrtmgp_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & + nday, idxday, tsfg, tsfa, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & + alb1d, errmsg, errflg) + + use machine, only: kind_phys + + use GFS_typedefs, only: GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_sfcprop_type + use module_radiation_surface, only: NF_ALBD, setalb + + implicit none + + type(GFS_control_type), intent(in) :: Model + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_grid_type), intent(in) :: Grid + integer, intent(in) :: im + integer, intent(out) :: nday + integer, dimension(size(Grid%xlon,1)), intent(out) :: idxday + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: alb1d + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Local variables + integer :: i + real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +! --- ... start radiation calculations +! remember to set heating rate unit to k/sec! +!> -# Start SW radiation calculations + if (Model%lsswr) then + +!> - Check for daytime points for SW radiation. + nday = 0 + idxday = 0 + do i = 1, IM + if (Radtend%coszen(i) >= 0.0001) then + nday = nday + 1 + idxday(nday) = i + endif + enddo + +!> - Call module_radiation_surface::setalb() to setup surface albedo. +!! for SW radiation. + + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& + tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, IM, & + alb1d, Model%pertalb, & ! mg, sfc-perts + sfcalb) ! --- outputs + +!> -# Approximate mean surface albedo from vis- and nir- diffuse values. + Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + else + nday = 0 + idxday = 0 + sfcalb = 0.0 + endif + + do i = 1, im + sfcalb1(i) = sfcalb(i,1) + sfcalb2(i) = sfcalb(i,2) + sfcalb3(i) = sfcalb(i,3) + sfcalb4(i) = sfcalb(i,4) + enddo + + end subroutine rrtmgp_sw_pre_run + +!> \section arg_table_rrtmgp_sw_pre_finalize Argument Table +!! + subroutine rrtmgp_sw_pre_finalize () + end subroutine rrtmgp_sw_pre_finalize + +!! @} + end module rrtmgp_sw_pre