diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 6bfd47ee8..428d72337 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -1,8 +1,16 @@ !> \file GFS_rrtmgp_pre.f90 !! This file contains module GFS_rrtmgp_pre + use machine, only: kind_phys - public GFS_rrtmgp_pre_run + 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 + + public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize contains @@ -15,82 +23,88 @@ subroutine GFS_rrtmgp_pre_init () end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_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 | -!! | Statein | GFS_statein_type_instance | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | -!! | Tbd | GFS_tbd_type_instance | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_tbd_type | | in | F | -!! | Cldprop | GFS_cldprop_type_instance | Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics | DDT | 0 | GFS_cldprop_type | | in | F | -!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields needed for coupling | DDT | 0 | GFS_coupling_type| | in | F | -!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | -!! | lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | count | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | -!! | lmk | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F | -!! | lmp | adjusted_vertical_level_dimension_for_radiation | number of vertical levels for radiation | count | 0 | integer | | in | F | -!! | kd | vertical_index_difference_between_inout_and_local | vertical index difference between in/out and local | index | 0 | integer | | out | F | -!! | kt | vertical_index_difference_between_layer_and_upper_bound | vertical index difference between layer and upper bound | index | 0 | integer | | out | F | -!! | kb | vertical_index_difference_between_layer_and_lower_bound | vertical index difference between layer and lower bound | index | 0 | integer | | out | F | -!! | raddt | time_step_for_radiation | radiation time step | s | 0 | real | kind_phys | out | F | -!! | delp | layer_pressure_thickness_for_radiation | layer pressure thickness on radiation levels | hPa | 2 | real | kind_phys | out | F | -!! | dz | layer_thickness_for_radiation | layer thickness on radiation levels | km | 2 | real | kind_phys | out | F | -!! | plvl | air_pressure_at_interface_for_radiation_in_hPa | air pressure at vertical interface for radiation calculation | hPa | 2 | real | kind_phys | out | F | -!! | plyr | air_pressure_at_layer_for_radiation_in_hPa | air pressure at vertical layer for radiation calculation | hPa | 2 | real | kind_phys | out | F | -!! | tlvl | air_temperature_at_interface_for_radiation | air temperature at vertical interface for radiation calculation | K | 2 | real | kind_phys | out | F | -!! | tlyr | air_temperature_at_layer_for_radiation | air temperature at vertical layer for radiation calculation | K | 2 | real | kind_phys | out | F | -!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | out | F | -!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | -!! | qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | -!! | olyr | ozone_concentration_at_layer_for_radiation | ozone concentration | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_co2 | volume_mixing_ratio_co2 | CO2 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_n2o | volume_mixing_ratio_n2o | N2O volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_ch4 | volume_mixing_ratio_ch4 | CH4 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_o2 | volume_mixing_ratio_o2 | O2 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_co | volume_mixing_ratio_co | CO volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_cfc11 | volume_mixing_ratio_cfc11 | CFC11 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_cfc12 | volume_mixing_ratio_cfc12 | CFC12 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_cfc22 | volume_mixing_ratio_cfc22 | CFC22 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_ccl4 | volume_mixing_ratio_ccl4 | CCL4 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | gasvmr_cfc113 | volume_mixing_ratio_cfc113 | CFC113 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | -!! | faersw1 | aerosol_optical_depth_for_shortwave_bands_01-16 | aerosol optical depth for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!! | faersw2 | aerosol_single_scattering_albedo_for_shortwave_bands_01-16 | aerosol single scattering albedo for shortwave bands 01-16 | frac | 3 | real | kind_phys | out | F | -!! | faersw3 | aerosol_asymmetry_parameter_for_shortwave_bands_01-16 | aerosol asymmetry parameter for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!! | faerlw1 | aerosol_optical_depth_for_longwave_bands_01-16 | aerosol optical depth for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!! | faerlw2 | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | frac | 3 | real | kind_phys | out | F | -!! | faerlw3 | aerosol_asymmetry_parameter_for_longwave_bands_01-16 | aerosol asymmetry parameter for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!! | aerodp | atmosphere_optical_thickness_due_to_ambient_aerosol_particles | vertical integrated optical depth for various aerosol species | none | 2 | real | kind_phys | out | F | -!! | clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | out | F | -!! | clouds2 | cloud_liquid_water_path | layer cloud liquid water path | g m-2 | 2 | real | kind_phys | out | F | -!! | clouds3 | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | out | F | -!! | clouds4 | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | out | F | -!! | clouds5 | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | out | F | -!! | clouds6 | cloud_rain_water_path | cloud rain water path | g m-2 | 2 | real | kind_phys | out | F | -!! | clouds7 | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | out | F | -!! | clouds8 | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | out | F | -!! | clouds9 | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | out | F | -!! | cldsa | cloud_area_fraction_for_radiation | fraction of clouds for low, middle,high, total and BL | frac | 2 | real | kind_phys | out | F | -!! | mtopa | model_layer_number_at_cloud_top | vertical indices for low, middle and high cloud tops | index | 2 | integer | | out | F | -!! | mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | out | F | -!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | out | F | -!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | 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 | -!! | 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_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 | +!! | 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 | +!! | Statein | GFS_statein_type_instance | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_statein_type | | in | F | +!! | Tbd | GFS_tbd_type_instance | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_tbd_type | | in | F | +!! | Cldprop | GFS_cldprop_type_instance | Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics | DDT | 0 | GFS_cldprop_type | | in | F | +!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields needed for coupling | DDT | 0 | GFS_coupling_type| | in | F | +!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | +!! | lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | count | 0 | integer | | in | F | +!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | lmk | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F | +!! | lmp | adjusted_vertical_level_dimension_for_radiation | number of vertical levels for radiation | count | 0 | integer | | in | F | +!! | kd | vertical_index_difference_between_inout_and_local | vertical index difference between in/out and local | index | 0 | integer | | out | F | +!! | kt | vertical_index_difference_between_layer_and_upper_bound | vertical index difference between layer and upper bound | index | 0 | integer | | out | F | +!! | kb | vertical_index_difference_between_layer_and_lower_bound | vertical index difference between layer and lower bound | index | 0 | integer | | out | F | +!! | raddt | time_step_for_radiation | radiation time step | s | 0 | real | kind_phys | out | F | +!! | delp | layer_pressure_thickness_for_radiation | layer pressure thickness on radiation levels | hPa | 2 | real | kind_phys | out | F | +!! | dz | layer_thickness_for_radiation | layer thickness on radiation levels | km | 2 | real | kind_phys | out | F | +!! | plvl | air_pressure_at_interface_for_radiation_in_hPa | air pressure at vertical interface for radiation calculation | hPa | 2 | real | kind_phys | out | F | +!! | plyr | air_pressure_at_layer_for_radiation_in_hPa | air pressure at vertical layer for radiation calculation | hPa | 2 | real | kind_phys | out | F | +!! | tlvl | air_temperature_at_interface_for_radiation | air temperature at vertical interface for radiation calculation | K | 2 | real | kind_phys | out | F | +!! | tlyr | air_temperature_at_layer_for_radiation | air temperature at vertical layer for radiation calculation | K | 2 | real | kind_phys | out | F | +!! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | out | F | +!! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | +!! | qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | +!! | olyr | ozone_concentration_at_layer_for_radiation | ozone concentration | kg kg-1 | 2 | real | kind_phys | out | F | +!! | icseed | seed_random_numbers_lw | seed for random number generation for longwave radiation | none | 1 | integer | | in | F | +!! | gasvmr_co2 | volume_mixing_ratio_co2 | CO2 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | gasvmr_n2o | volume_mixing_ratio_n2o | N2O volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | gasvmr_ch4 | volume_mixing_ratio_ch4 | CH4 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | gasvmr_o2 | volume_mixing_ratio_o2 | O2 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | gasvmr_co | volume_mixing_ratio_co | CO volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | gasvmr_cfc11 | volume_mixing_ratio_cfc11 | CFC11 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | gasvmr_cfc12 | volume_mixing_ratio_cfc12 | CFC12 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | gasvmr_cfc22 | volume_mixing_ratio_cfc22 | CFC22 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | gasvmr_ccl4 | volume_mixing_ratio_ccl4 | CCL4 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | gasvmr_cfc113 | volume_mixing_ratio_cfc113 | CFC113 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | +!! | faersw1 | aerosol_optical_depth_for_shortwave_bands_01-16 | aerosol optical depth for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!! | faersw2 | aerosol_single_scattering_albedo_for_shortwave_bands_01-16 | aerosol single scattering albedo for shortwave bands 01-16 | frac | 3 | real | kind_phys | out | F | +!! | faersw3 | aerosol_asymmetry_parameter_for_shortwave_bands_01-16 | aerosol asymmetry parameter for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!! | faerlw1 | aerosol_optical_depth_for_longwave_bands_01-16 | aerosol optical depth for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!! | faerlw2 | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | frac | 3 | real | kind_phys | out | F | +!! | faerlw3 | aerosol_asymmetry_parameter_for_longwave_bands_01-16 | aerosol asymmetry parameter for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!! | aerodp | atmosphere_optical_thickness_due_to_ambient_aerosol_particles | vertical integrated optical depth for various aerosol species | none | 2 | real | kind_phys | out | F | +!! | clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | out | F | +!! | clouds2 | cloud_liquid_water_path | layer cloud liquid water path | g m-2 | 2 | real | kind_phys | out | F | +!! | clouds3 | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | out | F | +!! | clouds4 | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | out | F | +!! | clouds5 | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | out | F | +!! | clouds6 | cloud_rain_water_path | cloud rain water path | g m-2 | 2 | real | kind_phys | out | F | +!! | clouds7 | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | out | F | +!! | clouds8 | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | out | F | +!! | clouds9 | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | out | F | +!! | cldsa | cloud_area_fraction_for_radiation | fraction of clouds for low, middle,high, total and BL | frac | 2 | real | kind_phys | out | F | +!! | mtopa | model_layer_number_at_cloud_top | vertical indices for low, middle and high cloud tops | index | 2 | integer | | out | F | +!! | mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | out | F | +!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | out | F | +!! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | 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 | +!! | 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_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_cldy_lw | 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 | +!! | kdist_cldy_sw | K_distribution_file_for_cloudy_RRTMGP_SW_scheme | DDT containing spectral information for cloudy RRTMGP SW radiation scheme | DDT | 0 | ty_cloud_optics | | in | F | +!! | optical_props_clouds | optical_properties_for_cloudy_atmosphere | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | out | F | +!! | optical_props_aerosol | optical_properties_for_aerosols | Fortran DDT containing RRTMGP optical properties | DDT | 0 | ty_optical_props_1scl | | out | F | +!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | inout | F | !! ! Attention - the output arguments lm, im, lmk, lmp must not be set ! in the CCPP version - they are defined in the interstitial_create routine ! ######################################################################################### subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coupling, & ! IN Radtend, & ! INOUT - lm, im, lmk, lmp, kdist_lw, kdist_sw, & ! IN - kd, kt, kb, raddt, delp, dz, plvl, plyr, tlvl, tlyr, tsfg, tsfa, qlyr, olyr, & ! OUT + lm, im, lmk, lmp, kdist_lw, kdist_sw, kdist_cldy_lw, kdist_cldy_sw, & ! IN + kd, kt, kb, raddt, delp, dz, plvl, plyr, tlvl, tlyr, tsfg, tsfa, qlyr, olyr, icseed, & ! OUT gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & ! OUT gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113, faersw1, faersw2, faersw3, & ! OUT faerlw1, faerlw2, faerlw3, aerodp, clouds1, clouds2, clouds3, clouds4, clouds5, & ! OUT clouds6, clouds7, clouds8, clouds9, cldsa, mtopa, mbota, de_lgth, alb1d, & ! OUT - errmsg, errflg) + optical_props_clouds, optical_props_aerosol, gas_concentrations, errmsg, errflg) use physparam use machine, only: & @@ -139,9 +153,20 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup progclduni ! Unified cloud-scheme use surface_perturbation, only: & cdfnor ! Routine to compute CDF (used to compute percentiles) + use rrtmgp_lw_pre, only: & + nrghice, ipsdlw0 + use rrtmgp_lw, only: check_error_msg + use mersenne_twister, only: & + random_setseed, & + random_number, & + random_stat ! RRTMGP types - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - + 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_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mo_gas_concentrations, only: ty_gas_concs + implicit none ! Inputs @@ -157,6 +182,16 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup type(ty_gas_optics_rrtmgp),intent(in) :: & kdist_lw, & ! RRTMGP DDT containing spectral information for LW calculation kdist_sw ! RRTMGP DDT containing spectral information for SW calculation + type(ty_cloud_optics),intent(in) :: & + kdist_cldy_lw, & + kdist_cldy_sw + type(ty_gas_concs),intent(inout) :: & + gas_concentrations + integer,intent(in),dimension(IM) :: & + 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. ! Outputs integer, intent(out) :: kd, kt, kb @@ -182,10 +217,18 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup real(kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: de_lgth,alb1d character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + type(ty_optical_props_1scl),intent(out) :: & + optical_props_clouds, & + optical_props_aerosol ! Local variables integer :: me, nfxr, ntrac, ntcw, ntiw, ncld, ntrw, ntsw, ntgl,i, j, k, k1, k2, lsk, & - lv, n, itop, ibtc, LP1, lla, llb, lya, lyb + lv, n, itop, ibtc, LP1, lla, llb, lya, lyb, iCol + integer,dimension(IM) :: ipseed + logical,dimension(IM,LMK) :: & + liqmask,icemask + real(kind_phys),dimension(IM,LMK) :: & + cld_ref_ice2,cld_ref_liq2, vmr_o3, vmr_h2o real(kind_phys) :: es, qs, delt, tem0d real(kind_phys), dimension(size(Grid%xlon,1)) :: cvt1, cvb1, tem1d, tskn real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: htswc, htlwc, & @@ -200,6 +243,14 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,kdist_sw%get_nband(),NF_AESW)::faersw real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,kdist_lw%get_nband(),NF_AELW)::faerlw + type(ty_optical_props_1scl) :: optical_props_clear, optical_props_cloudsByBand + real(kind_phys), dimension(kdist_lw%get_nband(),LMK,IM) :: & + rng3D + real(kind_phys), dimension(kdist_lw%get_nband()*LMK) :: & + rng1D + logical, dimension(IM,LMK,kdist_lw%get_nband()) :: & + cldfracMCICA + type(random_stat) :: rng_stat ! Initialize CCPP error handling variables errmsg = '' @@ -703,6 +754,88 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup endif ! mg, sfc-perts + ! ####################################################################################### + ! Compute radiative properties needed for RRTMGP + ! ####################################################################################### + + ! Change random number seed value for each radiation invocation (isubclw =1 or 2). + if(isubclw == 1) then ! advance prescribed permutation seed + do iCol = 1, IM + ipseed(iCol) = ipsdlw0 + iCol + enddo + elseif (isubclw == 2) then ! use input array of permutaion seeds + do iCol = 1, IM + ipseed(iCol) = icseed(iCol) + enddo + endif + + ! Compute volume mixing-ratios for ozone (mmr) and specific-humidity. + vmr_h2o = merge((qlyr/(1-qlyr))*amdw, 0., qlyr .ne. 1.) + vmr_o3 = merge(olyr*amdo3, 0., olyr .gt. 0.) + + ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics + liqmask = (clouds1 .gt. 0 .and. clouds2 .gt. 0) + icemask = (clouds1 .gt. 0 .and. clouds4 .gt. 0) + + ! RRTMGP cloud_optics expects particle size to be in a certain range. bound here + cld_ref_ice2 = clouds5 + where(cld_ref_ice2 .gt. kdist_cldy_lw%get_max_radius_ice()) cld_ref_ice2=kdist_cldy_lw%get_max_radius_ice() + where(cld_ref_ice2 .lt. kdist_cldy_lw%get_min_radius_ice()) cld_ref_ice2=kdist_cldy_lw%get_min_radius_ice() + cld_ref_liq2 = clouds5 + where(cld_ref_liq2 .gt. kdist_cldy_lw%get_max_radius_liq()) cld_ref_liq2=kdist_cldy_lw%get_max_radius_liq() + where(cld_ref_liq2 .lt. kdist_cldy_lw%get_min_radius_liq()) cld_ref_liq2=kdist_cldy_lw%get_min_radius_liq() + + ! Allocate space for gas optical properties [ncol,nlay,ngpts] + call check_error_msg(optical_props_clear%alloc_1scl( IM, LMK, kdist_lw)) + ! Cloud optics [nCol,nLay,nBands] + call check_error_msg(optical_props_cloudsByBand%init(optical_props_clear%get_band_lims_wavenumber())) + call check_error_msg(optical_props_cloudsByBand%alloc_1scl(IM, LMK)) + ! Aerosol optics [Ccol,nLay,nBands] + call check_error_msg(optical_props_aerosol%init(optical_props_clear%get_band_lims_wavenumber())) + call check_error_msg(optical_props_aerosol%alloc_1scl(IM, LMK)) + ! Cloud optics [nCol,nLay,nGpts] + call check_error_msg(optical_props_clouds%alloc_1scl(IM, LMK, kdist_lw)) + + ! Set gas concentrations + call gas_concentrations%reset() + call check_error_msg(gas_concentrations%set_vmr('o2', gasvmr_o2)) + call check_error_msg(gas_concentrations%set_vmr('co2', gasvmr_co2)) + call check_error_msg(gas_concentrations%set_vmr('ch4', gasvmr_ch4)) + call check_error_msg(gas_concentrations%set_vmr('n2o', gasvmr_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_aerosol%tau = faerlw1 * (1. - faerlw2) + + ! Compute cloud-optics for RTE. + call check_error_msg(kdist_cldy_lw%cloud_optics(IM, LMK, kdist_lw%get_nband(), nrghice, & + liqmask, icemask, clouds2, clouds4, clouds3, clouds5, optical_props_cloudsByBand)) + + ! 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,IM + call random_setseed(ipseed(icol),rng_stat) + call random_number(rng1D,rng_stat) + rng3D(:,:,iCol) = reshape(source = rng1D,shape=[kdist_lw%get_ngpt(),LMK]) + enddo + + ! Call McICA + select case ( iovrlw ) + ! Maximumn-random + case(1) + call check_error_msg(sampled_mask_max_ran(rng3D,clouds1,cldfracMCICA)) + end select + + ! Map band optical depth to each g-point using McICA + call check_error_msg(draw_samples(cldfracMCICA,optical_props_cloudsByBand,optical_props_clouds)) + endif + + + end subroutine GFS_rrtmgp_pre_run !> \section arg_table_GFS_rrtmgp_pre_finalize Argument Table diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index c71b096b7..58a0f8df4 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -1,15 +1,680 @@ !>\file rrtmgp_lw_pre.f90 !! This file contains a call to module_radiation_surface::setemis() to !! setup surface emissivity for LW radiation. - module rrtmgp_lw_pre - contains +module rrtmgp_lw_pre + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use mo_cloud_optics, only: ty_cloud_optics + use mo_rte_kind, only: wl + use rrtmgp_lw, only: check_error_msg + + ! 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 '/) + integer :: nrghice, ipsdlw0 + +contains -!>\defgroup rrtmgp_lw_pre GFS RRTMGP scheme pre -!! @{ -!> \section arg_table_rrtmgp_lw_pre_init Argument Table +!! \section arg_table_rrtmgp_lw_pre_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 | | out | F | +!! | kdist_cldy_lw | K_distribution_file_for_cloudy_RRTMGP_LW_scheme | DDT containing spectral information for cloudy RRTMGP LW radiation scheme | DDT | 0 | ty_cloud_optics | | out | F | +!! | gas_concentrations | Gas_concentrations_for_RRTMGP_suite | DDT containing gas concentrations for RRTMGP radiation scheme | DDT | 0 | ty_gas_concs | | out | F | !! - subroutine rrtmgp_lw_pre_init () - end subroutine rrtmgp_lw_pre_init + ! ######################################################################################### + subroutine rrtmgp_lw_pre_init(Model,mpicomm, mpirank, mpiroot, kdist_lw, kdist_cldy_lw, & + 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(out) :: & + kdist_lw + type(ty_cloud_optics),intent(out) :: & + kdist_cldy_lw + type(ty_gas_concs),intent(out) :: & + 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 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_cldy_lw%set_ice_roughness(nrghice)) + call check_error_msg(kdist_cldy_lw%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_cldy_lw%set_ice_roughness(nrghice)) + call check_error_msg(kdist_cldy_lw%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 rrtmgp_lw_pre_init !> \section arg_table_rrtmgp_lw_pre_run Argument Table !! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional | @@ -26,7 +691,6 @@ end subroutine rrtmgp_lw_pre_init !! | 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 | !! | sfc_emiss_byband | surface_longwave_emissivity_in_each_band | surface lw emissivity in fraction in each LW band | frac | 2 | real | kind_phys | inout | F | !! - subroutine rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, kdist_lw, sfc_emiss_byband, errmsg, errflg) use machine, only: kind_phys