diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 000000000000..9a3a83037f43 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,20 @@ +# This is the list of E3SM's significant contributing institutions in +# alphabetical order. +# +# This does not list every person who has contributed code, +# since many employees of one institution may be contributing. +# To see the full list of contributors, see the revision history in +# source control. Note that revision history for code imported +# at the start of the repository was not retained. +# Code in submodules is also not included. + +Argonne National Laboratory +Brookhaven National Laboratory +Lawrence Berkeley National Laboratory +Lawrence Livermore National Laboratory +Los Alamos National Laboratory +National Center for Atmospheric Research +Oak Ridge National Laboratory +Pacific Northwest National Laboratory +Sandia National Laboratory + diff --git a/CITATION.cff b/CITATION.cff new file mode 100644 index 000000000000..bf980f74f6d3 --- /dev/null +++ b/CITATION.cff @@ -0,0 +1,15 @@ +# This CITATION.cff file was generated with cffinit. +# Visit https://bit.ly/cffinit to generate yours today! + +cff-version: 1.2.0 +title: Energy Exascale Earth System Model +message: ' If you use this software, please cite it using the metadata from this file.' +type: software +authors: + - given-names: E3SM + family-names: Project +version: 2.1.0 +doi: 10.11578/E3SM/dc.20230110.5 +repository-code: 'https://github.com/E3SM-Project/E3SM' +url: 'https://e3sm.org' +license: BSD-3-Clause diff --git a/LICENSE b/LICENSE index 0ce2c2832b5a..d74a2aa127a0 100644 --- a/LICENSE +++ b/LICENSE @@ -2,7 +2,7 @@ Except for the separable pieces descibed below, E3SM is released under the following 3-Clause BSD Open Source license. ******************************************************************************* -Copyright ©2021, UChicago Argonne, LLC All Rights Reserved +Copyright ©2023, UChicago Argonne, LLC All Rights Reserved Software Name: Energy Exascale Earth System Model (E3SM) diff --git a/README.md b/README.md index 7443e985e0b9..84eb15d8e186 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ the most challenging and demanding climate-change research problems and Department of Energy mission needs while efficiently using DOE Leadership Computing Facilities. -DOI: [10.11578/E3SM/dc.20210927.1](http://dx.doi.org/10.11578/E3SM/dc.20210927.1) +DOI: [10.11578/E3SM/dc.20230110.5](http://dx.doi.org/10.11578/E3SM/dc.20230110.5) Please visit the [project website](https://e3sm.org) or our [Confluence site](https://acme-climate.atlassian.net/wiki/spaces/DOC/overview) for further details. @@ -64,11 +64,11 @@ the following BibTeX entry is provided. author = {{E3SM Project}}, abstractNote = {{E3SM} is a state-of-the-art fully coupled model of the {E}arth's climate including important biogeochemical and cryospheric processes.}, - howpublished = {[Computer Software] \url{https://dx.doi.org/10.11578/E3SM/dc.20210927.1}}, - url = {https://dx.doi.org/10.11578/E3SM/dc.20210927.1}, - doi = {10.11578/E3SM/dc.20210927.1}, - year = 2021, - month = sep, + howpublished = {[Computer Software] \url{https://dx.doi.org/10.11578/E3SM/dc.20230110.5}}, + url = {https://dx.doi.org/10.11578/E3SM/dc.20230110.5}, + doi = {10.11578/E3SM/dc.20230110.5}, + year = 2023, + month = jan, } ``` diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml index 64a952cc781e..f2385f35058b 100644 --- a/cime_config/allactive/config_pesall.xml +++ b/cime_config/allactive/config_pesall.xml @@ -781,6 +781,46 @@ + + + ne120-wcycl on 42 nodes 128x1c8 ~0.7 sypd + 128 + 256 + + 3072 + 384 + 3072 + 2560 + 512 + 2304 + 1 + 1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 2560 + 3072 + 0 + 0 + + + 8 + + + ne120-wcycl on 145 nodes, MPI-only diff --git a/cime_config/machines/cmake_macros/gnu_alvarez.cmake b/cime_config/machines/cmake_macros/gnu_alvarez.cmake index 89ba5a77c315..b43a0425c7e4 100644 --- a/cime_config/machines/cmake_macros/gnu_alvarez.cmake +++ b/cime_config/machines/cmake_macros/gnu_alvarez.cmake @@ -2,7 +2,7 @@ string(APPEND CONFIG_ARGS " --host=cray") if (COMP_NAME STREQUAL gptl) string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY") endif() -string(APPEND SLIBS " -L$ENV{CRAY_HDF5_PARALLEL_PREFIX}/lib -lhdf5_hl -lhdf5 -L$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX} -L$ENV{CRAY_PARALLEL_NETCDF_PREFIX}/lib -lpnetcdf -lnetcdf -lnetcdff") +string(APPEND SLIBS " -L$ENV{CRAY_HDF5_PARALLEL_PREFIX}/lib -lhdf5_hl -lhdf5 -L$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}/lib -L$ENV{CRAY_PARALLEL_NETCDF_PREFIX}/lib -lpnetcdf -lnetcdf -lnetcdff") string(APPEND SLIBS " -lblas -llapack") set(CXX_LINKER "FORTRAN") set(NETCDF_PATH "$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}") diff --git a/cime_config/machines/cmake_macros/gnu_pm-cpu.cmake b/cime_config/machines/cmake_macros/gnu_pm-cpu.cmake index 89ba5a77c315..b43a0425c7e4 100644 --- a/cime_config/machines/cmake_macros/gnu_pm-cpu.cmake +++ b/cime_config/machines/cmake_macros/gnu_pm-cpu.cmake @@ -2,7 +2,7 @@ string(APPEND CONFIG_ARGS " --host=cray") if (COMP_NAME STREQUAL gptl) string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY") endif() -string(APPEND SLIBS " -L$ENV{CRAY_HDF5_PARALLEL_PREFIX}/lib -lhdf5_hl -lhdf5 -L$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX} -L$ENV{CRAY_PARALLEL_NETCDF_PREFIX}/lib -lpnetcdf -lnetcdf -lnetcdff") +string(APPEND SLIBS " -L$ENV{CRAY_HDF5_PARALLEL_PREFIX}/lib -lhdf5_hl -lhdf5 -L$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}/lib -L$ENV{CRAY_PARALLEL_NETCDF_PREFIX}/lib -lpnetcdf -lnetcdf -lnetcdff") string(APPEND SLIBS " -lblas -llapack") set(CXX_LINKER "FORTRAN") set(NETCDF_PATH "$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}") diff --git a/cime_config/machines/cmake_macros/gnu_pm-gpu.cmake b/cime_config/machines/cmake_macros/gnu_pm-gpu.cmake index 89ba5a77c315..b43a0425c7e4 100644 --- a/cime_config/machines/cmake_macros/gnu_pm-gpu.cmake +++ b/cime_config/machines/cmake_macros/gnu_pm-gpu.cmake @@ -2,7 +2,7 @@ string(APPEND CONFIG_ARGS " --host=cray") if (COMP_NAME STREQUAL gptl) string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY") endif() -string(APPEND SLIBS " -L$ENV{CRAY_HDF5_PARALLEL_PREFIX}/lib -lhdf5_hl -lhdf5 -L$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX} -L$ENV{CRAY_PARALLEL_NETCDF_PREFIX}/lib -lpnetcdf -lnetcdf -lnetcdff") +string(APPEND SLIBS " -L$ENV{CRAY_HDF5_PARALLEL_PREFIX}/lib -lhdf5_hl -lhdf5 -L$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}/lib -L$ENV{CRAY_PARALLEL_NETCDF_PREFIX}/lib -lpnetcdf -lnetcdf -lnetcdff") string(APPEND SLIBS " -lblas -llapack") set(CXX_LINKER "FORTRAN") set(NETCDF_PATH "$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}") diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml index fbc336a6ced5..f7b9bbae3750 100644 --- a/cime_config/machines/config_machines.xml +++ b/cime_config/machines/config_machines.xml @@ -237,10 +237,10 @@ craype-accel-host cray-libsci craype - cray-mpich/8.1.17 - cray-hdf5-parallel/1.12.1.5 - cray-netcdf-hdf5parallel/4.8.1.5 - cray-parallel-netcdf/1.12.2.5 + cray-mpich/8.1.22 + cray-hdf5-parallel/1.12.2.1 + cray-netcdf-hdf5parallel/4.9.0.1 + cray-parallel-netcdf/1.12.3.1 cmake/3.22.0 @@ -359,10 +359,10 @@ cray-libsci craype - cray-mpich/8.1.17 - cray-hdf5-parallel/1.12.1.5 - cray-netcdf-hdf5parallel/4.8.1.5 - cray-parallel-netcdf/1.12.2.5 + cray-mpich/8.1.22 + cray-hdf5-parallel/1.12.2.1 + cray-netcdf-hdf5parallel/4.9.0.1 + cray-parallel-netcdf/1.12.3.1 cmake/3.22.0 diff --git a/cime_config/tests.py b/cime_config/tests.py index 83dcb68cdc04..87162dbfc445 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -91,7 +91,7 @@ "SMS_R_Ld5.ne4_ne4.FSCM-ARM97.eam-scm", "SMS_D_Ln5.ne4_oQU240.F2010", "SMS_Ln5.ne4pg2_oQU480.F2010", - "ERS.ne4_oQU240.F2010.eam-hommexx" + "ERS_D.ne4_oQU240.F2010.eam-hommexx" ) }, diff --git a/codemeta.json b/codemeta.json index debd9c96c299..03371bc06331 100644 --- a/codemeta.json +++ b/codemeta.json @@ -7,11 +7,11 @@ "name": "E3SM Project", } ], - "identifier": "http://dx.doi.org/10.11578/E3SM/dc.20180418.36", + "identifier": "http://dx.doi.org/10.11578/E3SM/dc.20230110.5", "codeRepository": "https://github.com/E3SM-Project/E3SM", - "datePublished": "2018-04-20", + "datePublished": "2023-01-11", "keywords": "climate modeling", "license": "BSD", "title": "Energy Exascale Earth System Model", - "version": "v1.0.0" + "version": "v2.1.0" } diff --git a/components/eam/cime_config/config_pes.xml b/components/eam/cime_config/config_pes.xml index bf1a345ad766..6f4c94228661 100644 --- a/components/eam/cime_config/config_pes.xml +++ b/components/eam/cime_config/config_pes.xml @@ -1663,6 +1663,36 @@ + + + pm-cpu ne120pg2 F-compset with MPASSI on 43 nodes 128x1c8 0.6 sypd + 128 + 256 + + 5504 + 5504 + 5504 + 5200 + 5200 + 64 + 64 + 688 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 8 + + + ne120 F-compset on 128 nodes 0.524sypd diff --git a/components/eam/src/physics/crm/crm_history.F90 b/components/eam/src/physics/crm/crm_history.F90 index f44d69b7745f..e7534c2d3adc 100644 --- a/components/eam/src/physics/crm/crm_history.F90 +++ b/components/eam/src/physics/crm/crm_history.F90 @@ -132,55 +132,16 @@ subroutine crm_history_init(species_class) call addfld('AOD700', horiz_only,'A', 'unitless', 'Aerosol optical depth at 700nm', flag_xyfill=.true.) !---------------------------------------------------------------------------- - ! 2-moment microphysics variables - if (MMF_microphysics_scheme .eq. 'm2005') then - call addfld('MMF_NC ',(/'lev'/), 'A', '/kg', 'Cloud water dropet number from CRM') - call addfld('MMF_NI ',(/'lev'/), 'A', '/kg', 'Cloud ice crystal number from CRM') - call addfld('MMF_NS ',(/'lev'/), 'A', '/kg', 'Snow particle number from CRM') - call addfld('MMF_NG ',(/'lev'/), 'A', '/kg', 'Graupel particle number from CRM') - call addfld('MMF_NR ',(/'lev'/), 'A', '/kg', 'Rain particle number from CRM') - - call addfld('CRM_FLIQ ',dims_crm_3D, 'A', '1', 'Frequency of Occurrence of Liquid' ) - call addfld('CRM_FICE ',dims_crm_3D, 'A', '1', 'Frequency of Occurrence of Ice' ) - call addfld('CRM_FRAIN',dims_crm_3D, 'A', '1', 'Frequency of Occurrence of Rain' ) - call addfld('CRM_FSNOW',dims_crm_3D, 'A', '1', 'Frequency of Occurrence of Snow' ) - call addfld('CRM_FGRAP',dims_crm_3D, 'A', '1', 'Frequency of Occurrence of Graupel' ) - - call addfld('CRM_QS ',dims_crm_3D, 'A', 'kg/kg','Snow mixing ratio from CRM' ) - call addfld('CRM_QG ',dims_crm_3D, 'A', 'kg/kg','Graupel mixing ratio from CRM' ) + ! P3 microphysics variables + if (MMF_microphysics_scheme .eq. 'p3') then + call addfld('MMF_NC ',(/'lev'/), 'A', '/kg', 'Cloud water dropet number from CRM') + call addfld('MMF_NI ',(/'lev'/), 'A', '/kg', 'Cloud ice crystal number from CRM') + call addfld('MMF_NR ',(/'lev'/), 'A', '/kg', 'Rain particle number from CRM') call addfld('CRM_QR ',dims_crm_3D, 'A', 'kg/kg','Rain mixing ratio from CRM' ) - call addfld('CRM_NC ',dims_crm_3D, 'A', '/kg', 'Cloud water dropet number from CRM' ) call addfld('CRM_NI ',dims_crm_3D, 'A', '/kg', 'Cloud ice crystal number from CRM' ) - call addfld('CRM_NS ',dims_crm_3D, 'A', '/kg', 'Snow particle number from CRM' ) - call addfld('CRM_NG ',dims_crm_3D, 'A', '/kg', 'Graupel particle number from CRM' ) call addfld('CRM_NR ',dims_crm_3D, 'A', '/kg', 'Rain particle number from CRM' ) - - ! below is for *instantaneous* crm output - call addfld('CRM_AUT ',dims_crm_3D, 'A', '/s', 'Autoconversion cloud waterfrom CRM' ) - call addfld('CRM_ACC ',dims_crm_3D, 'A', '/s', 'Accretion cloud water from CRM' ) - call addfld('CRM_EVPC ',dims_crm_3D, 'A', '/s', 'Evaporation cloud water from CRM' ) - call addfld('CRM_EVPR ',dims_crm_3D, 'A', '/s', 'Evaporation rain from CRM' ) - call addfld('CRM_MLT ',dims_crm_3D, 'A', '/s', 'Melting ice snow graupel from CRM' ) - call addfld('CRM_SUB ',dims_crm_3D, 'A', '/s', 'Sublimation ice snow graupel from CRM' ) - call addfld('CRM_DEP ',dims_crm_3D, 'A', '/s', 'Deposition ice snow graupel from CRM' ) - call addfld('CRM_CON ',dims_crm_3D, 'A', '/s', 'Condensation cloud water from CRM' ) - - ! *gcm-grid and time-step-avg* process output - call addfld('A_AUT ',(/'lev'/), 'A', '/s', 'Avg autoconversion cloud water from CRM' ) - call addfld('A_ACC ',(/'lev'/), 'A', '/s', 'Avg accretion cloud water from CRM' ) - call addfld('A_EVPC ',(/'lev'/), 'A', '/s', 'Avg evaporation cloud water from CRM' ) - call addfld('A_EVPR ',(/'lev'/), 'A', '/s', 'Avg evaporation rain from CRM' ) - call addfld('A_MLT ',(/'lev'/), 'A', '/s', 'Avg melting ice snow graupel from CRM' ) - call addfld('A_SUB ',(/'lev'/), 'A', '/s', 'Avg sublimation ice snow graupel from CRM' ) - call addfld('A_DEP ',(/'lev'/), 'A', '/s', 'Avg deposition ice snow graupel from CRM' ) - call addfld('A_CON ',(/'lev'/), 'A', '/s', 'Avg condensation cloud water from CRM' ) - - call addfld('CRM_DES ', dims_crm_3D,'A','m^-6', 'cloud scale snow effective diameter') - call addfld('CRM_MU ', dims_crm_3D,'A','m^-6', 'cloud scale droplet size distribution shape parameter for radiation') - call addfld('CRM_LAMBDA',dims_crm_3D,'A','m^-6', 'cloud scale slope of droplet distribution for radiation') - call addfld('CRM_WVAR', dims_crm_3D,'A','m/s', 'vertical velocity variance from CRM') - end if ! MMF_microphysics_scheme .eq. 'm2005' + endif !---------------------------------------------------------------------------- ! ECPP output variables @@ -229,8 +190,6 @@ subroutine crm_history_init(species_class) call addfld('ED_CRM', (/'lev'/), 'A','/s', 'entraiment rate from downdraft') call addfld('MMF_QC', (/'lev'/), 'A','kg/kg', 'Cloud water from CRM' ) call addfld('MMF_QI', (/'lev'/), 'A','kg/kg', 'Cloud ice from CRM' ) - call addfld('MMF_QS', (/'lev'/), 'A','kg/kg', 'Snow from CRM' ) - call addfld('MMF_QG', (/'lev'/), 'A','kg/kg', 'Graupel from CRM' ) call addfld('MMF_QR', (/'lev'/), 'A','kg/kg', 'Rain from CRM' ) call addfld('MMF_QTFLX', (/'lev'/), 'A','kg/m2/s','Nonprecip. water flux from CRM' ) call addfld('MMF_UFLX', (/'lev'/), 'A','m2/s2', 'x-momentum flux from CRM' ) @@ -347,11 +306,9 @@ subroutine crm_history_init(species_class) call add_default('MMF_TLS ', 1, ' ') call add_default('MMF_SUBCYCLE_FAC', 1, ' ') - if (MMF_microphysics_scheme .eq. 'm2005') then + if (MMF_microphysics_scheme .eq. 'p3') then call add_default('MMF_NC ', 1, ' ') call add_default('MMF_NI ', 1, ' ') - call add_default('MMF_NS ', 1, ' ') - call add_default('MMF_NG ', 1, ' ') call add_default('MMF_NR ', 1, ' ') end if @@ -457,33 +414,39 @@ subroutine crm_history_out(state, ptend, crm_state, crm_rad, crm_output, & call outfld('CRM_V ',crm_state%v_wind (icol_beg:icol_end,:,:,:), ncol, lchnk ) call outfld('CRM_W ',crm_state%w_wind (icol_beg:icol_end,:,:,:), ncol, lchnk ) call outfld('CRM_T ',crm_state%temperature(icol_beg:icol_end,:,:,:), ncol, lchnk ) + call outfld('CRM_QV ',crm_state%qv(icol_beg:icol_end,:,:,:) , ncol, lchnk ) - if (MMF_microphysics_scheme .eq. 'sam1mom') then - call outfld('CRM_QV ',(crm_state%qt(icol_beg:icol_end,:,:,:) & - -crm_output%qcl(icol_beg:icol_end,:,:,:) & - -crm_output%qci(icol_beg:icol_end,:,:,:)), ncol, lchnk ) - else if (MMF_microphysics_scheme .eq. 'm2005') then - call outfld('CRM_QV ', crm_state%qt(icol_beg:icol_end,:,:,:) & - -crm_output%qcl(icol_beg:icol_end,:,:,:), ncol, lchnk ) - endif + !---------------------------------------------------------------------------- + ! Turbulence parameter on CRM grid + call outfld('CRM_TK ', crm_output%tk (icol_beg:icol_end,:,:,:),ncol, lchnk ) + call outfld('CRM_TKH', crm_output%tkh (icol_beg:icol_end,:,:,:),ncol, lchnk ) !---------------------------------------------------------------------------- ! CRM condensate and precipitation on CRM grid call outfld('CRM_QC ',crm_output%qcl (icol_beg:icol_end,:,:,:),ncol, lchnk ) call outfld('CRM_QI ',crm_output%qci (icol_beg:icol_end,:,:,:),ncol, lchnk ) - call outfld('CRM_QPC ',crm_output%qpl (icol_beg:icol_end,:,:,:),ncol, lchnk ) - call outfld('CRM_QPI ',crm_output%qpi (icol_beg:icol_end,:,:,:),ncol, lchnk ) call outfld('CRM_PREC',crm_output%prec_crm(icol_beg:icol_end,:,:), ncol, lchnk ) - call outfld('CRM_TK ', crm_output%tk (icol_beg:icol_end,:,:,:),ncol, lchnk ) - call outfld('CRM_TKH', crm_output%tkh (icol_beg:icol_end,:,:,:),ncol, lchnk ) + if (MMF_microphysics_scheme .eq. 'sam1mom') then + call outfld('CRM_QPC ',crm_output%qpl (icol_beg:icol_end,:,:,:),ncol, lchnk ) + call outfld('CRM_QPI ',crm_output%qpi (icol_beg:icol_end,:,:,:),ncol, lchnk ) + end if + if (MMF_microphysics_scheme .eq. 'p3') then + call outfld('CRM_NC ',crm_state%nc(icol_beg:icol_end,:,:,:), ncol, lchnk ) + call outfld('CRM_NI ',crm_state%ni(icol_beg:icol_end,:,:,:), ncol, lchnk ) + call outfld('CRM_NR ',crm_state%nr(icol_beg:icol_end,:,:,:), ncol, lchnk ) + call outfld('CRM_QR ',crm_state%qr(icol_beg:icol_end,:,:,:), ncol, lchnk ) + endif !---------------------------------------------------------------------------- ! CRM domain average condensate and precipitation call outfld('MMF_QC ',crm_output%qc_mean(icol_beg:icol_end,:), ncol ,lchnk ) call outfld('MMF_QI ',crm_output%qi_mean(icol_beg:icol_end,:), ncol ,lchnk ) - call outfld('MMF_QS ',crm_output%qs_mean(icol_beg:icol_end,:), ncol ,lchnk ) - call outfld('MMF_QG ',crm_output%qg_mean(icol_beg:icol_end,:), ncol ,lchnk ) call outfld('MMF_QR ',crm_output%qr_mean(icol_beg:icol_end,:), ncol ,lchnk ) + if (MMF_microphysics_scheme .eq. 'p3') then + call outfld('MMF_NC ',crm_output%nc_mean(icol_beg:icol_end,:), ncol, lchnk ) + call outfld('MMF_NI ',crm_output%ni_mean(icol_beg:icol_end,:), ncol, lchnk ) + call outfld('MMF_NR ',crm_output%nr_mean(icol_beg:icol_end,:), ncol, lchnk ) + endif !---------------------------------------------------------------------------- ! CRM domain average fluxes @@ -528,49 +491,6 @@ subroutine crm_history_out(state, ptend, crm_state, crm_rad, crm_output, & call outfld('DU_CRM ', crm_output%du_crm(icol_beg:icol_end,:), ncol, lchnk ) call outfld('ED_CRM ', crm_output%ed_crm(icol_beg:icol_end,:), ncol, lchnk ) -#ifdef m2005 - if (MMF_microphysics_scheme .eq. 'm2005') then - ! index is defined in MICRO_M2005/microphysics.F90 - ! Be cautious to use them here. They are defined in crm codes, and these codes are called only - ! after the subroutine of crm is called. So they can only be used after the 'crm' subroutine. - ! incl, inci, ... can not be used here, for they are defined before we call them??? - call outfld('CRM_NC ',crm_state%nc(icol_beg:icol_end,:,:,:), ncol, lchnk ) - call outfld('CRM_NI ',crm_state%ni(icol_beg:icol_end,:,:,:), ncol, lchnk ) - call outfld('CRM_NR ',crm_state%nr(icol_beg:icol_end,:,:,:), ncol, lchnk ) - call outfld('CRM_NS ',crm_state%ns(icol_beg:icol_end,:,:,:), ncol, lchnk ) - call outfld('CRM_NG ',crm_state%ng(icol_beg:icol_end,:,:,:), ncol, lchnk ) - call outfld('CRM_QR ',crm_state%qr(icol_beg:icol_end,:,:,:), ncol, lchnk ) - call outfld('CRM_QS ',crm_state%qs(icol_beg:icol_end,:,:,:), ncol, lchnk ) - call outfld('CRM_QG ',crm_state%qg(icol_beg:icol_end,:,:,:), ncol, lchnk ) - - call outfld('CRM_WVAR',crm_output%wvar(icol_beg:icol_end,:,:,:), ncol, lchnk) - - call outfld('CRM_AUT', crm_output%aut (icol_beg:icol_end,:,:,:), ncol, lchnk) - call outfld('CRM_ACC', crm_output%acc (icol_beg:icol_end,:,:,:), ncol, lchnk) - call outfld('CRM_MLT', crm_output%mlt (icol_beg:icol_end,:,:,:), ncol, lchnk) - call outfld('CRM_SUB', crm_output%sub (icol_beg:icol_end,:,:,:), ncol, lchnk) - call outfld('CRM_DEP', crm_output%dep (icol_beg:icol_end,:,:,:), ncol, lchnk) - call outfld('CRM_CON', crm_output%con (icol_beg:icol_end,:,:,:), ncol, lchnk) - call outfld('CRM_EVPC',crm_output%evpc(icol_beg:icol_end,:,:,:), ncol, lchnk) - call outfld('CRM_EVPR',crm_output%evpr(icol_beg:icol_end,:,:,:), ncol, lchnk) - - call outfld('A_AUT', crm_output%aut_a (icol_beg:icol_end,:), ncol, lchnk) - call outfld('A_ACC', crm_output%acc_a (icol_beg:icol_end,:), ncol, lchnk) - call outfld('A_MLT', crm_output%mlt_a (icol_beg:icol_end,:), ncol, lchnk) - call outfld('A_SUB', crm_output%sub_a (icol_beg:icol_end,:), ncol, lchnk) - call outfld('A_DEP', crm_output%dep_a (icol_beg:icol_end,:), ncol, lchnk) - call outfld('A_CON', crm_output%con_a (icol_beg:icol_end,:), ncol, lchnk) - call outfld('A_EVPC',crm_output%evpc_a(icol_beg:icol_end,:), ncol, lchnk) - call outfld('A_EVPR',crm_output%evpr_a(icol_beg:icol_end,:), ncol, lchnk) - - call outfld('MMF_NC ',crm_output%nc_mean(icol_beg:icol_end,:), ncol, lchnk ) - call outfld('MMF_NI ',crm_output%ni_mean(icol_beg:icol_end,:), ncol, lchnk ) - call outfld('MMF_NS ',crm_output%ns_mean(icol_beg:icol_end,:), ncol, lchnk ) - call outfld('MMF_NG ',crm_output%ng_mean(icol_beg:icol_end,:), ncol, lchnk ) - call outfld('MMF_NR ',crm_output%nr_mean(icol_beg:icol_end,:), ncol, lchnk ) - endif ! m2005 -#endif /* m2005 */ - !---------------------------------------------------------------------------- ! Compute liquid water paths (for diagnostics only) tgicewp(1:ncol) = 0. diff --git a/components/eam/src/physics/crm/crm_input_module.F90 b/components/eam/src/physics/crm/crm_input_module.F90 index 2642dd55b785..122be63d6d17 100644 --- a/components/eam/src/physics/crm/crm_input_module.F90 +++ b/components/eam/src/physics/crm/crm_input_module.F90 @@ -38,10 +38,6 @@ module crm_input_module real(crm_rknd), allocatable :: fluxt00(:) ! surface sensible heat fluxes [K Kg/ (m2 s)] real(crm_rknd), allocatable :: fluxq00(:) ! surface latent heat fluxes [ kg/(m2 s)] - real(crm_rknd), allocatable :: naermod (:,:,:) ! Aerosol number concentration [/m3] - real(crm_rknd), allocatable :: vaerosol(:,:,:) ! aerosol volume concentration [m3/m3] - real(crm_rknd), allocatable :: hygro (:,:,:) ! hygroscopicity of aerosol mode - real(crm_rknd), allocatable :: ul_esmt(:,:) ! input u for ESMT real(crm_rknd), allocatable :: vl_esmt(:,:) ! input v for ESMT @@ -49,6 +45,11 @@ module crm_input_module real(crm_rknd), allocatable :: q_vt(:,:) ! CRM input of variance used for forcing tendency real(crm_rknd), allocatable :: u_vt(:,:) ! CRM input of variance used for forcing tendency + ! inputs for P3 + real(crm_rknd), allocatable :: nccn(:,:) ! CCN number concentration [kg-1] + real(crm_rknd), allocatable :: nc_nuceat_tend(:,:) ! activated CCN number tendency [kg-1 s-1] + real(crm_rknd), allocatable :: ni_activated(:,:) ! activated ice nuclei concentration [kg-1] + end type crm_input_type !------------------------------------------------------------------------------------------------ @@ -104,15 +105,6 @@ subroutine crm_input_initialize(input, ncrms, nlev, MMF_microphysics_scheme) call prefetch(input%fluxt00) call prefetch(input%fluxq00) - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then - if (.not. allocated(input%naermod)) allocate(input%naermod(ncrms,nlev,ntot_amode)) - if (.not. allocated(input%vaerosol)) allocate(input%vaerosol(ncrms,nlev,ntot_amode)) - if (.not. allocated(input%hygro)) allocate(input%hygro(ncrms,nlev,ntot_amode)) - call prefetch(input%naermod) - call prefetch(input%vaerosol) - call prefetch(input%hygro) - end if - if (.not. allocated(input%ul_esmt)) allocate(input%ul_esmt(ncrms,nlev)) if (.not. allocated(input%vl_esmt)) allocate(input%vl_esmt(ncrms,nlev)) @@ -123,6 +115,15 @@ subroutine crm_input_initialize(input, ncrms, nlev, MMF_microphysics_scheme) call prefetch(input%q_vt) call prefetch(input%u_vt) + if (trim(MMF_microphysics_scheme).eq.'p3') then + if (.not. allocated(input%nccn )) allocate(input%nccn(ncrms,nlev)) + if (.not. allocated(input%nc_nuceat_tend)) allocate(input%nc_nuceat_tend(ncrms,nlev)) + if (.not. allocated(input%ni_activated )) allocate(input%ni_activated(ncrms,nlev)) + call prefetch(input%nccn) + call prefetch(input%nc_nuceat_tend) + call prefetch(input%ni_activated) + end if + ! Initialize input%zmid = 0 input%zint = 0 @@ -147,12 +148,6 @@ subroutine crm_input_initialize(input, ncrms, nlev, MMF_microphysics_scheme) input%fluxt00 = 0 input%fluxq00 = 0 - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then - input%naermod = 0 - input%vaerosol = 0 - input%hygro = 0 - end if - input%ul_esmt = 0 input%vl_esmt = 0 @@ -160,6 +155,12 @@ subroutine crm_input_initialize(input, ncrms, nlev, MMF_microphysics_scheme) input%q_vt = 0 input%u_vt = 0 + if (trim(MMF_microphysics_scheme).eq.'p3') then + input%nccn = 0 + input%nc_nuceat_tend = 0 + input%ni_activated = 0 + end if + end subroutine crm_input_initialize !------------------------------------------------------------------------------------------------ subroutine crm_input_finalize(input, MMF_microphysics_scheme) @@ -189,12 +190,6 @@ subroutine crm_input_finalize(input, MMF_microphysics_scheme) if (allocated(input%fluxt00)) deallocate(input%fluxt00) if (allocated(input%fluxq00)) deallocate(input%fluxq00) - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then - if (allocated(input%naermod)) deallocate(input%naermod) - if (allocated(input%vaerosol)) deallocate(input%vaerosol) - if (allocated(input%hygro)) deallocate(input%hygro) - end if - if (allocated(input%ul_esmt)) deallocate(input%ul_esmt) if (allocated(input%vl_esmt)) deallocate(input%vl_esmt) @@ -202,6 +197,10 @@ subroutine crm_input_finalize(input, MMF_microphysics_scheme) if (allocated(input%q_vt)) deallocate(input%q_vt) if (allocated(input%u_vt)) deallocate(input%u_vt) + if (allocated(input%nccn )) deallocate(input%nccn) + if (allocated(input%nc_nuceat_tend)) deallocate(input%nc_nuceat_tend) + if (allocated(input%ni_activated )) deallocate(input%ni_activated) + end subroutine crm_input_finalize end module crm_input_module diff --git a/components/eam/src/physics/crm/crm_output_module.F90 b/components/eam/src/physics/crm/crm_output_module.F90 index d01077cc0172..9cc39940da10 100644 --- a/components/eam/src/physics/crm/crm_output_module.F90 +++ b/components/eam/src/physics/crm/crm_output_module.F90 @@ -51,26 +51,14 @@ module crm_output_module ! crm_physics_tend, from, for example, something like crm_output%uwind - crm_input%uwind. real(crm_rknd), allocatable :: qc_mean(:,:) ! mean cloud water real(crm_rknd), allocatable :: qi_mean(:,:) ! mean cloud ice + real(crm_rknd), allocatable :: qr_mean(:,:) ! mean rain real(crm_rknd), allocatable :: qs_mean(:,:) ! mean snow real(crm_rknd), allocatable :: qg_mean(:,:) ! mean graupel - real(crm_rknd), allocatable :: qr_mean(:,:) ! mean rain real(crm_rknd), allocatable :: nc_mean(:,:) ! mean cloud water (#/kg) real(crm_rknd), allocatable :: ni_mean(:,:) ! mean cloud ice (#/kg) - real(crm_rknd), allocatable :: ns_mean(:,:) ! mean snow (#/kg) - real(crm_rknd), allocatable :: ng_mean(:,:) ! mean graupel (#/kg) real(crm_rknd), allocatable :: nr_mean(:,:) ! mean rain (#/kg) - ! Time and domain averaged process rates - real(crm_rknd), allocatable :: aut_a (:,:) ! cloud water autoconversion (1/s) - real(crm_rknd), allocatable :: acc_a (:,:) ! cloud water accretion (1/s) - real(crm_rknd), allocatable :: evpc_a(:,:) ! cloud water evaporation (1/s) - real(crm_rknd), allocatable :: evpr_a(:,:) ! rain evaporation (1/s) - real(crm_rknd), allocatable :: mlt_a (:,:) ! ice, snow, graupel melting (1/s) - real(crm_rknd), allocatable :: sub_a (:,:) ! ice, snow, graupel sublimation (1/s) - real(crm_rknd), allocatable :: dep_a (:,:) ! ice, snow, graupel deposition (1/s) - real(crm_rknd), allocatable :: con_a (:,:) ! cloud water condensation(1/s) - real(crm_rknd), allocatable :: ultend (:,:) ! CRM output tendency of zonal wind real(crm_rknd), allocatable :: vltend (:,:) ! CRM output tendency of meridional wind real(crm_rknd), allocatable :: sltend (:,:) ! CRM output tendency of static energy @@ -176,9 +164,9 @@ subroutine crm_output_initialize(output, ncol, nlev, crm_nx, crm_ny, crm_nz, MMF if (.not. allocated(output%qc_mean)) allocate(output%qc_mean(ncol,nlev)) if (.not. allocated(output%qi_mean)) allocate(output%qi_mean(ncol,nlev)) + if (.not. allocated(output%qr_mean)) allocate(output%qr_mean(ncol,nlev)) if (.not. allocated(output%qs_mean)) allocate(output%qs_mean(ncol,nlev)) if (.not. allocated(output%qg_mean)) allocate(output%qg_mean(ncol,nlev)) - if (.not. allocated(output%qr_mean)) allocate(output%qr_mean(ncol,nlev)) call prefetch(output%qcl) call prefetch(output%qci) @@ -207,26 +195,13 @@ subroutine crm_output_initialize(output, ncol, nlev, crm_nx, crm_ny, crm_nz, MMF call prefetch(output%cldtop) call prefetch(output%qc_mean) call prefetch(output%qi_mean) + call prefetch(output%qr_mean) call prefetch(output%qs_mean) call prefetch(output%qg_mean) - call prefetch(output%qr_mean) - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then - if (.not. allocated(output%nc_mean)) allocate(output%nc_mean(ncol,nlev)) - if (.not. allocated(output%ni_mean)) allocate(output%ni_mean(ncol,nlev)) - if (.not. allocated(output%ns_mean)) allocate(output%ns_mean(ncol,nlev)) - if (.not. allocated(output%ng_mean)) allocate(output%ng_mean(ncol,nlev)) - if (.not. allocated(output%nr_mean)) allocate(output%nr_mean(ncol,nlev)) - - if (.not. allocated(output%aut_a )) allocate(output%aut_a (ncol,nlev)) - if (.not. allocated(output%acc_a )) allocate(output%acc_a (ncol,nlev)) - if (.not. allocated(output%evpc_a)) allocate(output%evpc_a(ncol,nlev)) - if (.not. allocated(output%evpr_a)) allocate(output%evpr_a(ncol,nlev)) - if (.not. allocated(output%mlt_a )) allocate(output%mlt_a (ncol,nlev)) - if (.not. allocated(output%sub_a )) allocate(output%sub_a (ncol,nlev)) - if (.not. allocated(output%dep_a )) allocate(output%dep_a (ncol,nlev)) - if (.not. allocated(output%con_a )) allocate(output%con_a (ncol,nlev)) - end if + if (.not. allocated(output%nc_mean)) allocate(output%nc_mean(ncol,nlev)) + if (.not. allocated(output%ni_mean)) allocate(output%ni_mean(ncol,nlev)) + if (.not. allocated(output%nr_mean)) allocate(output%nr_mean(ncol,nlev)) if (.not. allocated(output%ultend )) allocate(output%ultend (ncol,nlev)) if (.not. allocated(output%vltend )) allocate(output%vltend (ncol,nlev)) @@ -368,26 +343,13 @@ subroutine crm_output_initialize(output, ncol, nlev, crm_nx, crm_ny, crm_nz, MMF output%qc_mean = 0 output%qi_mean = 0 + output%qr_mean = 0 output%qs_mean = 0 output%qg_mean = 0 - output%qr_mean = 0 - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then - output%nc_mean = 0 - output%ni_mean = 0 - output%ns_mean = 0 - output%ng_mean = 0 - output%nr_mean = 0 - - output%aut_a = 0 - output%acc_a = 0 - output%evpc_a = 0 - output%evpr_a = 0 - output%mlt_a = 0 - output%sub_a = 0 - output%dep_a = 0 - output%con_a = 0 - end if + output%nc_mean = 0 + output%ni_mean = 0 + output%nr_mean = 0 output%ultend = 0 output%vltend = 0 @@ -482,27 +444,13 @@ subroutine crm_output_finalize(output, MMF_microphysics_scheme) if (allocated(output%qc_mean)) deallocate(output%qc_mean) if (allocated(output%qi_mean)) deallocate(output%qi_mean) + if (allocated(output%qr_mean)) deallocate(output%qr_mean) if (allocated(output%qs_mean)) deallocate(output%qs_mean) if (allocated(output%qg_mean)) deallocate(output%qg_mean) - if (allocated(output%qr_mean)) deallocate(output%qr_mean) - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then - if (allocated(output%nc_mean)) deallocate(output%nc_mean) - if (allocated(output%ni_mean)) deallocate(output%ni_mean) - if (allocated(output%ns_mean)) deallocate(output%ns_mean) - if (allocated(output%ng_mean)) deallocate(output%ng_mean) - if (allocated(output%nr_mean)) deallocate(output%nr_mean) - - ! Time and domain-averaged process rates - if (allocated(output%aut_a)) deallocate(output%aut_a) - if (allocated(output%acc_a)) deallocate(output%acc_a) - if (allocated(output%evpc_a)) deallocate(output%evpc_a) - if (allocated(output%evpr_a)) deallocate(output%evpr_a) - if (allocated(output%mlt_a)) deallocate(output%mlt_a) - if (allocated(output%sub_a)) deallocate(output%sub_a) - if (allocated(output%dep_a)) deallocate(output%dep_a) - if (allocated(output%con_a)) deallocate(output%con_a) - end if + if (allocated(output%nc_mean)) deallocate(output%nc_mean) + if (allocated(output%ni_mean)) deallocate(output%ni_mean) + if (allocated(output%nr_mean)) deallocate(output%nr_mean) if (allocated(output%ultend)) deallocate(output%ultend) if (allocated(output%vltend)) deallocate(output%vltend) diff --git a/components/eam/src/physics/crm/crm_physics.F90 b/components/eam/src/physics/crm/crm_physics.F90 index 78a2d9583fa1..b60fdaebf968 100644 --- a/components/eam/src/physics/crm/crm_physics.F90 +++ b/components/eam/src/physics/crm/crm_physics.F90 @@ -9,7 +9,7 @@ module crm_physics use physics_types, only: physics_state, physics_tend use ppgrid, only: begchunk, endchunk, pcols, pver, pverp use constituents, only: pcnst -#ifdef MODAL_AERO +#if defined(MODAL_AERO) use modal_aero_data, only: ntot_amode #endif @@ -22,13 +22,11 @@ module crm_physics public :: crm_physics_final public :: crm_physics_tend public :: crm_surface_flux_bypass_tend - public :: m2005_effradius integer, public :: ncrms = -1 ! total number of CRMs summed over all chunks in task - ! Constituent names - character(len=8), parameter :: cnst_names(8) = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE', & - 'RAINQM', 'SNOWQM','NUMRAI','NUMSNO'/) + ! Constituent names - assigned according to MMF_microphysics_scheme + character(len=8) :: cnst_names(8) integer :: ixcldliq = -1 ! cloud liquid amount index integer :: ixcldice = -1 ! cloud ice amount index @@ -38,6 +36,8 @@ module crm_physics integer :: ixsnow = -1 ! snow index integer :: ixnumrain = -1 ! rain number index integer :: ixnumsnow = -1 ! snow number index + integer :: ixcldrim = -1 ! ice rime mass mixing ratio index + integer :: ixrimvol = -1 ! ice rime volume mixing ratio index integer :: idx_vt_t = -1 ! CRM variance transport - liquid static energy integer :: idx_vt_q = -1 ! CRM variance transport - total water integer :: idx_vt_u = -1 ! CRM variance transport - horizontal momentum @@ -62,6 +62,9 @@ module crm_physics integer :: crm_qs_rad_idx = -1 integer :: crm_ns_rad_idx = -1 + integer :: crm_t_prev_idx = -1 + integer :: crm_q_prev_idx = -1 + contains !=================================================================================================== !=================================================================================================== @@ -82,11 +85,11 @@ subroutine crm_physics_register() use crm_history, only: crm_history_register #if defined(MMF_SAMXX) use cpp_interface_mod, only: setparm - use gator_mod, only: gator_init + use gator_mod, only: gator_init #elif defined(MMF_SAM) || defined(MMF_SAMOMP) use setparm_mod , only: setparm #endif -#ifdef MODAL_AERO +#if defined(MODAL_AERO) use modal_aero_data, only: ntot_amode #endif !---------------------------------------------------------------------------- @@ -103,7 +106,7 @@ subroutine crm_physics_register() integer, dimension(4) :: dims_crm_rad integer :: cnst_ind ! dummy for adding new constituents for variance transport !---------------------------------------------------------------------------- -#ifdef MMF_SAMXX +#if defined(MMF_SAMXX) call gator_init() #endif @@ -155,14 +158,27 @@ subroutine crm_physics_register() !---------------------------------------------------------------------------- ! constituents !---------------------------------------------------------------------------- - call cnst_add(cnst_names(1), mwdry, cpair, 0._r8, ixcldliq, longname='Grid box averaged cld liquid amount',is_convtran1=.true.) - call cnst_add(cnst_names(2), mwdry, cpair, 0._r8, ixcldice, longname='Grid box averaged cld ice amount', is_convtran1=.true.) - call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, longname='Grid box averaged cld liquid number',is_convtran1=.true.) - call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, longname='Grid box averaged cld ice number', is_convtran1=.true.) - call cnst_add(cnst_names(5), mwh2o, cpair, 0._r8, ixrain, longname='Grid box averaged rain amount', is_convtran1=.true.) - call cnst_add(cnst_names(6), mwh2o, cpair, 0._r8, ixsnow, longname='Grid box averaged snow amount', is_convtran1=.true.) - call cnst_add(cnst_names(7), mwh2o, cpair, 0._r8, ixnumrain,longname='Grid box averaged rain number', is_convtran1=.true.) - call cnst_add(cnst_names(8), mwh2o, cpair, 0._r8, ixnumsnow,longname='Grid box averaged snow number', is_convtran1=.true.) + if ( MMF_microphysics_scheme .eq. 'p3' ) then + cnst_names(:) = (/'CLDLIQ','CLDICE','NUMLIQ','NUMICE','RAINQM','NUMRAI', 'CLDRIM','BVRIM '/) + call cnst_add(cnst_names(1), mwdry, cpair, 0._r8, ixcldliq, longname='Grid box averaged cld liquid amount',is_convtran1=.true.) + call cnst_add(cnst_names(2), mwdry, cpair, 0._r8, ixcldice, longname='Grid box averaged cld ice amount', is_convtran1=.true.) + call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, longname='Grid box averaged cld liquid number',is_convtran1=.true.) + call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, longname='Grid box averaged cld ice number', is_convtran1=.true.) + call cnst_add(cnst_names(5), mwh2o, cpair, 0._r8, ixrain, longname='Grid box averaged rain amount', is_convtran1=.true.) + call cnst_add(cnst_names(6), mwh2o, cpair, 0._r8, ixnumrain,longname='Grid box averaged rain number', is_convtran1=.true.) + call cnst_add(cnst_names(7), mwh2o, cpair, 0._r8, ixcldrim, longname='Grid box averaged rime amount', is_convtran1=.true.) + call cnst_add(cnst_names(8), mwh2o, cpair, 0._r8, ixrimvol, longname='Grid box averaged rime volume', is_convtran1=.true.) + else + cnst_names(:) = (/'CLDLIQ','CLDICE','NUMLIQ','NUMICE','RAINQM','SNOWQM','NUMRAI','NUMSNO'/) + call cnst_add(cnst_names(1), mwdry, cpair, 0._r8, ixcldliq, longname='Grid box averaged cld liquid amount',is_convtran1=.true.) + call cnst_add(cnst_names(2), mwdry, cpair, 0._r8, ixcldice, longname='Grid box averaged cld ice amount', is_convtran1=.true.) + call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, longname='Grid box averaged cld liquid number',is_convtran1=.true.) + call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, longname='Grid box averaged cld ice number', is_convtran1=.true.) + call cnst_add(cnst_names(5), mwh2o, cpair, 0._r8, ixrain, longname='Grid box averaged rain amount', is_convtran1=.true.) + call cnst_add(cnst_names(6), mwh2o, cpair, 0._r8, ixsnow, longname='Grid box averaged snow amount', is_convtran1=.true.) + call cnst_add(cnst_names(7), mwh2o, cpair, 0._r8, ixnumrain,longname='Grid box averaged rain number', is_convtran1=.true.) + call cnst_add(cnst_names(8), mwh2o, cpair, 0._r8, ixnumsnow,longname='Grid box averaged snow number', is_convtran1=.true.) + end if !---------------------------------------------------------------------------- ! Register MMF history variables @@ -201,33 +217,29 @@ subroutine crm_physics_register() call pbuf_add_field('CLD', 'global', dtype_r8,dims_gcm_3D,idx) ! cloud fraction call pbuf_add_field('CONCLD', 'global', dtype_r8,dims_gcm_3D,idx) ! convective cloud fraction - if (MMF_microphysics_scheme .eq. 'm2005') then + call pbuf_add_field('CRM_QV', 'global', dtype_r8,dims_crm_3D,idx) + + if (MMF_microphysics_scheme .eq. 'sam1mom') then + call pbuf_add_field('CRM_QP', 'global', dtype_r8,dims_crm_3D,idx) + call pbuf_add_field('CRM_QN', 'global', dtype_r8,dims_crm_3D,idx) + end if + + if (MMF_microphysics_scheme .eq. 'p3') then call pbuf_add_field('CRM_NC_RAD','physpkg',dtype_r8,dims_crm_rad,crm_nc_rad_idx) call pbuf_add_field('CRM_NI_RAD','physpkg',dtype_r8,dims_crm_rad,crm_ni_rad_idx) - call pbuf_add_field('CRM_QS_RAD','physpkg',dtype_r8,dims_crm_rad,crm_qs_rad_idx) - call pbuf_add_field('CRM_NS_RAD','physpkg',dtype_r8,dims_crm_rad,crm_ns_rad_idx) - - call pbuf_add_field('CRM_QT', 'global', dtype_r8,dims_crm_3D,idx) + call pbuf_add_field('CRM_QC', 'global', dtype_r8,dims_crm_3D,idx) call pbuf_add_field('CRM_NC', 'global', dtype_r8,dims_crm_3D,idx) call pbuf_add_field('CRM_QR', 'global', dtype_r8,dims_crm_3D,idx) call pbuf_add_field('CRM_NR', 'global', dtype_r8,dims_crm_3D,idx) call pbuf_add_field('CRM_QI', 'global', dtype_r8,dims_crm_3D,idx) call pbuf_add_field('CRM_NI', 'global', dtype_r8,dims_crm_3D,idx) - call pbuf_add_field('CRM_QS', 'global', dtype_r8,dims_crm_3D,idx) - call pbuf_add_field('CRM_NS', 'global', dtype_r8,dims_crm_3D,idx) - call pbuf_add_field('CRM_QG', 'global', dtype_r8,dims_crm_3D,idx) - call pbuf_add_field('CRM_NG', 'global', dtype_r8,dims_crm_3D,idx) - call pbuf_add_field('CRM_QC', 'global', dtype_r8,dims_crm_3D,idx) - - if (prog_modal_aero) then - call pbuf_add_field('RATE1_CW2PR_ST','physpkg',dtype_r8,dims_gcm_2D,idx) - end if - - else - call pbuf_add_field('CRM_QT', 'global', dtype_r8,dims_crm_3D,idx) - call pbuf_add_field('CRM_QP', 'global', dtype_r8,dims_crm_3D,idx) - call pbuf_add_field('CRM_QN', 'global', dtype_r8,dims_crm_3D,idx) + call pbuf_add_field('CRM_QM', 'global', dtype_r8,dims_crm_3D,idx) + call pbuf_add_field('CRM_BM', 'global', dtype_r8,dims_crm_3D,idx) + call pbuf_add_field('CRM_T_PREV','global', dtype_r8,dims_crm_3D,crm_t_prev_idx) + call pbuf_add_field('CRM_Q_PREV','global', dtype_r8,dims_crm_3D,crm_q_prev_idx) + if (prog_modal_aero) call pbuf_add_field('RATE1_CW2PR_ST','physpkg',dtype_r8,dims_gcm_2D,idx) end if + ! CRM rad stuff specific to COSP; this does not strictly need to be in ! pbuf, we could compute it in rad and pass as optional arguments, but ! this seemed to be the cleanest solution for the time being (in other @@ -365,14 +377,34 @@ subroutine crm_physics_init(state, pbuf2d, species_class) endif end do - call addfld(apcnst(ixcldliq), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' after physics' ) - call addfld(apcnst(ixcldice), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' after physics' ) - call addfld(bpcnst(ixcldliq), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' before physics' ) - call addfld(bpcnst(ixcldice), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' before physics' ) - call addfld(apcnst(ixrain), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixrain))//' after physics' ) - call addfld(apcnst(ixsnow), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' after physics' ) - call addfld(bpcnst(ixrain), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixrain))//' before physics' ) - call addfld(bpcnst(ixsnow), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' before physics' ) + if ( MMF_microphysics_scheme .eq. 'sam1mom' ) then + call addfld(apcnst(ixcldliq), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' after physics' ) + call addfld(apcnst(ixcldice), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' after physics' ) + call addfld(bpcnst(ixcldliq), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' before physics' ) + call addfld(bpcnst(ixcldice), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' before physics' ) + call addfld(apcnst(ixrain), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixrain))//' after physics' ) + call addfld(apcnst(ixsnow), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' after physics' ) + call addfld(bpcnst(ixrain), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixrain))//' before physics' ) + call addfld(bpcnst(ixsnow), (/'lev'/), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' before physics' ) + end if + if ( MMF_microphysics_scheme .eq. 'p3' ) then + call addfld(apcnst(ixcldliq ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixcldliq ))//' after physics' ) + call addfld(bpcnst(ixcldliq ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixcldliq ))//' before physics' ) + call addfld(apcnst(ixcldice ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixcldice ))//' after physics' ) + call addfld(bpcnst(ixcldice ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixcldice ))//' before physics' ) + call addfld(apcnst(ixnumliq ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixnumliq ))//' after physics' ) + call addfld(bpcnst(ixnumliq ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixnumliq ))//' before physics' ) + call addfld(apcnst(ixnumice ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixnumice ))//' after physics' ) + call addfld(bpcnst(ixnumice ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixnumice ))//' before physics' ) + call addfld(apcnst(ixrain ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixrain ))//' after physics' ) + call addfld(bpcnst(ixrain ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixrain ))//' before physics' ) + call addfld(apcnst(ixnumrain),(/'lev'/),'A','kg/kg',trim(cnst_name(ixnumrain))//' after physics' ) + call addfld(bpcnst(ixnumrain),(/'lev'/),'A','kg/kg',trim(cnst_name(ixnumrain))//' before physics' ) + call addfld(apcnst(ixcldrim ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixcldrim ))//' after physics' ) + call addfld(bpcnst(ixcldrim ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixcldrim ))//' before physics' ) + call addfld(apcnst(ixrimvol ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixrimvol ))//' after physics' ) + call addfld(bpcnst(ixrimvol ),(/'lev'/),'A','kg/kg',trim(cnst_name(ixrimvol ))//' before physics' ) + end if if (use_MMF_VT) then ! initialize variance transport tracers @@ -398,12 +430,6 @@ subroutine crm_physics_init(state, pbuf2d, species_class) call pbuf_set_field(pbuf2d, crm_qi_rad_idx, 0._r8) call pbuf_set_field(pbuf2d, crm_cld_rad_idx,0._r8) call pbuf_set_field(pbuf2d, crm_qrad_idx, 0._r8) - if (MMF_microphysics_scheme .eq. 'm2005') then - call pbuf_set_field(pbuf2d, crm_nc_rad_idx,0._r8) - call pbuf_set_field(pbuf2d, crm_ni_rad_idx,0._r8) - call pbuf_set_field(pbuf2d, crm_qs_rad_idx,0._r8) - call pbuf_set_field(pbuf2d, crm_ns_rad_idx,0._r8) - end if call pbuf_set_field(pbuf2d, pbuf_get_index('CLDO') , 0._r8) call pbuf_set_field(pbuf2d, pbuf_get_index('PRER_EVAP') , 0._r8) @@ -481,7 +507,7 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, use phys_control, only: phys_getopts, phys_do_flux_avg use crm_history, only: crm_history_out use wv_saturation, only: qsat_water -#if (defined m2005 && defined MODAL_AERO) +#if defined(MODAL_AERO) ! modal_aero_data only exists if MODAL_AERO use modal_aero_data, only: ntot_amode, ntot_amode use ndrop, only: loadaer @@ -523,13 +549,13 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, type(physics_buffer_desc), pointer :: pbuf_chunk(:) ! temporary pbuf pointer for single chunk ! convective precipitation variables on pbuf - real(r8), pointer :: prec_dp(:) ! total precip from deep convection (ZM) [m/s] - real(r8), pointer :: snow_dp(:) ! snow from deep convection (ZM) [m/s] + real(r8), pointer :: prec_dp(:) ! total precip from deep convection [m/s] + real(r8), pointer :: snow_dp(:) ! snow from deep convection [m/s] real(r8), pointer :: ttend_dp(:,:) ! Convective heating for gravity wave drag real(r8), pointer :: mmf_clear_rh(:,:) ! clear air RH for aerosol water uptake real(r8), pointer :: cld(:,:) ! cloud fraction -#if (defined m2005 && defined MODAL_AERO) +#if defined(MODAL_AERO) real(r8), dimension(pcols) :: aerosol_num ! aerosol number concentration [/m3] real(r8), dimension(pcols) :: aerosol_vol ! aerosol voume concentration [m3/m3] real(r8), dimension(pcols) :: aerosol_hygro ! aerosol bulk hygroscopicity @@ -544,10 +570,10 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, real(r8), pointer, dimension(:,:) :: qrs ! shortwave radiative heating rate real(r8), pointer, dimension(:,:) :: qrl ! shortwave radiative heating rate - real(r8), dimension(begchunk:endchunk,pcols) :: qli_hydro_before ! column-integraetd rain + snow + graupel - real(r8), dimension(begchunk:endchunk,pcols) :: qi_hydro_before ! column-integrated snow water + graupel water - real(r8), dimension(begchunk:endchunk,pcols) :: qli_hydro_after ! column-integraetd rain + snow + graupel - real(r8), dimension(begchunk:endchunk,pcols) :: qi_hydro_after ! column-integrated snow water + graupel water + real(r8), dimension(begchunk:endchunk,pcols) :: qli_hydro_before ! column-integraetd initial precipitating water+ice + real(r8), dimension(begchunk:endchunk,pcols) :: qi_hydro_before ! column-integrated initial precipitating ice + real(r8), dimension(begchunk:endchunk,pcols) :: qli_hydro_after ! column-integraetd final precipitating water+ice + real(r8), dimension(begchunk:endchunk,pcols) :: qi_hydro_after ! column-integrated final precipitating ice real(r8) :: sfactor ! used to determine precip type for sam1mom @@ -624,21 +650,21 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, real(crm_rknd), pointer :: crm_v (:,:,:,:) ! CRM v-wind component real(crm_rknd), pointer :: crm_w (:,:,:,:) ! CRM w-wind component real(crm_rknd), pointer :: crm_t (:,:,:,:) ! CRM temperature - real(crm_rknd), pointer :: crm_qt(:,:,:,:) ! CRM total water + real(crm_rknd), pointer :: crm_qv(:,:,:,:) ! CRM water vapor mixing ratio (kg/kg of wet air) real(crm_rknd), pointer :: crm_qp(:,:,:,:) ! 1-mom mass mixing ratio of precipitating condensate real(crm_rknd), pointer :: crm_qn(:,:,:,:) ! 1-mom mass mixing ratio of cloud condensate - real(crm_rknd), pointer :: crm_nc(:,:,:,:) ! 2-mom mass mixing ratio of cloud water - real(crm_rknd), pointer :: crm_qr(:,:,:,:) ! 2-mom number concentration of cloud water - real(crm_rknd), pointer :: crm_nr(:,:,:,:) ! 2-mom mass mixing ratio of rain - real(crm_rknd), pointer :: crm_qi(:,:,:,:) ! 2-mom number concentration of rain - real(crm_rknd), pointer :: crm_ni(:,:,:,:) ! 2-mom mass mixing ratio of cloud ice - real(crm_rknd), pointer :: crm_qs(:,:,:,:) ! 2-mom number concentration of cloud ice - real(crm_rknd), pointer :: crm_ns(:,:,:,:) ! 2-mom mass mixing ratio of snow - real(crm_rknd), pointer :: crm_qg(:,:,:,:) ! 2-mom number concentration of snow - real(crm_rknd), pointer :: crm_ng(:,:,:,:) ! 2-mom mass mixing ratio of graupel - real(crm_rknd), pointer :: crm_qc(:,:,:,:) ! 2-mom number concentration of graupel + real(crm_rknd), pointer :: crm_qc(:,:,:,:) ! p3 mass mixing ratio of cloud liquid + real(crm_rknd), pointer :: crm_qr(:,:,:,:) ! p3 mass mixing ratio of rain + real(crm_rknd), pointer :: crm_qi(:,:,:,:) ! p3 mass mixing ratio of cloud ice + real(crm_rknd), pointer :: crm_nc(:,:,:,:) ! p3 number concentration of cloud water + real(crm_rknd), pointer :: crm_nr(:,:,:,:) ! p3 number concentration of rain + real(crm_rknd), pointer :: crm_ni(:,:,:,:) ! p3 number concentration of cloud ice + real(crm_rknd), pointer :: crm_qm(:,:,:,:) ! p3 rime density + real(crm_rknd), pointer :: crm_bm(:,:,:,:) ! p3 rime volume + real(crm_rknd), pointer :: crm_q_prev(:,:,:,:) ! p3 previous qv + real(crm_rknd), pointer :: crm_t_prev(:,:,:,:) ! p3 previous t !------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------ @@ -781,25 +807,38 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_V'), crm_v) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_W'), crm_w) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_T'), crm_t) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QT'), crm_qt) + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QV'), crm_qv) if (MMF_microphysics_scheme .eq. 'sam1mom') then call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QP'), crm_qp) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QN'), crm_qn) - else + else if (MMF_microphysics_scheme .eq. 'p3') then + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QC'), crm_qc) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NC'), crm_nc) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QR'), crm_qr) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NR'), crm_nr) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QI'), crm_qi) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NI'), crm_ni) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QS'), crm_qs) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NS'), crm_ns) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QG'), crm_qg) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NG'), crm_ng) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QC'), crm_qc) + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QM'), crm_qm) + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_BM'), crm_bm) + call pbuf_get_field(pbuf_chunk, crm_t_prev_idx, crm_t_prev) + call pbuf_get_field(pbuf_chunk, crm_q_prev_idx, crm_q_prev) end if - ! initialize all of total water to zero (needed for ncol < i <= pcols) - crm_qt(1:pcols,:,:,:) = 0.0_r8 + ! initialize all water to zero (needed for ncol < i <= pcols) + crm_qv(1:pcols,:,:,:) = 0.0_r8 + if (MMF_microphysics_scheme .eq. 'sam1mom') then + crm_qp(1:pcols,:,:,:) = 0.0_r8 + crm_qn(1:pcols,:,:,:) = 0.0_r8 + else if (MMF_microphysics_scheme .eq. 'p3') then + crm_qc(1:pcols,:,:,:) = 0.0_r8 + crm_nc(1:pcols,:,:,:) = 0.0_r8 + crm_qr(1:pcols,:,:,:) = 0.0_r8 + crm_nr(1:pcols,:,:,:) = 0.0_r8 + crm_qi(1:pcols,:,:,:) = 0.0_r8 + crm_ni(1:pcols,:,:,:) = 0.0_r8 + crm_qm(1:pcols,:,:,:) = 0.0_r8 + crm_bm(1:pcols,:,:,:) = 0.0_r8 + end if do i = 1,ncol do k = 1,crm_nz @@ -810,23 +849,23 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, crm_w(i,:,:,k) = 0. crm_t(i,:,:,k) = state(c)%t(i,m) - ! Initialize microphysics arrays + ! Initialize microphysics arrays if (MMF_microphysics_scheme .eq. 'sam1mom') then - crm_qt(i,:,:,k) = state(c)%q(i,m,1)+state(c)%q(i,m,ixcldliq)+state(c)%q(i,m,ixcldice) + crm_qv(i,:,:,k) = state(c)%q(i,m,1)!+state(c)%q(i,m,ixcldliq)+state(c)%q(i,m,ixcldice) crm_qp(i,:,:,k) = 0.0_r8 crm_qn(i,:,:,k) = state(c)%q(i,m,ixcldliq)+state(c)%q(i,m,ixcldice) - else if (MMF_microphysics_scheme .eq. 'm2005') then - crm_qt(i,:,:,k) = state(c)%q(i,m,1)+state(c)%q(i,m,ixcldliq) + else if (MMF_microphysics_scheme .eq. 'p3') then + crm_qv(i,:,:,k) = state(c)%q(i,m,1)!+state(c)%q(i,m,ixcldliq) crm_qc(i,:,:,k) = state(c)%q(i,m,ixcldliq) crm_qi(i,:,:,k) = state(c)%q(i,m,ixcldice) - crm_nc(i,:,:,k) = 0.0_r8 crm_qr(i,:,:,k) = 0.0_r8 - crm_nr(i,:,:,k) = 0.0_r8 + crm_nc(i,:,:,k) = 0.0_r8 crm_ni(i,:,:,k) = 0.0_r8 - crm_qs(i,:,:,k) = 0.0_r8 - crm_ns(i,:,:,k) = 0.0_r8 - crm_qg(i,:,:,k) = 0.0_r8 - crm_ng(i,:,:,k) = 0.0_r8 + crm_nr(i,:,:,k) = 0.0_r8 + crm_qm(i,:,:,k) = 0.0_r8 + crm_bm(i,:,:,k) = 0.0_r8 + crm_t_prev(i,:,:,k) = state(c)%t(i,m) + crm_q_prev(i,:,:,k) = state(c)%q(i,m,1) end if end do @@ -841,11 +880,9 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, call pbuf_get_field(pbuf_chunk, crm_qi_rad_idx, crm_qi_rad) call pbuf_get_field(pbuf_chunk, crm_cld_rad_idx,crm_cld_rad) call pbuf_get_field(pbuf_chunk, crm_qrad_idx, crm_qrad) - if (MMF_microphysics_scheme .eq. 'm2005') then + if (MMF_microphysics_scheme .eq. 'p3') then call pbuf_get_field(pbuf_chunk, crm_nc_rad_idx,crm_nc_rad) call pbuf_get_field(pbuf_chunk, crm_ni_rad_idx,crm_ni_rad) - call pbuf_get_field(pbuf_chunk, crm_qs_rad_idx,crm_qs_rad) - call pbuf_get_field(pbuf_chunk, crm_ns_rad_idx,crm_ns_rad) end if do k = 1,crm_nz @@ -857,11 +894,9 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, crm_qc_rad (i,:,:,k) = 0. crm_qi_rad (i,:,:,k) = 0. crm_cld_rad(i,:,:,k) = 0. - if (MMF_microphysics_scheme .eq. 'm2005') then + if (MMF_microphysics_scheme .eq. 'p3') then crm_nc_rad(i,:,:,k) = 0.0 crm_ni_rad(i,:,:,k) = 0.0 - crm_qs_rad(i,:,:,k) = 0.0 - crm_ns_rad(i,:,:,k) = 0.0 end if end do end do @@ -915,21 +950,22 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_V'), crm_v) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_W'), crm_w) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_T'), crm_t) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QT'), crm_qt) + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QV'), crm_qv) if (MMF_microphysics_scheme .eq. 'sam1mom') then call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QP'), crm_qp) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QN'), crm_qn) - else + end if + if (MMF_microphysics_scheme .eq. 'p3') then call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NC'), crm_nc) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QR'), crm_qr) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NR'), crm_nr) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QI'), crm_qi) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NI'), crm_ni) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QS'), crm_qs) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NS'), crm_ns) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QG'), crm_qg) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NG'), crm_ng) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QC'), crm_qc) + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QM'), crm_qm) + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_BM'), crm_bm) + call pbuf_get_field(pbuf_chunk, crm_t_prev_idx, crm_t_prev) + call pbuf_get_field(pbuf_chunk, crm_q_prev_idx, crm_q_prev) end if ! copy pbuf data into crm_state @@ -939,21 +975,22 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, crm_state%v_wind (icrm,:,:,:) = crm_v (i,:,:,:) crm_state%w_wind (icrm,:,:,:) = crm_w (i,:,:,:) crm_state%temperature(icrm,:,:,:) = crm_t (i,:,:,:) - crm_state%qt (icrm,:,:,:) = crm_qt(i,:,:,:) + crm_state%qv (icrm,:,:,:) = crm_qv(i,:,:,:) if (MMF_microphysics_scheme .eq. 'sam1mom') then crm_state%qp (icrm,:,:,:) = crm_qp(i,:,:,:) crm_state%qn (icrm,:,:,:) = crm_qn(i,:,:,:) - else - crm_state%nc (icrm,:,:,:) = crm_nc(i,:,:,:) - crm_state%qr (icrm,:,:,:) = crm_qr(i,:,:,:) - crm_state%nr (icrm,:,:,:) = crm_nr(i,:,:,:) + end if + if (MMF_microphysics_scheme .eq. 'p3') then + crm_state%qc (icrm,:,:,:) = crm_qc(i,:,:,:) crm_state%qi (icrm,:,:,:) = crm_qi(i,:,:,:) + crm_state%qr (icrm,:,:,:) = crm_qr(i,:,:,:) + crm_state%nc (icrm,:,:,:) = crm_nc(i,:,:,:) crm_state%ni (icrm,:,:,:) = crm_ni(i,:,:,:) - crm_state%qs (icrm,:,:,:) = crm_qs(i,:,:,:) - crm_state%ns (icrm,:,:,:) = crm_ns(i,:,:,:) - crm_state%qg (icrm,:,:,:) = crm_qg(i,:,:,:) - crm_state%ng (icrm,:,:,:) = crm_ng(i,:,:,:) - crm_state%qc (icrm,:,:,:) = crm_qc(i,:,:,:) + crm_state%nr (icrm,:,:,:) = crm_nr(i,:,:,:) + crm_state%qm (icrm,:,:,:) = crm_qm(i,:,:,:) + crm_state%bm (icrm,:,:,:) = crm_bm(i,:,:,:) + crm_state%t_prev (icrm,:,:,:) = crm_t_prev(i,:,:,:) + crm_state%q_prev (icrm,:,:,:) = crm_q_prev(i,:,:,:) end if end do ! i=1,ncol @@ -981,13 +1018,11 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, dp_g = state(c)%pdel(i,k)/gravit do jj = 1,crm_ny do ii = 1,crm_nx - if (MMF_microphysics_scheme .eq. 'm2005') then - qli_hydro_before(c,i) = qli_hydro_before(c,i)+(crm_state%qr(icrm,ii,jj,m)+ & - crm_state%qs(icrm,ii,jj,m)+ & - crm_state%qg(icrm,ii,jj,m)) * dp_g - qi_hydro_before(c,i) = qi_hydro_before(c,i)+(crm_state%qs(icrm,ii,jj,m)+ & - crm_state%qg(icrm,ii,jj,m)) * dp_g - else if (MMF_microphysics_scheme .eq. 'sam1mom') then + if (MMF_microphysics_scheme .eq. 'p3') then + qli_hydro_before(c,i) = qli_hydro_before(c,i)+(crm_state%qr(icrm,ii,jj,m)) * dp_g + ! TODO: how do we handle qi_hydro_before for P3? + end if + if (MMF_microphysics_scheme .eq. 'sam1mom') then sfactor = max(0._r8,min(1._r8,(crm_state%temperature(icrm,ii,jj,m)-268.16)*1./(283.16-268.16))) qli_hydro_before(c,i) = qli_hydro_before(c,i)+crm_state%qp(icrm,ii,jj,m) * dp_g qi_hydro_before(c,i) = qi_hydro_before(c,i)+crm_state%qp(icrm,ii,jj,m) * (1-sfactor) * dp_g @@ -1036,6 +1071,21 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, end do ! k=1,pver end do ! i=1,ncol + !------------------------------------------------------------------------------------------ + ! P3 input data + !------------------------------------------------------------------------------------------ + if (MMF_microphysics_scheme .eq. 'p3') then + do i = 1,ncol + icrm = ncol_sum + i + do k = 1, pver + crm_input%nccn (icrm,k) = 1e3 + crm_input%nc_nuceat_tend(icrm,k) = 1.0 ! npccn (i,l) + crm_input%ni_activated (icrm,k) = 1.0 ! ni_activated(i,l) + end do + end do + + end if + !------------------------------------------------------------------------------------------ ! Set surface flux variables !------------------------------------------------------------------------------------------ @@ -1069,7 +1119,7 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, !------------------------------------------------------------------------------------------ ! Set aerosol !------------------------------------------------------------------------------------------ -#if (defined m2005 && defined MODAL_AERO) +#if defined(MODAL_AERO) phase = 1 ! interstital aerosols only do i = 1,ncol icrm = ncol_sum + i @@ -1116,20 +1166,17 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, #if defined(MMF_SAM) || defined(MMF_SAMOMP) call t_startf ('crm_call') - call crm(ncrms, ztodt, pver, & crm_input, crm_state, crm_rad, & crm_ecpp_output, crm_output, crm_clear_rh, & latitude0, longitude0, gcolp, nstep, & use_MMF_VT_tmp, MMF_VT_wn_max, & use_crm_accel_tmp, crm_accel_factor, crm_accel_uv_tmp) - call t_stopf('crm_call') #elif defined(MMF_SAMXX) call t_startf ('crm_call') - ! Fortran classes don't translate to C++ classes, we we have to separate ! this stuff out when calling the C++ routinte crm(...) call crm(ncrms, ncrms, ztodt, pver, crm_input%bflxls, crm_input%wndls, crm_input%zmid, crm_input%zint, & @@ -1138,7 +1185,7 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, crm_input%ul_esmt, crm_input%vl_esmt, & crm_input%t_vt, crm_input%q_vt, crm_input%u_vt, & crm_state%u_wind, crm_state%v_wind, crm_state%w_wind, crm_state%temperature, & - crm_state%qt, crm_state%qp, crm_state%qn, crm_rad%qrad, crm_rad%temperature, & + crm_state%qv, crm_state%qp, crm_state%qn, crm_rad%qrad, crm_rad%temperature, & crm_rad%qv, crm_rad%qc, crm_rad%qi, crm_rad%cld, crm_output%subcycle_factor, & crm_output%prectend, crm_output%precstend, crm_output%cld, crm_output%cldtop, & crm_output%gicewp, crm_output%gliqwp, crm_output%mctot, crm_output%mcup, crm_output%mcdn, & @@ -1160,9 +1207,8 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, latitude0, longitude0, gcolp, nstep, & use_MMF_VT, MMF_VT_wn_max, use_MMF_ESMT, & use_crm_accel, crm_accel_factor, crm_accel_uv) - call t_stopf('crm_call') - + #endif deallocate(longitude0) @@ -1221,17 +1267,17 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, end do ! i = 1,ncol !------------------------------------------------------------------------------------------ - ! Populate output tendencies for 2-mom microphysics + ! Populate output tendencies for P3 microphysics !------------------------------------------------------------------------------------------ + if ( MMF_microphysics_scheme .eq. 'p3' ) then - if (MMF_microphysics_scheme .eq. 'm2005') then ptend(c)%lq(ixnumliq) = .TRUE. ptend(c)%lq(ixnumice) = .TRUE. if (use_ECPP) then ptend(c)%lq(ixrain) = .TRUE. - ptend(c)%lq(ixsnow) = .TRUE. ptend(c)%lq(ixnumrain) = .TRUE. - ptend(c)%lq(ixnumsnow) = .TRUE. + ptend(c)%lq(ixcldrim) = .TRUE. + ptend(c)%lq(ixrimvol) = .TRUE. end if do i = 1, ncol @@ -1244,9 +1290,9 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, ptend(c)%q(i,m,ixnumice) = ptend(c)%q(i,m,ixnumice) + crm_state%ni(icrm,ii,jj,k) if (use_ECPP) then ptend(c)%q(i,m,ixrain) = ptend(c)%q(i,m,ixrain) + crm_state%qr(icrm,ii,jj,k) - ptend(c)%q(i,m,ixsnow) = ptend(c)%q(i,m,ixsnow) + crm_state%qs(icrm,ii,jj,k) ptend(c)%q(i,m,ixnumrain) = ptend(c)%q(i,m,ixnumrain) + crm_state%nr(icrm,ii,jj,k) - ptend(c)%q(i,m,ixnumsnow) = ptend(c)%q(i,m,ixnumsnow) + crm_state%ns(icrm,ii,jj,k) + ptend(c)%q(i,m,ixcldrim) = ptend(c)%q(i,m,ixcldrim) + crm_state%qm(icrm,ii,jj,k) + ptend(c)%q(i,m,ixrimvol) = ptend(c)%q(i,m,ixrimvol) + crm_state%bm(icrm,ii,jj,k) end if end do end do @@ -1254,12 +1300,13 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, ptend(c)%q(i,m,ixnumice) = (ptend(c)%q(i,m,ixnumice) /(crm_nx*crm_ny) - state(c)%q(i,m,ixnumice)) /ztodt if (use_ECPP) then ptend(c)%q(i,m,ixrain) = (ptend(c)%q(i,m,ixrain) /(crm_nx*crm_ny) - state(c)%q(i,m,ixrain)) /ztodt - ptend(c)%q(i,m,ixsnow) = (ptend(c)%q(i,m,ixsnow) /(crm_nx*crm_ny) - state(c)%q(i,m,ixsnow)) /ztodt ptend(c)%q(i,m,ixnumrain) = (ptend(c)%q(i,m,ixnumrain)/(crm_nx*crm_ny) - state(c)%q(i,m,ixnumrain))/ztodt - ptend(c)%q(i,m,ixnumsnow) = (ptend(c)%q(i,m,ixnumsnow)/(crm_nx*crm_ny) - state(c)%q(i,m,ixnumsnow))/ztodt + ptend(c)%q(i,m,ixcldrim) = (ptend(c)%q(i,m,ixcldrim) /(crm_nx*crm_ny) - state(c)%q(i,m,ixcldrim)) /ztodt + ptend(c)%q(i,m,ixrimvol) = (ptend(c)%q(i,m,ixrimvol) /(crm_nx*crm_ny) - state(c)%q(i,m,ixrimvol)) /ztodt end if end do end do + end if !------------------------------------------------------------------------------------------ @@ -1385,11 +1432,9 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, call pbuf_get_field(pbuf_chunk, crm_cld_rad_idx, crm_cld_rad) call pbuf_get_field(pbuf_chunk, crm_qrad_idx, crm_qrad) - if (MMF_microphysics_scheme .eq. 'm2005') then + if (MMF_microphysics_scheme .eq. 'p3') then call pbuf_get_field(pbuf_chunk, crm_nc_rad_idx, crm_nc_rad) call pbuf_get_field(pbuf_chunk, crm_ni_rad_idx, crm_ni_rad) - call pbuf_get_field(pbuf_chunk, crm_qs_rad_idx, crm_qs_rad) - call pbuf_get_field(pbuf_chunk, crm_ns_rad_idx, crm_ns_rad) end if do i = 1,ncol @@ -1404,11 +1449,9 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, crm_qc_rad (i,:,:,:) = crm_rad%qc (icrm,:,:,:) crm_qi_rad (i,:,:,:) = crm_rad%qi (icrm,:,:,:) crm_cld_rad (i,:,:,:) = crm_rad%cld (icrm,:,:,:) - if (MMF_microphysics_scheme .eq. 'm2005') then + if (MMF_microphysics_scheme .eq. 'p3') then crm_nc_rad(i,:,:,:) = crm_rad%nc (icrm,:,:,:) crm_ni_rad(i,:,:,:) = crm_rad%ni (icrm,:,:,:) - crm_qs_rad(i,:,:,:) = crm_rad%qs (icrm,:,:,:) - crm_ns_rad(i,:,:,:) = crm_rad%ns (icrm,:,:,:) end if end do @@ -1419,21 +1462,22 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_V'), crm_v) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_W'), crm_w) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_T'), crm_t) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QT'), crm_qt) + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QV'), crm_qv) if (MMF_microphysics_scheme .eq. 'sam1mom') then call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QP'), crm_qp) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QN'), crm_qn) - else + end if + if (MMF_microphysics_scheme .eq. 'p3') then call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NC'), crm_nc) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QR'), crm_qr) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NR'), crm_nr) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QI'), crm_qi) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NI'), crm_ni) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QS'), crm_qs) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NS'), crm_ns) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QG'), crm_qg) - call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_NG'), crm_ng) call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QC'), crm_qc) + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_QM'), crm_qm) + call pbuf_get_field(pbuf_chunk, pbuf_get_index('CRM_BM'), crm_bm) + call pbuf_get_field(pbuf_chunk, crm_t_prev_idx, crm_t_prev) + call pbuf_get_field(pbuf_chunk, crm_q_prev_idx, crm_q_prev) end if do i = 1,ncol @@ -1442,21 +1486,22 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, crm_v (i,:,:,:) = crm_state%v_wind (icrm,:,:,:) crm_w (i,:,:,:) = crm_state%w_wind (icrm,:,:,:) crm_t (i,:,:,:) = crm_state%temperature(icrm,:,:,:) - crm_qt(i,:,:,:) = crm_state%qt (icrm,:,:,:) + crm_qv(i,:,:,:) = crm_state%qv (icrm,:,:,:) if (MMF_microphysics_scheme .eq. 'sam1mom') then crm_qp(i,:,:,:) = crm_state%qp(icrm,:,:,:) crm_qn(i,:,:,:) = crm_state%qn(icrm,:,:,:) - else if (MMF_microphysics_scheme .eq. 'm2005') then - crm_qc(i,:,:,:) = crm_state%qc(icrm,:,:,:) - crm_qi(i,:,:,:) = crm_state%qi(icrm,:,:,:) - crm_nc(i,:,:,:) = crm_state%nc(icrm,:,:,:) - crm_qr(i,:,:,:) = crm_state%qr(icrm,:,:,:) - crm_nr(i,:,:,:) = crm_state%nr(icrm,:,:,:) - crm_ni(i,:,:,:) = crm_state%ni(icrm,:,:,:) - crm_qs(i,:,:,:) = crm_state%qs(icrm,:,:,:) - crm_ns(i,:,:,:) = crm_state%ns(icrm,:,:,:) - crm_qg(i,:,:,:) = crm_state%qg(icrm,:,:,:) - crm_ng(i,:,:,:) = crm_state%ng(icrm,:,:,:) + end if + if (MMF_microphysics_scheme .eq. 'p3') then + crm_qc(i,:,:,:) = crm_state%qc (icrm,:,:,:) + crm_qi(i,:,:,:) = crm_state%qi (icrm,:,:,:) + crm_qr(i,:,:,:) = crm_state%qr (icrm,:,:,:) + crm_nc(i,:,:,:) = crm_state%nc (icrm,:,:,:) + crm_ni(i,:,:,:) = crm_state%ni (icrm,:,:,:) + crm_nr(i,:,:,:) = crm_state%nr (icrm,:,:,:) + crm_qm(i,:,:,:) = crm_state%qm (icrm,:,:,:) + crm_bm(i,:,:,:) = crm_state%bm (icrm,:,:,:) + crm_t_prev(i,:,:,:) = crm_state%t_prev(icrm,:,:,:) + crm_q_prev(i,:,:,:) = crm_state%q_prev(icrm,:,:,:) end if end do @@ -1474,13 +1519,11 @@ subroutine crm_physics_tend(ztodt, state, tend, ptend, pbuf2d, cam_in, cam_out, dp_g = state(c)%pdel(i,k)/gravit do jj = 1,crm_ny do ii = 1,crm_nx - if(MMF_microphysics_scheme .eq. 'm2005') then - qli_hydro_after(c,i) = qli_hydro_after(c,i)+(crm_state%qr(icrm,ii,jj,m)+ & - crm_state%qs(icrm,ii,jj,m)+ & - crm_state%qg(icrm,ii,jj,m)) * dp_g - qi_hydro_after(c,i) = qi_hydro_after(c,i)+(crm_state%qs(icrm,ii,jj,m)+ & - crm_state%qg(icrm,ii,jj,m)) * dp_g - else if(MMF_microphysics_scheme .eq. 'sam1mom') then + if(MMF_microphysics_scheme .eq. 'p3') then + qli_hydro_after(c,i) = qli_hydro_after(c,i)+(crm_state%qr(icrm,ii,jj,m)) * dp_g + ! TODO: how do we handle qi_hydro_after for P3? + end if + if(MMF_microphysics_scheme .eq. 'sam1mom') then sfactor = max(0._r8,min(1._r8,(crm_state%temperature(icrm,ii,jj,m)-268.16)*1./(283.16-268.16))) qli_hydro_after(c,i) = qli_hydro_after(c,i)+crm_state%qp(icrm,ii,jj,m) * dp_g qi_hydro_after(c,i) = qi_hydro_after(c,i)+crm_state%qp(icrm,ii,jj,m) * (1-sfactor) * dp_g @@ -1584,225 +1627,4 @@ end subroutine crm_surface_flux_bypass_tend !================================================================================================== !================================================================================================== -subroutine m2005_effradius(ql, nl,qi,ni,qs, ns, cld, pres, tk, & - effl, effi, effl_fn, deffi, & - lamcrad, pgamrad, des) - !------------------------------------------------------------------------------------------------ - ! This subroutine is used to calculate droplet and ice crystal effective radius, which will be - ! used in the CAM radiation code. The method to calculate effective radius is taken out of the - ! Morrision two moment scheme from M2005MICRO_GRAUPEL. It is also very similar to the subroutine - ! effradius in the module of cldwat2m in the CAM source codes. - ! Adopted by Minghuai Wang (Minghuai.Wang@pnl.gov). - !------------------------------------------------------------------------------------------------ - ! Calculate effective radius for radiation code - ! If no cloud water, default value is: - ! 10 micron for droplets, - ! 25 micron for cloud ice. - ! Be careful of the unit of effective radius : [micro meter] - !------------------------------------------------------------------------------------------------ - use shr_spfn_mod, only: gamma => shr_spfn_gamma - implicit none - - ! input arguments - real(r8), intent(in) :: ql ! Mean LWC of pixels [ kg/kg ] - real(r8), intent(in) :: nl ! Grid-mean number concentration of cloud liquid droplet [#/kg] - real(r8), intent(in) :: qi ! Mean IWC of pixels [ kg/kg ] - real(r8), intent(in) :: ni ! Grid-mean number concentration of cloud ice droplet [#/kg] - real(r8), intent(in) :: qs ! mean snow water content [kg/kg] - real(r8), intent(in) :: ns ! Mean snow crystal number concnetration [#/kg] - real(r8), intent(in) :: cld ! Physical stratus fraction - real(r8), intent(in) :: pres ! Air pressure [Pa] - real(r8), intent(in) :: tk ! air temperature [K] - - ! output arguments - real(r8), intent(out) :: effl ! Effective radius of cloud liquid droplet [micro-meter] - real(r8), intent(out) :: effi ! Effective radius of cloud ice droplet [micro-meter] - real(r8), intent(out) :: effl_fn ! effl for fixed number concentration of nlic = 1.e8 - real(r8), intent(out) :: deffi ! ice effective diameter for optics (radiation) - real(r8), intent(out) :: pgamrad ! gamma parameter for optics (radiation) - real(r8), intent(out) :: lamcrad ! slope of droplet distribution for optics (radiation) - real(r8), intent(out) :: des ! snow effective diameter for optics (radiation) [micro-meter] - - ! local variables - real(r8) qlic ! In-cloud LWC [kg/m3] - real(r8) qiic ! In-cloud IWC [kg/m3] - real(r8) nlic ! In-cloud liquid number concentration [#/kg] - real(r8) niic ! In-cloud ice number concentration [#/kg] - real(r8) mtime ! Factor to account for droplet activation timescale [no] - real(r8) cldm ! Constrained stratus fraction [no] - real(r8) mincld ! Minimum stratus fraction [no] - - real(r8) lami, laml, lammax, lammin, pgam, lams, lammaxs, lammins - - real(r8) dcs ! autoconversion size threshold [meter] - real(r8) di, ci ! cloud ice mass-diameter relationship - real(r8) ds, cs ! snow crystal mass-diameter relationship - real(r8) qsmall ! - real(r8) rho ! air density [kg/m3] - real(r8) rhow ! liquid water density [kg/m3] - real(r8) rhoi ! ice density [kg/m3] - real(r8) rhos ! snow density [kg/m3] - real(r8) res ! effective snow diameters - real(r8) pi ! - real(r8) tempnc ! - - !------------------------------------------------------------------------------------------------ - ! Main computation - !------------------------------------------------------------------------------------------------ - - pi = 3.1415926535897932384626434 - ! qsmall = 1.0e-18 ! in the CAM source code (cldwat2m) - qsmall = 1.0e-14 ! in the SAM source code (module_mp_graupel) - ! rhow = 1000. ! in cldwat2m, CAM - rhow = 997. ! in module_mp_graupel, SAM - rhoi = 500. ! in both CAM and SAM - - ! dcs = 70.e-6_r8 ! in cldwat2m, CAM - dcs = 125.e-6_r8 ! in module_mp_graupel, SAM - ci = rhoi * pi/6. - di = 3. - - ! for snow water - rhos = 100. ! in both SAM and CAM5 - cs = rhos*pi/6. - ds = 3. - - - rho = pres / (287.15*tk) ! air density [kg/m3] - - mincld = 0.0001_r8 - cldm = max(cld,mincld) - qlic = min(5.e-3_r8,max(0._r8,ql/cldm)) - qiic = min(5.e-3_r8,max(0._r8,qi/cldm)) - nlic = max(nl,0._r8)/cldm - niic = max(ni,0._r8)/cldm - - !------------------------------------------------------------------------------------------------ - ! Effective diameters of snow crystals - !------------------------------------------------------------------------------------------------ - if(qs.gt.1.0e-7) then - lammaxs=1._r8/10.e-6_r8 - lammins=1._r8/2000.e-6_r8 - lams = (gamma(1._r8+ds)*cs * ns/qs)**(1._r8/ds) - lams = min(lammaxs,max(lams,lammins)) - res = 1.5/lams*1.0e6_r8 - else - res = 500._r8 - end if - - ! - ! from Hugh Morrision: rhos/917 accouts for assumptions about - ! ice density in the Mitchell optics. - ! - - des = res * rhos/917._r8 *2._r8 - - !------------------------------------------------------------------------------------------------ - ! Effective radius of cloud ice droplet - !------------------------------------------------------------------------------------------------ - - if( qiic.ge.qsmall ) then - niic = min(niic,qiic*1.e20_r8) - ! lammax = 1._r8/10.e-6_r8 ! in cldwat2m, CAM - ! lammin = 1._r8/(2._r8*dcs) ! in cldwat2m, CAM - lammax = 1._r8/1.e-6_r8 ! in module_mp_graupel, SAM - lammin = 1._r8/(2._r8*dcs+100.e-6_r8) ! in module_mp_graupel, SAM - lami = (gamma(1._r8+di)*ci*niic/qiic)**(1._r8/di) - lami = min(lammax,max(lami,lammin)) - effi = 1.5_r8/lami*1.e6_r8 - else - effi = 25._r8 - end if - - !--hm ice effective radius for david mitchell's optics - !--ac morrison indicates that this is effective diameter - !--ac morrison indicates 917 (for the density of pure ice..) - deffi = effi *rhoi/917._r8*2._r8 - - !------------------------------------------------------------------------------------------------ - ! Effective radius of cloud liquid droplet - !------------------------------------------------------------------------------------------------ - - if( qlic.ge.qsmall ) then - ! Matin et al., 1994 (JAS) formula for pgam (the same is used in both CAM and SAM). - ! See also Morrison and Grabowski (2007, JAS, Eq. (2)) - nlic = min(nlic,qlic*1.e20_r8) - - ! set the minimum droplet number as 20/cm3. - ! nlic = max(nlic,20.e6_r8/rho) ! sghan minimum in #/cm3 - tempnc = nlic/rho/1.0e6 ! #/kg --> #/cm3 - ! if (tempnc.gt.100._r8) then - ! write(0, *) 'nc larger than 100 ', tempnc, rho - ! end if - - !!!!!! ????? Should be the in-cloud dropelt number calculated as nlic*rho/1.0e6_r8 ????!!!! +++mhwang - ! pgam = 0.0005714_r8*(nlic/1.e6_r8/rho) + 0.2714_r8 !wrong, confirmed with Hugh Morrison. fixed in the latest SAM. - pgam = 0.0005714_r8*(nlic*rho/1.e6_r8) + 0.2714_r8 - pgam = 1._r8/(pgam**2)-1._r8 - ! pgam = min(15._r8,max(pgam,2._r8)) ! in cldwat2m, CAM - pgam = min(10._r8,max(pgam,2._r8)) ! in module_mp_graupel, SAM - ! if(pgam.gt.2.01_r8 .and.pgam.lt.9.99_r8) then - ! write(0, *) 'pgam', pgam - ! end if - laml = (pi/6._r8*rhow*nlic*gamma(pgam+4._r8)/(qlic*gamma(pgam+1._r8)))**(1._r8/3._r8) - lammin = (pgam+1._r8)/50.e-6_r8 ! in cldwat2m, CAM - lammax = (pgam+1._r8)/2.e-6_r8 ! in cldwat2m, CAM ! cldwat2m should be used, - ! if lammax is too large, this will lead to crash in - ! src/physics/rrtmg/cloud_rad_props.F90 because - ! klambda-1 can be zero in gam_liquid_lw and gam_liquid_sw - ! and g_lambda(kmu,klambda-1) will not be defined. - ! lammin = (pgam+1._r8)/60.e-6_r8 ! in module_mp_graupel, SAM - ! lammax = (pgam+1._r8)/1.e-6_r8 ! in module_mp_graupel, SAM - - laml = min(max(laml,lammin),lammax) - ! effl = gamma(qcvar+1._r8/3._r8)/(gamma(qcvar)*qcvar**(1._r8/3._r8))* & - ! gamma(pgam+4._r8)/gamma(pgam+3._r8)/laml/2._r8*1.e6_r8 ! in cldwat2m, CAM - effl = gamma(pgam+4._r8)/gamma(pgam+3._r8)/laml/2._r8*1.e6_r8 ! in module_mp_graupel, SAM - lamcrad = laml - pgamrad = pgam - else - ! we chose 10. over 25, since 10 is a more reasonable value for liquid droplet. +++mhwang - effl = 10._r8 ! in cldwat2m, CAM - ! effl = 25._r8 ! in module_mp_graupel, SAM - lamcrad = 0.0_r8 - pgamrad = 0.0_r8 - end if - - !------------------------------------------------------------------------------------------------ - ! Recalculate effective radius for constant number, in order to separate first and second - ! indirect effects. Assume constant number of 10^8 kg-1 - !------------------------------------------------------------------------------------------------ - - nlic = 1.e8 - if( qlic.ge.qsmall ) then - ! Matin et al., 1994 (JAS) formula for pgam (the same is used in both CAM and SAM). - ! See also Morrison and Grabowski (2007, JAS, Eq. (2)) - nlic = min(nlic,qlic*1.e20_r8) - pgam = 0.0005714_r8*(nlic/1.e6_r8/rho) + 0.2714_r8 - pgam = 1._r8/(pgam**2)-1._r8 - ! pgam = min(15._r8,max(pgam,2._r8)) ! in cldwat2m, CAM - pgam = min(10._r8,max(pgam,2._r8)) ! in module_mp_graupel, SAM - laml = (pi/6._r8*rhow*nlic*gamma(pgam+4._r8)/(qlic*gamma(pgam+1._r8)))**(1._r8/3._r8) - ! lammin = (pgam+1._r8)/50.e-6_r8 ! in cldwat2m, CAM - ! lammax = (pgam+1._r8)/2.e-6_r8 ! in cldwat2m, CAM - lammin = (pgam+1._r8)/60.e-6_r8 ! in module_mp_graupel, SAM - lammax = (pgam+1._r8)/1.e-6_r8 ! in module_mp_graupel, SAM - - laml = min(max(laml,lammin),lammax) - ! effl_fn = gamma(qcvar+1._r8/3._r8)/(gamma(qcvar)*qcvar**(1._r8/3._r8))* & - ! gamma(pgam+4._r8)/gamma(pgam+3._r8)/laml/2._r8*1.e6_r8 ! in cldwat2m, CAM - effl_fn = gamma(pgam+4._r8)/gamma(pgam+3._r8)/laml/2._r8*1.e6_r8 ! in module_mp_graupel, SAM - else - ! we chose 10. over 25, since 10 is a more reasonable value for liquid droplet. +++mhwang - effl_fn = 10._r8 ! in cldwat2m, CAM - ! effl_fn = 25._r8 ! in module_mp_graupel, SAM - end if - !------------------------------------------------------------------------------------------------ - !------------------------------------------------------------------------------------------------ - return -end subroutine m2005_effradius - -!================================================================================================== -!================================================================================================== - end module crm_physics diff --git a/components/eam/src/physics/crm/crm_rad_module.F90 b/components/eam/src/physics/crm/crm_rad_module.F90 index f9d6e4162bc4..fad4d346472e 100644 --- a/components/eam/src/physics/crm/crm_rad_module.F90 +++ b/components/eam/src/physics/crm/crm_rad_module.F90 @@ -26,7 +26,7 @@ module crm_rad_module real(crm_rknd), allocatable :: qi (:,:,:,:) ! rad cloud ice real(crm_rknd), allocatable :: cld(:,:,:,:) ! rad cloud fraction - ! Only relevant when using 2-moment microphysics + ! Only relevant when using 2-moment microphysics (ex. P3) real(crm_rknd), allocatable :: nc(:,:,:,:) ! rad cloud droplet number (#/kg) real(crm_rknd), allocatable :: ni(:,:,:,:) ! rad cloud ice crystal number (#/kg) real(crm_rknd), allocatable :: qs(:,:,:,:) ! rad cloud snow (kg/kg) @@ -48,13 +48,21 @@ subroutine crm_rad_initialize(rad, ncrms, crm_nx_rad, crm_ny_rad, crm_nz, MMF_mi if (.not. allocated(rad%qc)) allocate(rad%qc (ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) if (.not. allocated(rad%qi)) allocate(rad%qi (ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) if (.not. allocated(rad%cld)) allocate(rad%cld (ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) - + if (.not. allocated(rad%nc)) allocate(rad%nc (ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) + if (.not. allocated(rad%ni)) allocate(rad%ni (ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) + if (.not. allocated(rad%qs)) allocate(rad%qs (ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) + if (.not. allocated(rad%ns)) allocate(rad%ns (ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) + call prefetch(rad%qrad) call prefetch(rad%temperature) call prefetch(rad%qv) call prefetch(rad%qc) call prefetch(rad%qi) call prefetch(rad%cld) + call prefetch(rad%nc) + call prefetch(rad%ni) + call prefetch(rad%qs) + call prefetch(rad%ns) rad%qrad = 0 rad%temperature = 0 @@ -62,23 +70,10 @@ subroutine crm_rad_initialize(rad, ncrms, crm_nx_rad, crm_ny_rad, crm_nz, MMF_mi rad%qc = 0 rad%qi = 0 rad%cld = 0 - - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then - if (.not. allocated(rad%nc)) allocate(rad%nc(ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) - if (.not. allocated(rad%ni)) allocate(rad%ni(ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) - if (.not. allocated(rad%qs)) allocate(rad%qs(ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) - if (.not. allocated(rad%ns)) allocate(rad%ns(ncrms, crm_nx_rad, crm_ny_rad, crm_nz)) - - call prefetch(rad%nc) - call prefetch(rad%ni) - call prefetch(rad%qs) - call prefetch(rad%ns) - - rad%nc = 0 - rad%ni = 0 - rad%qs = 0 - rad%ns = 0 - end if + rad%nc = 0 + rad%ni = 0 + rad%qs = 0 + rad%ns = 0 end subroutine crm_rad_initialize !------------------------------------------------------------------------------------------------ @@ -92,13 +87,10 @@ subroutine crm_rad_finalize(rad, MMF_microphysics_scheme) if (allocated(rad%qc)) deallocate(rad%qc) if (allocated(rad%qi)) deallocate(rad%qi) if (allocated(rad%cld)) deallocate(rad%cld) - - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then - if (allocated(rad%nc)) deallocate(rad%nc) - if (allocated(rad%ni)) deallocate(rad%ni) - if (allocated(rad%qs)) deallocate(rad%qs) - if (allocated(rad%ns)) deallocate(rad%ns) - end if + if (allocated(rad%nc)) deallocate(rad%nc) + if (allocated(rad%ni)) deallocate(rad%ni) + if (allocated(rad%qs)) deallocate(rad%qs) + if (allocated(rad%ns)) deallocate(rad%ns) end subroutine crm_rad_finalize !------------------------------------------------------------------------------------------------ diff --git a/components/eam/src/physics/crm/crm_state_module.F90 b/components/eam/src/physics/crm/crm_state_module.F90 index a18b15a65420..82db8d682466 100644 --- a/components/eam/src/physics/crm/crm_state_module.F90 +++ b/components/eam/src/physics/crm/crm_state_module.F90 @@ -24,24 +24,28 @@ module crm_state_module real(crm_rknd), allocatable :: u_wind(:,:,:,:) ! CRM u-wind component real(crm_rknd), allocatable :: v_wind(:,:,:,:) ! CRM v-wind component real(crm_rknd), allocatable :: w_wind(:,:,:,:) ! CRM w-wind component - real(crm_rknd), allocatable :: temperature(:,:,:,:) ! CRM temperuture - real(crm_rknd), allocatable :: qt(:,:,:,:) ! CRM total water + real(crm_rknd), allocatable :: temperature(:,:,:,:) ! CRM temperature + real(crm_rknd), allocatable :: qv(:,:,:,:) ! CRM water vapor - ! 2-moment microphsics variables + ! 1-moment microphsics variables + real(crm_rknd), allocatable :: qp(:,:,:,:) ! mass mixing ratio of precipitating condensate + real(crm_rknd), allocatable :: qn(:,:,:,:) ! mass mixing ratio of cloud condensate + + ! 2-moment microphysics variables (p3) real(crm_rknd), allocatable :: qc(:,:,:,:) ! mass mixing ratio of cloud water real(crm_rknd), allocatable :: nc(:,:,:,:) ! number concentration of cloud water real(crm_rknd), allocatable :: qr(:,:,:,:) ! mass mixing ratio of rain real(crm_rknd), allocatable :: nr(:,:,:,:) ! number concentration of rain real(crm_rknd), allocatable :: qi(:,:,:,:) ! mass mixing ratio of cloud ice real(crm_rknd), allocatable :: ni(:,:,:,:) ! number concentration of cloud ice - real(crm_rknd), allocatable :: qs(:,:,:,:) ! mass mixing ratio of snow - real(crm_rknd), allocatable :: ns(:,:,:,:) ! number concentration of snow - real(crm_rknd), allocatable :: qg(:,:,:,:) ! mass mixing ratio of graupel - real(crm_rknd), allocatable :: ng(:,:,:,:) ! number concentration of graupel - - ! 1-moment microphsics variables - real(crm_rknd), allocatable :: qp(:,:,:,:) ! mass mixing ratio of precipitating condensate - real(crm_rknd), allocatable :: qn(:,:,:,:) ! mass mixing ratio of cloud condensate + + ! p3 microphysics variables not included above + real(crm_rknd), allocatable :: qm(:,:,:,:) ! averaged riming density + real(crm_rknd), allocatable :: bm(:,:,:,:) ! averaged riming volume + + ! "previous" state variables needed for P3 + real(crm_rknd), allocatable :: t_prev(:,:,:,:) ! previous CRM time step temperature + real(crm_rknd), allocatable :: q_prev(:,:,:,:) ! previous CRM time step water vapor end type crm_state_type !------------------------------------------------------------------------------------------------ @@ -59,41 +63,42 @@ subroutine crm_state_initialize(state,ncrms,crm_nx,crm_ny,crm_nz,MMF_microphysic if (.not. allocated(state%v_wind)) allocate(state%v_wind(ncrms,crm_nx,crm_ny,crm_nz)) if (.not. allocated(state%w_wind)) allocate(state%w_wind(ncrms,crm_nx,crm_ny,crm_nz)) if (.not. allocated(state%temperature)) allocate(state%temperature(ncrms,crm_nx,crm_ny,crm_nz)) - if (.not. allocated(state%qt)) allocate(state%qt(ncrms,crm_nx,crm_ny,crm_nz)) + if (.not. allocated(state%qv)) allocate(state%qv(ncrms,crm_nx,crm_ny,crm_nz)) call prefetch(state%u_wind) call prefetch(state%v_wind) call prefetch(state%w_wind) call prefetch(state%temperature) - call prefetch(state%qt) + call prefetch(state%qv) - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then + if (trim(MMF_microphysics_scheme) .eq. 'sam1mom') then + if (.not. allocated(state%qp)) allocate(state%qp(ncrms,crm_nx,crm_ny,crm_nz)) + if (.not. allocated(state%qn)) allocate(state%qn(ncrms,crm_nx,crm_ny,crm_nz)) + call prefetch(state%qp) + call prefetch(state%qn) + end if + + if (trim(MMF_microphysics_scheme).eq.'p3') then if (.not. allocated(state%qc)) allocate(state%qc(ncrms,crm_nx,crm_ny,crm_nz)) if (.not. allocated(state%qi)) allocate(state%qi(ncrms,crm_nx,crm_ny,crm_nz)) if (.not. allocated(state%qr)) allocate(state%qr(ncrms,crm_nx,crm_ny,crm_nz)) - if (.not. allocated(state%qs)) allocate(state%qs(ncrms,crm_nx,crm_ny,crm_nz)) - if (.not. allocated(state%qg)) allocate(state%qg(ncrms,crm_nx,crm_ny,crm_nz)) if (.not. allocated(state%nc)) allocate(state%nc(ncrms,crm_nx,crm_ny,crm_nz)) if (.not. allocated(state%ni)) allocate(state%ni(ncrms,crm_nx,crm_ny,crm_nz)) if (.not. allocated(state%nr)) allocate(state%nr(ncrms,crm_nx,crm_ny,crm_nz)) - if (.not. allocated(state%ns)) allocate(state%ns(ncrms,crm_nx,crm_ny,crm_nz)) - if (.not. allocated(state%ng)) allocate(state%ng(ncrms,crm_nx,crm_ny,crm_nz)) + if (.not. allocated(state%qm)) allocate(state%qm(ncrms,crm_nx,crm_ny,crm_nz)) + if (.not. allocated(state%bm)) allocate(state%bm(ncrms,crm_nx,crm_ny,crm_nz)) + if (.not. allocated(state%t_prev)) allocate(state%t_prev(ncrms,crm_nx,crm_ny,crm_nz)) + if (.not. allocated(state%q_prev)) allocate(state%q_prev(ncrms,crm_nx,crm_ny,crm_nz)) call prefetch(state%qc) call prefetch(state%qi) call prefetch(state%qr) - call prefetch(state%qs) - call prefetch(state%qg) call prefetch(state%nc) call prefetch(state%ni) call prefetch(state%nr) - call prefetch(state%ns) - call prefetch(state%ng) - end if - if (trim(MMF_microphysics_scheme) .eq. 'sam1mom') then - if (.not. allocated(state%qp)) allocate(state%qp(ncrms,crm_nx,crm_ny,crm_nz)) - if (.not. allocated(state%qn)) allocate(state%qn(ncrms,crm_nx,crm_ny,crm_nz)) - call prefetch(state%qp) - call prefetch(state%qn) + call prefetch(state%qm) + call prefetch(state%bm) + call prefetch(state%t_prev) + call prefetch(state%q_prev) end if end subroutine crm_state_initialize @@ -102,29 +107,26 @@ subroutine crm_state_finalize(state, MMF_microphysics_scheme) type(crm_state_type), intent(inout) :: state character(len=*), intent(in) :: MMF_microphysics_scheme ! CRM microphysics scheme - ! Nullify pointers if (allocated(state%u_wind)) deallocate(state%u_wind) if (allocated(state%v_wind)) deallocate(state%v_wind) if (allocated(state%w_wind)) deallocate(state%w_wind) if (allocated(state%temperature)) deallocate(state%temperature) - if (allocated(state%qt)) deallocate(state%qt) - - if (trim(MMF_microphysics_scheme) .eq. 'm2005') then - if (allocated(state%qc)) deallocate(state%qc) - if (allocated(state%qi)) deallocate(state%qi) - if (allocated(state%qr)) deallocate(state%qr) - if (allocated(state%qs)) deallocate(state%qs) - if (allocated(state%qg)) deallocate(state%qg) - if (allocated(state%nc)) deallocate(state%nc) - if (allocated(state%ni)) deallocate(state%ni) - if (allocated(state%nr)) deallocate(state%nr) - if (allocated(state%ns)) deallocate(state%ns) - if (allocated(state%ng)) deallocate(state%ng) - end if - if (trim(MMF_microphysics_scheme) .eq. 'sam1mom') then - if (allocated(state%qp)) deallocate(state%qp) - if (allocated(state%qn)) deallocate(state%qn) - end if + if (allocated(state%qv)) deallocate(state%qv) + if (allocated(state%qp)) deallocate(state%qp) + if (allocated(state%qn)) deallocate(state%qn) + + if (allocated(state%qc)) deallocate(state%qc) + if (allocated(state%qi)) deallocate(state%qi) + if (allocated(state%qr)) deallocate(state%qr) + if (allocated(state%nc)) deallocate(state%nc) + if (allocated(state%ni)) deallocate(state%ni) + if (allocated(state%nr)) deallocate(state%nr) + + if (allocated(state%qm)) deallocate(state%qm) + if (allocated(state%bm)) deallocate(state%bm) + if (allocated(state%t_prev)) deallocate(state%t_prev) + if (allocated(state%q_prev)) deallocate(state%q_prev) + end subroutine crm_state_finalize end module crm_state_module diff --git a/components/eam/src/physics/crm/rrtmg/radiation.F90 b/components/eam/src/physics/crm/rrtmg/radiation.F90 deleted file mode 100644 index fd98e497f2d0..000000000000 --- a/components/eam/src/physics/crm/rrtmg/radiation.F90 +++ /dev/null @@ -1,2536 +0,0 @@ -module radiation - -!--------------------------------------------------------------------------------- -! Purpose: -! -! CAM interface to RRTMG -! -! Revision history: -! May 2004, D. B. Coleman, Initial version of interface module. -! July 2004, B. Eaton, Use interfaces from new shortwave, longwave, and ozone modules. -! Feb 2005, B. Eaton, Add namelist variables and control of when calcs are done. -! May 2008, Mike Iacono Initial version for RRTMG -! June, 2009, Minghuai Wang, MMF cam -! The MMF treatment is added to the subroutine of radiation_tend. -! These modifications are based on the spcam3.5, which was developled -! by Marat Khairoutdinov. The spcam3.5 only have one radiation package -! (camrt). See comments in radiation_tend for the details. -!July, 2009, Minghuai Wang: -! For the Morrison's two momenent microphysics in SAM, droplet and ice crystal effective radius -! used in the radiation code are calcualted at each CRM column by calling m2005_effradius -!October, 2009, Minghuai Wang: -! CRM-scale aerosol water is used to calculate aerosol optical depth -! -! Nov 2010, J. Kay Add COSP simulator calls -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8 -use spmd_utils, only: masterproc, iam, npes -use ppgrid, only: pcols, pver, pverp, begchunk, endchunk -use physics_types, only: physics_state, physics_ptend -use physconst, only: cpair, cappa -use time_manager, only: get_nstep, is_first_restart_step -use cam_abortutils, only: endrun -use error_messages, only: handle_err -use cam_control_mod, only: lambm0, obliqr, mvelpp, eccen -use scamMod, only: scm_crm_mode, single_column,have_cld,cldobs,& - have_clwp,clwpobs,have_tg,tground -use perf_mod, only: t_startf, t_stopf -use cam_logfile, only: iulog - -use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, rad_cnst_get_info -use radconstants, only: rrtmg_sw_cloudsim_band, rrtmg_lw_cloudsim_band, nswbands, nlwbands - -implicit none -private -save - -public :: & - radiation_register, &! registers radiation physics buffer fields - radiation_nextsw_cday, &! calendar day of next radiation calculation - radiation_do, &! query which radiation calcs are done this timestep - radiation_init, &! calls radini - radiation_final, &! deallocate - radiation_readnl, &! read radiation namelist - radiation_tend ! moved from radctl.F90 - -integer,public, allocatable :: cosp_cnt(:) ! counter for cosp -integer,public :: cosp_cnt_init = 0 !initial value for cosp counter - -integer, public, parameter :: kiss_seed_num = 4 -integer, public, allocatable :: rad_randn_seedrst(:,:,:), tot_chnk_till_this_prc(:) !total number of chunks till this processor - -! Private module data -integer :: qrs_idx = 0 -integer :: qrl_idx = 0 -integer :: su_idx = 0 -integer :: sd_idx = 0 -integer :: lu_idx = 0 -integer :: ld_idx = 0 -integer :: cldfsnow_idx = 0 -integer :: cld_idx = 0 -integer :: concld_idx = 0 -integer :: rel_idx = 0 -integer :: rei_idx = 0 -integer :: dei_idx = 0 - -! Default values for namelist variables - -! Frequency of shortwave and longwave calculations in time steps (positive) or -! in hours (negative). We wrap this in an ifdef for now, because we want the -! default to be to run every time step if we are running SP, but keep the -! default of every hour if not running SP. However, the radiation namelist is -! read before the other physics namelists are read, so we cannot know if we are -! running SP before these are set unless we change the order of how things are -! read. A better option would be to set these defaults in the compset definition -! probably. - -integer :: iradsw = -1 ! freq. of shortwave radiation calc in time steps (positive) - ! or hours (negative). -integer :: iradlw = -1 ! frequency of longwave rad. calc. in time steps (positive) - ! or hours (negative). - -integer :: irad_always = 0 ! Specifies length of time in timesteps (positive) - ! or hours (negative) SW/LW radiation will be - ! run continuously from the start of an - ! initial or restart run -logical :: spectralflux = .false. ! calculate fluxes (up and down) per band. - -logical :: use_rad_dt_cosz = .false. ! if true, uses the radiation dt for all cosz calculations !BSINGH - Added for solar insolation calc. -character(len=16) :: microp_scheme ! microphysics scheme - -character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ','_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) - -logical :: dohirs = .false. ! diagnostic brightness temperatures at the top of the - ! atmosphere for 7 TOVS/HIRS channels (2,4,6,8,10,11,12) and 4 TOVS/MSU - ! channels (1,2,3,4). -integer :: ihirsfq = 1 ! frequency (timesteps) of brightness temperature calcs - -integer, allocatable :: clm_rand_seed(:,:,:) - -real(r8) :: dt_avg=0.0_r8 ! time step to use for the shr_orb_cosz calculation, if use_rad_dt_cosz set to true !BSINGH - Added for solar insolation calc. - -logical :: pergro_mods = .false. ! for activating pergro mods -integer :: firstblock, lastblock ! global block indices - -!=============================================================================== -contains -!=============================================================================== - -subroutine radiation_readnl(nlfile, dtime_in) -!------------------------------------------------------------------------------- -! Purpose: Read radiation_nl namelist group. -!------------------------------------------------------------------------------- - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_logical, & - mpi_character, masterproc - use time_manager, only: get_step_size - - ! File containing namelist input - character(len=*), intent(in) :: nlfile - integer, intent(in), optional :: dtime_in - - ! Local variables - integer :: unitn, ierr - integer :: dtime ! timestep size - character(len=*), parameter :: subroutine_name = 'radiation_readnl' - - ! Variables defined in namelist - namelist /radiation_nl/ iradsw, iradlw, irad_always, & - use_rad_dt_cosz, spectralflux - - ! Read the namelist, only if called from master process - ! TODO: better documentation and cleaner logic here? - if (masterproc) then - unitn = getunit() - open(unitn, file=trim(nlfile), status='old') - call find_group_name(unitn, 'radiation_nl', status=ierr) - if (ierr == 0) then - read(unitn, radiation_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subroutine_name // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - ! Broadcast namelist variables - call mpibcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr) - call mpibcast(iradlw, 1, mpi_integer, mstrid, mpicom, ierr) - call mpibcast(irad_always, 1, mpi_integer, mstrid, mpicom, ierr) - call mpibcast(use_rad_dt_cosz, 1, mpi_logical, mstrid, mpicom, ierr) - call mpibcast(spectralflux, 1, mpi_logical, mstrid, mpicom, ierr) -#endif - - ! Convert iradsw, iradlw and irad_always from hours to timesteps if necessary - if (present(dtime_in)) then - dtime = dtime_in - else - dtime = get_step_size() - end if - if (iradsw < 0) iradsw = nint((-iradsw *3600._r8)/dtime) - if (iradlw < 0) iradlw = nint((-iradlw *3600._r8)/dtime) - if (irad_always < 0) irad_always = nint((-irad_always*3600._r8)/dtime) - - ! Print runtime options to log. - if (masterproc) then - call radiation_printopts() - end if - -end subroutine radiation_readnl - - - subroutine radiation_register -!----------------------------------------------------------------------- -! -! Register radiation fields in the physics buffer -! -!----------------------------------------------------------------------- - - use physics_buffer, only: pbuf_add_field, dtype_r8 - - call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate - call pbuf_add_field('QRL' , 'global',dtype_r8,(/pcols,pver/), qrl_idx) ! longwave radiative heating rate - - ! If the namelist has been configured for preserving the spectral fluxes, then create - ! physics buffer variables to store the results. - if (spectralflux) then - call pbuf_add_field('SU' , 'global',dtype_r8,(/pcols,pverp,nswbands/), su_idx) ! shortwave upward flux (per band) - call pbuf_add_field('SD' , 'global',dtype_r8,(/pcols,pverp,nswbands/), sd_idx) ! shortwave downward flux (per band) - call pbuf_add_field('LU' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), lu_idx) ! longwave upward flux (per band) - call pbuf_add_field('LD' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), ld_idx) ! longwave downward flux (per band) - end if - - end subroutine radiation_register - -!================================================================================================ -subroutine radiation_defaultopts(iradsw_out, iradlw_out, irad_always_out, spectralflux_out, use_rad_dt_cosz_out) -!----------------------------------------------------------------------- -! Purpose: Return default runtime options -!----------------------------------------------------------------------- - - integer, intent(out), optional :: iradsw_out - integer, intent(out), optional :: iradlw_out - integer, intent(out), optional :: irad_always_out - logical, intent(out), optional :: spectralflux_out - logical, intent(out), optional :: use_rad_dt_cosz_out - !----------------------------------------------------------------------- - - if ( present(iradsw_out) ) iradsw_out = iradsw - if ( present(iradlw_out) ) iradlw_out = iradlw - if ( present(irad_always_out) ) irad_always_out = irad_always - if ( present(spectralflux_out) ) spectralflux_out = spectralflux - if ( present(use_rad_dt_cosz_out) ) use_rad_dt_cosz_out = use_rad_dt_cosz -end subroutine radiation_defaultopts - -!================================================================================================ - - -subroutine radiation_setopts(dtime, nhtfrq, iradsw_in, iradlw_in, & - irad_always_in, spectralflux_in, use_rad_dt_cosz_in) -!----------------------------------------------------------------------- -! Purpose: Set runtime options -! *** NOTE *** This routine needs information about dtime (init by dycore) -! and nhtfrq (init by history) to do its checking. Being called -! from runtime_opts provides these values possibly before they -! have been set in the modules responsible for them. -!----------------------------------------------------------------------- - - integer, intent(in) :: dtime ! timestep size (s) - integer, intent(in) :: nhtfrq ! output frequency of primary history file - integer, intent(in), optional :: iradsw_in - integer, intent(in), optional :: iradlw_in - integer, intent(in), optional :: irad_always_in - logical, intent(in), optional :: spectralflux_in - logical, intent(in), optional :: use_rad_dt_cosz_in - - ! Local - integer :: ntspdy ! no. timesteps per day - integer :: nhtfrq1 ! local copy of input arg nhtfrq -!----------------------------------------------------------------------- - - if ( present(iradsw_in) ) iradsw = iradsw_in - if ( present(iradlw_in) ) iradlw = iradlw_in - if ( present(irad_always_in) ) irad_always = irad_always_in - if ( present(spectralflux_in) ) spectralflux = spectralflux_in - if ( present(use_rad_dt_cosz_in) ) use_rad_dt_cosz = use_rad_dt_cosz_in - - ! Convert iradsw, iradlw and irad_always from hours to timesteps if necessary - if (iradsw < 0) iradsw = nint((-iradsw *3600._r8)/dtime) - if (iradlw < 0) iradlw = nint((-iradlw *3600._r8)/dtime) - if (irad_always < 0) irad_always = nint((-irad_always*3600._r8)/dtime) - -end subroutine radiation_setopts - -!=============================================================================== - -subroutine radiation_get(iradsw_out, iradlw_out, irad_always_out, spectralflux_out) -!----------------------------------------------------------------------- -! Purpose: Provide access to private module data. (This should be eliminated.) -!----------------------------------------------------------------------- - - integer, intent(out), optional :: iradsw_out - integer, intent(out), optional :: iradlw_out - integer, intent(out), optional :: irad_always_out - logical, intent(out), optional :: spectralflux_out - !----------------------------------------------------------------------- - - if ( present(iradsw_out) ) iradsw_out = iradsw - if ( present(iradlw_out) ) iradlw_out = iradlw - if ( present(irad_always_out) ) irad_always_out = irad_always - if ( present(spectralflux_out) ) spectralflux_out = spectralflux_out - -end subroutine radiation_get - -!================================================================================================ - -subroutine radiation_printopts -!----------------------------------------------------------------------- -! Purpose: Print runtime options to log. -!----------------------------------------------------------------------- - - - if(irad_always /= 0) write(iulog,10) irad_always - write(iulog,20) iradsw,iradlw -10 format(' Execute SW/LW radiation continuously for the first ',i5, ' timestep(s) of this run') -20 format(' Frequency of Shortwave Radiation calc. (IRADSW) ',i5/, & - ' Frequency of Longwave Radiation calc. (IRADLW) ',i5) - -end subroutine radiation_printopts - -!================================================================================================ - -function radiation_do(op, timestep) -!----------------------------------------------------------------------- -! Purpose: Returns true if the specified operation is done this timestep. -!----------------------------------------------------------------------- - - character(len=*), intent(in) :: op ! name of operation - integer, intent(in), optional:: timestep - logical :: radiation_do ! return value - - ! Local variables - integer :: nstep ! current timestep number - !----------------------------------------------------------------------- - - if (present(timestep)) then - nstep = timestep - else - nstep = get_nstep() - end if - - select case (op) - case ('sw') ! do a shortwave heating calc this timestep? - if (iradsw==0) then - radiation_do = .false. - else - radiation_do = nstep == 0 .or. iradsw == 1 & - .or. (mod(nstep-1,iradsw) == 0 .and. nstep /= 1) & - .or. nstep <= irad_always - end if - case ('lw') ! do a longwave heating calc this timestep? - if (iradlw==0) then - radiation_do = .false. - else - radiation_do = nstep == 0 .or. iradlw == 1 & - .or. (mod(nstep-1,iradlw) == 0 .and. nstep /= 1) & - .or. nstep <= irad_always - end if - case default - call endrun('radiation_do: unknown operation:'//op) - end select -end function radiation_do - -!================================================================================================ - -real(r8) function radiation_nextsw_cday() - -!----------------------------------------------------------------------- -! Purpose: Returns calendar day of next sw radiation calculation -!----------------------------------------------------------------------- - - use time_manager, only: get_curr_calday, get_nstep, get_step_size - - ! Local variables - integer :: nstep ! timestep counter - logical :: dosw ! true => do shosrtwave calc - integer :: offset ! offset for calendar day calculation - integer :: dTime ! integer timestep size - real(r8):: calday ! calendar day of - !----------------------------------------------------------------------- - - radiation_nextsw_cday = -1._r8 - dosw = .false. - nstep = get_nstep() - dtime = get_step_size() - offset = 0 - if (iradsw/=0) then - do while (.not. dosw) - nstep = nstep + 1 - offset = offset + dtime - if (radiation_do('sw', nstep)) then - radiation_nextsw_cday = get_curr_calday(offset=offset) - dosw = .true. - end if - end do - end if - -end function radiation_nextsw_cday - -!================================================================================================ - - subroutine radiation_init(phys_state) -!----------------------------------------------------------------------- -! -! Initialize the radiation parameterization, add fields to the history buffer -! -!----------------------------------------------------------------------- - use physics_buffer, only: pbuf_get_index - use phys_grid, only: npchunks, get_ncols_p, chunks, knuhcs, ngcols, dyn_to_latlon_gcol_map - use cam_history, only: addfld, horiz_only, add_default - use constituents, only: cnst_get_ind - use physconst, only: gravit, stebol, & - pstd, mwdry, mwco2, mwo3 - use phys_control, only: phys_getopts - use cospsimulator_intr, only: docosp, cospsimulator_intr_init - use radsw, only: radsw_init - use radlw, only: radlw_init - use hirsbt, only: hirsbt_init - use hirsbtpar, only: hirsname, msuname - - use radiation_data, only: init_rad_data - use modal_aer_opt, only: modal_aer_opt_init - use rrtmg_state, only: rrtmg_state_init - use time_manager, only: get_step_size - use dyn_grid, only: get_block_bounds_d -#ifdef SPMD - use mpishorthand, only: mpi_integer, mpicom, mpi_comm_world -#endif - use crmdims, only: crm_nx, crm_ny, crm_nz, crm_nx_rad, crm_ny_rad - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - - integer :: icall, nmodes - logical :: active_calls(0:N_DIAG) - integer :: nstep ! current timestep number - logical :: history_amwg ! output the variables used by the AMWG diag package - logical :: history_vdiag ! output the variables used by the AMWG variability diag package - logical :: history_budget ! output tendencies and state variables for CAM4 - ! temperature, water vapor, cloud ice and cloud - ! liquid budgets. - integer :: history_budget_histfile_num ! output history file number for budget fields - integer :: err - integer :: dtime ! time step - - logical :: use_MMF ! MMF flag - character(len=16) :: MMF_microphysics_scheme ! MMF microphysics scheme - - !variables for pergro_mods - character (len=250) :: errstr - integer, allocatable, dimension(:,:,:) :: clm_id_mstr - integer, allocatable, dimension(:,:) :: clm_id - integer :: id, lchnk, ncol, ilchnk, astat, iseed, ipes, ipes_tmp - integer :: igcol, chunkid, icol, iown, tot_cols, ierr, max_chnks_in_blk - !----------------------------------------------------------------------- - - call rrtmg_state_init() - - call init_rad_data() ! initialize output fields for offline driver - - call phys_getopts( use_MMF_out = use_MMF ) - call phys_getopts( MMF_microphysics_scheme_out = MMF_microphysics_scheme ) - call phys_getopts( microp_scheme_out = microp_scheme ) - - call radsw_init() - call radlw_init() - - ! Set the radiation timestep for cosz calculations if requested using the adjusted iradsw value from radiation - if (use_rad_dt_cosz) then - dtime = get_step_size() - dt_avg = iradsw*dtime - end if - - call phys_getopts(history_amwg_out = history_amwg, & - history_vdiag_out = history_vdiag, & - history_budget_out = history_budget, & - history_budget_histfile_num_out = history_budget_histfile_num, & - pergro_mods_out = pergro_mods) - - ! Determine whether modal aerosols are affecting the climate, and if so - ! then initialize the modal aerosol optics module - call rad_cnst_get_info(0, nmodes=nmodes) - if (nmodes > 0) call modal_aer_opt_init() - - call hirsbt_init() - - ! "irad_always" is number of time steps to execute radiation continuously from start of - ! initial OR restart run - - nstep = get_nstep() - if ( irad_always > 0) then - nstep = get_nstep() - irad_always = irad_always + nstep - end if - - - if (docosp) call cospsimulator_intr_init - - - allocate(cosp_cnt(begchunk:endchunk)) - - !Modification needed by pergro_mods for generating random numbers - if (pergro_mods) then - max_chnks_in_blk = maxval(npchunks(:)) !maximum of the number for chunks in each procs - allocate(clm_rand_seed(pcols,kiss_seed_num,max_chnks_in_blk), stat=astat) - if( astat /= 0 ) then - write(iulog,*) 'radiation.F90(rrtmg)-radiation_init: failed to allocate clm_rand_seed; error = ',astat - call endrun - end if - - allocate(tot_chnk_till_this_prc(0:npes-1), stat=astat ) - if( astat /= 0 ) then - write(errstr,*) 'radiation.F90(rrtmg)-radiation_init: failed to allocate tot_chnk_till_this_prc variable; error = ',astat - call endrun (errstr) - end if - - !BSINGH - Build lat lon relationship to chunk and column - !Compute maximum number of chunks each processor have - if(masterproc) then - tot_chnk_till_this_prc(0:npes-1) = huge(1) - do ipes = 0, npes - 1 - tot_chnk_till_this_prc(ipes) = 0 - do ipes_tmp = 0, ipes-1 - tot_chnk_till_this_prc(ipes) = tot_chnk_till_this_prc(ipes) + npchunks(ipes_tmp) - enddo - enddo - endif -#ifdef SPMD - !BSINGH - Ideally we should use mpi_scatter but we are using this variable - !in "if(masterproc)" below in phys_run1, so broadcast is iused here - call mpibcast(tot_chnk_till_this_prc,npes, mpi_integer, 0, mpicom) -#endif - call get_block_bounds_d(firstblock,lastblock) - - allocate(clm_id(pcols,max_chnks_in_blk), stat=astat) - if( astat /= 0 ) then - write(errstr,*) 'radiation.F90(rrtmg)-radiation_init: failed to allocate clm_id; error = ',astat - call endrun(errstr) - end if - - allocate(clm_id_mstr(pcols,max_chnks_in_blk,npes), stat=astat) - if( astat /= 0 ) then - write(errstr,*) 'radiation.F90(rrtmg)-radiation_init: failed to allocate clm_id_mstr; error = ',astat - call endrun(errstr) - end if - !compute all clm ids on masterproc and then scatter it .... - if(masterproc) then - do igcol = 1, ngcols - if (dyn_to_latlon_gcol_map(igcol) .ne. -1) then - chunkid = knuhcs(igcol)%chunkid - icol = knuhcs(igcol)%col - iown = chunks(chunkid)%owner - ilchnk = (chunks(chunkid)%lcid - lastblock) - tot_chnk_till_this_prc(iown) - clm_id_mstr(icol,ilchnk,iown+1) = igcol - endif - enddo - endif - -#ifdef SPMD - !Scatter - tot_cols = pcols*max_chnks_in_blk - call MPI_Scatter( clm_id_mstr, tot_cols, mpi_integer, & - clm_id, tot_cols, mpi_integer, 0, & - mpicom,ierr) -#else - !BSINGH - Haven't tested it..... - call endrun('radiation.F90(rrtmg)-radiation_init: non-mpi compiles are not tested yet for pergro test...') -#endif - endif - - if (is_first_restart_step()) then - cosp_cnt(begchunk:endchunk)=cosp_cnt_init - if (pergro_mods) then - !-------------------------------------- - !Read seeds from restart file - !-------------------------------------- - !For restart runs, rad_randn_seedrst array will already be allocated in the restart_physics.F90 - - do ilchnk = 1, max_chnks_in_blk - lchnk = begchunk + (ilchnk -1) - ncol = phys_state(lchnk)%ncol - do iseed = 1, kiss_seed_num - do icol = 1, ncol - clm_rand_seed(icol,iseed,ilchnk) = rad_randn_seedrst(icol,iseed,lchnk) - enddo - enddo - enddo - endif - else - cosp_cnt(begchunk:endchunk)=0 - if (pergro_mods) then - !--------------------------------------- - !create seeds based off of column ids - !--------------------------------------- - !allocate array rad_randn_seedrst for initial run for maintaining exact restarts - !For restart runs, it will already be allocated in the restart_physics.F90 - allocate(rad_randn_seedrst(pcols,kiss_seed_num,begchunk:endchunk), stat=astat) - if( astat /= 0 ) then - write(iulog,*) 'radiation.F90(rrtmg)-radiation_init: failed to allocate rad_randn_seedrst; error = ',astat - call endrun - end if - do ilchnk = 1, max_chnks_in_blk - lchnk = begchunk + (ilchnk -1) - ncol = phys_state(lchnk)%ncol - do iseed = 1, kiss_seed_num - do icol = 1, ncol - id = clm_id(icol,ilchnk) - clm_rand_seed(icol,iseed,ilchnk) = id + (iseed -1) - enddo - enddo - enddo - endif - end if - - - ! Shortwave radiation - call addfld('TOT_CLD_VISTAU', (/ 'lev' /), 'A', '1', 'Total gbx cloud extinction visible sw optical depth', & - sampling_seq='rad_lwsw', flag_xyfill=.true.) - call addfld('TOT_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Total in-cloud extinction visible sw optical depth', & - sampling_seq='rad_lwsw', flag_xyfill=.true.) - call addfld('LIQ_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Liquid in-cloud extinction visible sw optical depth', & - sampling_seq='rad_lwsw', flag_xyfill=.true.) - call addfld('ICE_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Ice in-cloud extinction visible sw optical depth', & - sampling_seq='rad_lwsw', flag_xyfill=.true.) - - - - call add_default('TOT_CLD_VISTAU', 1, ' ') - call add_default('TOT_ICLD_VISTAU', 1, ' ') - - ! get list of active radiation calls - call rad_cnst_get_call_list(active_calls) - - do icall = 0, N_DIAG - - if (active_calls(icall)) then - call addfld('SOLIN'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar insolation', sampling_seq='rad_lwsw') - call addfld('SOLL'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared direct to surface',& - sampling_seq='rad_lwsw') - call addfld('SOLS'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible direct to surface', & - sampling_seq='rad_lwsw') - call addfld('SOLLD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared diffuse to surface', & - sampling_seq='rad_lwsw') - call addfld('SOLSD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible diffuse to surface', & - sampling_seq='rad_lwsw') - call addfld('QRS'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Solar heating rate', sampling_seq='rad_lwsw') - call addfld('QRSC'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Clearsky solar heating rate', & - sampling_seq='rad_lwsw') - call addfld('FSNS'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FSNT'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of model', & - sampling_seq='rad_lwsw') - call addfld('FSNTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld('FSUTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Upwelling solar flux at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld('FSNTOAC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld('FSUTOAC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky upwelling solar flux at top of atmosphere', & - sampling_seq='rad_lwsw') - call addfld('FSN200'//diag(icall), horiz_only, 'A', 'W/m2', 'Net shortwave flux at 200 mb', & - sampling_seq='rad_lwsw') - call addfld('FSN200C'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net shortwave flux at 200 mb', & - sampling_seq='rad_lwsw') - call addfld('FSNTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of model', & - sampling_seq='rad_lwsw') - call addfld('FSNSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FSDSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky downwelling solar flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FSDS'//diag(icall), horiz_only, 'A', 'W/m2', 'Downwelling solar flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FUS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave upward flux') - call addfld('FDS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave downward flux') - call addfld('FUSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky upward flux') - call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky downward flux') - call addfld('FSNIRTOA'//diag(icall), horiz_only, 'A','W/m2',& - 'Net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') - call addfld('FSNRTOAC'//diag(icall), horiz_only, 'A','W/m2', & - 'Clearsky net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw') - call addfld('FSNRTOAS'//diag(icall), horiz_only, 'A','W/m2', & - 'Net near-infrared flux (>= 0.7 microns) at top of atmosphere', sampling_seq='rad_lwsw') - call addfld ('SWCF'//diag(icall), horiz_only, 'A', 'W/m2', 'Shortwave cloud forcing', sampling_seq='rad_lwsw') - - if (history_amwg) then - call add_default('SOLIN'//diag(icall), 1, ' ') - call add_default('QRS'//diag(icall), 1, ' ') - call add_default('FSNS'//diag(icall), 1, ' ') - call add_default('FSNT'//diag(icall), 1, ' ') - call add_default('FSNTOA'//diag(icall), 1, ' ') - call add_default('FSUTOA'//diag(icall), 1, ' ') - call add_default('FSNTOAC'//diag(icall), 1, ' ') - call add_default('FSUTOAC'//diag(icall), 1, ' ') - call add_default('FSNTC'//diag(icall), 1, ' ') - call add_default('FSNSC'//diag(icall), 1, ' ') - call add_default('FSDSC'//diag(icall), 1, ' ') - call add_default('FSDS'//diag(icall), 1, ' ') - call add_default('SWCF'//diag(icall), 1, ' ') - endif - - end if - end do - - - if (single_column .and. scm_crm_mode) then - call add_default ('FUS ', 1, ' ') - call add_default ('FUSC ', 1, ' ') - call add_default ('FDS ', 1, ' ') - call add_default ('FDSC ', 1, ' ') - endif - - - ! Longwave radiation - do icall = 0, N_DIAG - if (active_calls(icall)) then - call addfld('QRL'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Longwave heating rate', sampling_seq='rad_lwsw') - call addfld('QRLC'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Clearsky longwave heating rate', & - sampling_seq='rad_lwsw') - call addfld('FLDS'//diag(icall), horiz_only, 'A', 'W/m2', 'Downwelling longwave flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FLDSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky Downwelling longwave flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FLNS'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FLNT'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at top of model', & - sampling_seq='rad_lwsw') - call addfld('FLUT'//diag(icall), horiz_only, 'A', 'W/m2', 'Upwelling longwave flux at top of model', & - sampling_seq='rad_lwsw') - call addfld('FLUTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky upwelling longwave flux at top of model', & - sampling_seq='rad_lwsw') - call addfld('FLNTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net longwave flux at top of model', & - sampling_seq='rad_lwsw') - call addfld('LWCF'//diag(icall), horiz_only, 'A', 'W/m2', 'Longwave cloud forcing', sampling_seq='rad_lwsw') - call addfld('FLN200'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at 200 mb', & - sampling_seq='rad_lwsw') - call addfld('FLN200C'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net longwave flux at 200 mb', & - sampling_seq='rad_lwsw') - call addfld('FLNSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net longwave flux at surface', & - sampling_seq='rad_lwsw') - call addfld('FUL'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave upward flux') - call addfld('FDL'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave downward flux') - call addfld('FULC'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave clear-sky upward flux') - call addfld('FDLC'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave clear-sky downward flux') - - if (history_amwg) then - call add_default('QRL' //diag(icall), 1, ' ') - call add_default('FLNS'//diag(icall), 1, ' ') - call add_default('FLDS'//diag(icall), 1, ' ') - call add_default('FLNT'//diag(icall), 1, ' ') - call add_default('FLUT'//diag(icall), 1, ' ') - call add_default('FLUTC'//diag(icall), 1, ' ') - call add_default('FLNTC'//diag(icall), 1, ' ') - call add_default('FLNSC'//diag(icall), 1, ' ') - call add_default('LWCF'//diag(icall), 1, ' ') - endif - - end if ! active_calls(icall) - end do ! icall = 0,N_DIAG - - ! Add cloud-scale radiative quantities - if (use_MMF) then - call addfld ('CRM_QRAD', (/'crm_nx_rad','crm_ny_rad','crm_nz '/), 'A', 'K/s', 'Radiative heating tendency') - call addfld ('CRM_QRS ', (/'crm_nx_rad','crm_ny_rad','crm_nz '/), 'I', 'K/s', 'CRM Shortwave radiative heating rate') - call addfld ('CRM_QRSC', (/'crm_nx_rad','crm_ny_rad','crm_nz '/), 'I', 'K/s', 'CRM Clearsky shortwave radiative heating rate') - call addfld ('CRM_QRL ', (/'crm_nx_rad','crm_ny_rad','crm_nz '/), 'I', 'K/s', 'CRM Longwave radiative heating rate' ) - call addfld ('CRM_QRLC', (/'crm_nx_rad','crm_ny_rad','crm_nz '/), 'I', 'K/s', 'CRM Longwave radiative heating rate' ) - call addfld ('CRM_CLD_RAD', (/'crm_nx_rad','crm_ny_rad','crm_nz '/), 'I', 'fraction', 'CRM cloud fraction' ) - call addfld ('CRM_TAU ', (/'crm_nx_rad','crm_ny_rad','crm_nz'/), 'A', '1', 'CRM cloud optical depth' ) - call addfld ('CRM_EMS ', (/'crm_nx_rad','crm_ny_rad','crm_nz'/), 'A', '1', 'CRM cloud longwave emissivity' ) - end if - - call addfld('EMIS', (/ 'lev' /), 'A', '1', 'Cloud longwave emissivity') - - if (single_column.and.scm_crm_mode) then - call add_default ('FUL ', 1, ' ') - call add_default ('FULC ', 1, ' ') - call add_default ('FDL ', 1, ' ') - call add_default ('FDLC ', 1, ' ') - endif - - ! HIRS/MSU diagnostic brightness temperatures - if (dohirs) then - call addfld (hirsname(1),horiz_only,'A','K','HIRS CH2 infra-red brightness temperature') - call addfld (hirsname(2),horiz_only,'A','K','HIRS CH4 infra-red brightness temperature') - call addfld (hirsname(3),horiz_only,'A','K','HIRS CH6 infra-red brightness temperature') - call addfld (hirsname(4),horiz_only,'A','K','HIRS CH8 infra-red brightness temperature') - call addfld (hirsname(5),horiz_only,'A','K','HIRS CH10 infra-red brightness temperature') - call addfld (hirsname(6),horiz_only,'A','K','HIRS CH11 infra-red brightness temperature') - call addfld (hirsname(7),horiz_only,'A','K','HIRS CH12 infra-red brightness temperature') - call addfld (msuname(1),horiz_only,'A','K','MSU CH1 microwave brightness temperature') - call addfld (msuname(2),horiz_only,'A','K','MSU CH2 microwave brightness temperature') - call addfld (msuname(3),horiz_only,'A','K','MSU CH3 microwave brightness temperature') - call addfld (msuname(4),horiz_only,'A','K','MSU CH4 microwave brightness temperature') - - call add_default (hirsname(1), 1, ' ') - call add_default (hirsname(2), 1, ' ') - call add_default (hirsname(3), 1, ' ') - call add_default (hirsname(4), 1, ' ') - call add_default (hirsname(5), 1, ' ') - call add_default (hirsname(6), 1, ' ') - call add_default (hirsname(7), 1, ' ') - call add_default (msuname(1), 1, ' ') - call add_default (msuname(2), 1, ' ') - call add_default (msuname(3), 1, ' ') - call add_default (msuname(4), 1, ' ') - end if - - ! Heating rate needed for d(theta)/dt computation - call addfld ('HR',(/ 'lev' /), 'A','K/s','Heating rate needed for d(theta)/dt computation') - - if ( history_budget .and. history_budget_histfile_num > 1 ) then - call add_default ('QRL ', history_budget_histfile_num, ' ') - call add_default ('QRS ', history_budget_histfile_num, ' ') - end if - - if (history_vdiag) then - call add_default('FLUT', 2, ' ') - call add_default('FLUT', 3, ' ') - end if - - ! (Almost) net radiative flux at surface, does not have lwup. - ! call addfld ('SRFRAD ','W/m2 ',1, 'A','Net radiative flux at surface',phys_decomp) - ! call add_default ('SRFRAD ', 1, ' ') - - ! call phys_getopts(history_budget_out = history_budget, history_budget_histfile_num_out = history_budget_histfile_num) - - if ( history_budget .and. history_budget_histfile_num > 1 ) then - call add_default ('QRL ', history_budget_histfile_num, ' ') - call add_default ('QRS ', history_budget_histfile_num, ' ') - end if - - if (history_vdiag) then - call add_default('FLUT', 2, ' ') - call add_default('FLUT', 3, ' ') - end if - - cldfsnow_idx = pbuf_get_index('CLDFSNOW',errcode=err) - cld_idx = pbuf_get_index('CLD') - concld_idx = pbuf_get_index('CONCLD') - rel_idx = pbuf_get_index('REL') - rei_idx = pbuf_get_index('REI') - dei_idx = pbuf_get_index('DEI') - - if (use_MMF .and. MMF_microphysics_scheme .eq. 'sam1mom') then - cldfsnow_idx = 0 - end if - - if (cldfsnow_idx > 0) then - call addfld ('CLDFSNOW',(/ 'lev' /),'I','1','CLDFSNOW',flag_xyfill=.true.) - call addfld('SNOW_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Snow in-cloud extinction visible sw optical depth', & - sampling_seq='rad_lwsw', flag_xyfill=.true.) - endif - - call addfld('COSZRS', horiz_only, 'I', '1', & - 'Cosine of solar zenith angle', & - sampling_seq='rad_lwsw', flag_xyfill=.true.) - - end subroutine radiation_init - -!=============================================================================== - - subroutine radiation_final() - ! Do any needed clean-up and deallocation before model exit. Empty for now - ! but required for consistency with RRTMGPXX interface. - end subroutine radiation_final - -!=============================================================================== - - subroutine radiation_tend( state, ptend,pbuf, & - cam_out, cam_in, & - landfrac,icefrac,snowh, & - fsns, fsnt, flns, flnt, & - fsds, net_flx, is_cmip6_volc) - - !----------------------------------------------------------------------- - ! - ! Purpose: - ! Driver for radiation computation. - ! - ! Method: - ! Radiation uses cgs units, so conversions must be done from - ! model fields to radiation fields. - ! - ! Revision history: - ! May 2004 D.B. Coleman Merge of code from radctl.F90 and parts of tphysbc.F90. - ! 2004-08-09 B. Eaton Add pointer variables for constituents. - ! 2004-08-24 B. Eaton Access O3 and GHG constituents from chem_get_cnst. - ! 2004-08-30 B. Eaton Replace chem_get_cnst by rad_constituent_get. - ! 2007-11-05 M. Iacono Install rrtmg_lw and sw as radiation model. - ! 2007-12-27 M. Iacono Modify to use CAM cloud optical properties with rrtmg. - ! 2009-06 Minghuai Wang, add treatments for MMF CAM - ! These modifications are based on the spcam3.5, which was developled - ! by Marat Khairoutdinov (mkhairoutdin@ms.cc.sunysb.edu). The spcam3.5 - ! only have one radiation package (camrt). - ! Short wave and long wave radiation codes are called for every column - ! of the CRM domain. CRM fields are named as *_crm, and domain-averaged fields are - ! named as *_m. The domain-averaged fields and CRM fields are outputed at the end - ! of the CRM domain loop (last_column=.true.). - ! Several variables in state are updated with those from CRM output - ! (liquid water, qc_rad; ice water, qi_rad; water vapor, qv_rad; - ! and temperature, t_rad). Several variables in pbuf are also updated - ! with those in CRM domain (cld, cicewp, cliqwp, csnowp, cldfsnow). - ! At the end of the radiation calculation, state and those in pbuf are - ! restored to the old values. - ! Finally, a new cloud simulator are called, which takes account of cloud fileds - ! from the CRM domain. - ! 2009-07-13, Minghuai Wang: MMF CAM - ! When Morrison's two momenent microphysics is used in SAM, droplet and ice crystal effective radius - ! used in this radiation code are calcualted at each CRM column by calling m2005_effradius - ! 2009-10-21, Minghuai Wang: MMF CAM - ! CRM-scale aerosol water is used to calculate aerosol optical depth - !---------------------------------------------------------------------------------------------- - - - use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx, pbuf_get_index, pbuf_set_field - - use phys_grid, only: get_rlat_all_p, get_rlon_all_p - use physics_types, only: physics_state, physics_ptend - use cospsimulator_intr, only: docosp, cospsimulator_intr_run,cosp_nradsteps - use time_manager, only: get_curr_calday - use camsrfexch, only: cam_out_t, cam_in_t - use cam_history, only: outfld - use cam_history_support, only: fillvalue - use parrrtm, only: nbndlw - use parrrsw, only: nbndsw - use hirsbt, only: hirsrtm - use hirsbtpar, only: pnb_hirs, pnf_msu, hirsname, msuname - use radheat, only: radheat_tend - use ppgrid - use pspect - use physconst, only: cpair, stebol - use radconstants, only: nlwbands,idx_sw_diag - use radsw, only: rad_rrtmg_sw - use radlw, only: rad_rrtmg_lw - use rad_constituents, only: rad_cnst_get_gas, rad_cnst_out, & - liqcldoptics, icecldoptics - use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw - use interpolate_data, only: vertinterp - use cloud_rad_props, only: get_ice_optics_sw, get_liquid_optics_sw, liquid_cloud_get_rad_props_lw, & - ice_cloud_get_rad_props_lw, cloud_rad_props_get_lw, snow_cloud_get_rad_props_lw, get_snow_optics_sw - use slingo, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw - use ebert_curry, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw - use rad_solar_var, only: get_variability - use radiation_data, only: output_rad_data - use rrtmg_state, only: rrtmg_state_create, rrtmg_state_update, rrtmg_state_destroy, rrtmg_state_t, num_rrtmg_levs - use crmdims, only: crm_nx, crm_ny, crm_nz, crm_nx_rad, crm_ny_rad - use physconst, only: gravit - use constituents, only: cnst_get_ind - use radconstants, only: idx_sw_diag - - use crm_physics, only: m2005_effradius - -#ifdef MODAL_AERO - use modal_aero_data, only: ntot_amode -#endif - use phys_control, only: phys_getopts - use orbit, only: zenith - use output_aerocom_aie, only: do_aerocom_ind3 - use pkg_cldoptics, only: cldefr ! for sam1mom microphysics - - - ! Arguments - logical, intent(in) :: is_cmip6_volc ! true if cmip6 style volcanic file is read otherwise false - real(r8), intent(in) :: landfrac(pcols) ! land fraction - real(r8), intent(in) :: icefrac(pcols) ! land fraction - real(r8), intent(in) :: snowh(pcols) ! Snow depth (liquid water equivalent) -#ifdef MODAL_AERO -#endif - real(r8), intent(inout) :: fsns(pcols) ! Surface solar absorbed flux - real(r8), intent(inout) :: fsnt(pcols) ! Net column abs solar flux at model top - real(r8), intent(inout) :: flns(pcols) ! Srf longwave cooling (up-down) flux - real(r8), intent(inout) :: flnt(pcols) ! Net outgoing lw flux at model top - real(r8), intent(inout) :: fsds(pcols) ! Surface solar down flux - real(r8), intent(inout) :: net_flx(pcols) - - type(physics_state), intent(inout), target :: state - - type(physics_ptend), intent(out) :: ptend - - type(physics_buffer_desc), pointer :: pbuf(:) - type(cam_out_t), intent(inout) :: cam_out - type(cam_in_t), intent(in) :: cam_in - - ! Local variables - - type(physics_state), target :: statein_copy - logical :: dosw, dolw - integer nstep ! current timestep number - real(r8) britemp(pcols,pnf_msu) ! Microwave brightness temperature - real(r8) tb_ir(pcols,pnb_hirs) ! Infrared brightness temperature - real(r8) ts(pcols) ! surface temperature - real(r8) pintmb(pcols,pverp) ! Model interface pressures (hPa) - real(r8) oro(pcols) ! Land surface flag, sea=0, land=1 - - real(r8),pointer :: nc_rad(:,:,:,:) ! rad cloud water droplet number (#/kg) - real(r8),pointer :: ni_rad(:,:,:,:) ! rad cloud ice crystal nubmer (#/kg) - real(r8),pointer :: qs_rad(:,:,:,:) ! rad cloud snow crystal mass (kg/kg) - real(r8),pointer :: ns_rad(:,:,:,:) ! rad cloud snow crystal number (#/kg) - - real(r8),pointer :: t_rad (:,:,:,:) ! rad temperuture - real(r8),pointer :: qv_rad(:,:,:,:) ! rad vapor - real(r8),pointer :: qc_rad(:,:,:,:) ! rad cloud water - real(r8),pointer :: qi_rad(:,:,:,:) ! rad cloud ice - real(r8),pointer :: cld_rad(:,:,:,:) ! 3D cloud fraction averaged over CRM integration - real(r8),pointer :: crm_qrad(:,:,:,:) ! rad heating - - integer nmxrgn(pcols) ! Number of maximally overlapped regions - real(r8) pmxrgn(pcols,pverp) ! Maximum values of pressure for each - ! maximally overlapped region. - ! 0->pmxrgn(i,1) is range of pressure for - ! 1st region,pmxrgn(i,1)->pmxrgn(i,2) for - ! 2nd region, etc - real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity - real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables - - ! combined cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: c_cld_tau (nbndsw,pcols,pver) ! cloud extinction optical depth - real(r8) :: c_cld_tau_w (nbndsw,pcols,pver) ! cloud single scattering albedo * tau - real(r8) :: c_cld_tau_w_g(nbndsw,pcols,pver) ! cloud assymetry parameter * w * tau - real(r8) :: c_cld_tau_w_f(nbndsw,pcols,pver) ! cloud forward scattered fraction * w * tau - real(r8) :: c_cld_lw_abs (nbndlw,pcols,pver) ! cloud absorption optics depth (LW) - - ! cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: cld_tau (nbndsw,pcols,pver) ! cloud extinction optical depth - real(r8) :: cld_tau_w (nbndsw,pcols,pver) ! cloud single scattering albedo * tau - real(r8) :: cld_tau_w_g(nbndsw,pcols,pver) ! cloud assymetry parameter * w * tau - real(r8) :: cld_tau_w_f(nbndsw,pcols,pver) ! cloud forward scattered fraction * w * tau - real(r8) :: cld_lw_abs (nbndlw,pcols,pver) ! cloud absorption optics depth (LW) - - ! cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: ice_tau (nbndsw,pcols,pver) ! ice extinction optical depth - real(r8) :: ice_tau_w (nbndsw,pcols,pver) ! ice single scattering albedo * tau - real(r8) :: ice_tau_w_g(nbndsw,pcols,pver) ! ice assymetry parameter * tau * w - real(r8) :: ice_tau_w_f(nbndsw,pcols,pver) ! ice forward scattered fraction * tau * w - real(r8) :: ice_lw_abs (nbndlw,pcols,pver) ! ice absorption optics depth (LW) - - ! cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: snow_tau (nbndsw,pcols,pver) ! snow extinction optical depth - real(r8) :: snow_tau_w (nbndsw,pcols,pver) ! snow single scattering albedo * tau - real(r8) :: snow_tau_w_g(nbndsw,pcols,pver) ! snow assymetry parameter * tau * w - real(r8) :: snow_tau_w_f(nbndsw,pcols,pver) ! snow forward scattered fraction * tau * w - real(r8) :: snow_lw_abs (nbndlw,pcols,pver) ! snow absorption optics depth (LW) - real(r8) :: gb_snow_tau (pcols,pver) ! grid-box mean snow_tau for COSP only - real(r8) :: gb_snow_lw (pcols,pver) ! grid-box mean LW snow optical depth for COSP only - - ! cloud radiative parameters are "in cloud" not "in cell" - real(r8) :: liq_tau (nbndsw,pcols,pver) ! liquid extinction optical depth - real(r8) :: liq_tau_w (nbndsw,pcols,pver) ! liquid single scattering albedo * tau - real(r8) :: liq_tau_w_g(nbndsw,pcols,pver) ! liquid assymetry parameter * tau * w - real(r8) :: liq_tau_w_f(nbndsw,pcols,pver) ! liquid forward scattered fraction * tau * w - real(r8) :: liq_lw_abs (nbndlw,pcols,pver) ! liquid absorption optics depth (LW) - - real(r8) :: tot_cld_vistau(pcols,pver) ! tot gbx cloud visible sw optical depth for output on history files - real(r8) :: tot_icld_vistau(pcols,pver) ! tot in-cloud visible sw optical depth for output on history files - real(r8) :: liq_icld_vistau(pcols,pver) ! liq in-cloud visible sw optical depth for output on history files - real(r8) :: ice_icld_vistau(pcols,pver) ! ice in-cloud visible sw optical depth for output on history files - real(r8) :: snow_icld_vistau(pcols,pver) ! snow in-cloud visible sw optical depth for output on history files - - integer itim, ifld - real(r8), pointer, dimension(:,:) :: rel ! liquid effective drop radius (microns) - real(r8), pointer, dimension(:,:) :: rei ! ice effective drop size (microns) - real(r8), pointer, dimension(:,:) :: cld ! cloud fraction - real(r8), pointer, dimension(:,:) :: cldfsnow ! cloud fraction of just "snow clouds- whatever they are" - real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction (snow plus regular) - real(r8), pointer, dimension(:,:) :: concld ! convective cloud fraction - real(r8), pointer, dimension(:,:) :: qrs ! shortwave radiative heating rate - real(r8), pointer, dimension(:,:) :: qrl ! longwave radiative heating rate - real(r8) :: qrsc(pcols,pver) ! clearsky shortwave radiative heating rate - real(r8) :: qrlc(pcols,pver) ! clearsky longwave radiative heating rate - - integer lchnk, ncol, lw - real(r8) :: calday ! current calendar day - real(r8) :: clat(pcols) ! current latitudes(radians) - real(r8) :: clon(pcols) ! current longitudes(radians) - real(r8) :: coszrs(pcols) ! Cosine solar zenith angle - logical :: conserve_energy = .true. ! flag to carry (QRS,QRL)*dp across time steps - - ! Local variables from radctl - integer :: i, k, iseed, ilchnk ! index - integer :: istat - integer :: clm_seed (pcols,kiss_seed_num) - real(r8) solin(pcols) ! Solar incident flux - real(r8) fsntoa(pcols) ! Net solar flux at TOA - real(r8) fsutoa(pcols) ! Upwelling solar flux at TOA - real(r8) fsntoac(pcols) ! Clear sky net solar flux at TOA - real(r8) fsutoac(pcols) ! Clear sky upwelling solar flux at TOA - real(r8) fsnirt(pcols) ! Near-IR flux absorbed at toa - real(r8) fsnrtc(pcols) ! Clear sky near-IR flux absorbed at toa - real(r8) fsnirtsq(pcols) ! Near-IR flux absorbed at toa >= 0.7 microns - real(r8) fsntc(pcols) ! Clear sky total column abs solar flux - real(r8) fsnsc(pcols) ! Clear sky surface abs solar flux - real(r8) fsdsc(pcols) ! Clear sky surface downwelling solar flux - real(r8) flut(pcols) ! Upward flux at top of model - real(r8) lwcf(pcols) ! longwave cloud forcing - real(r8) swcf(pcols) ! shortwave cloud forcing - real(r8) flutc(pcols) ! Upward Clear Sky flux at top of model - real(r8) flntc(pcols) ! Clear sky lw flux at model top - real(r8) flnsc(pcols) ! Clear sky lw flux at srf (up-down) - real(r8) fldsc(pcols) ! Clear sky lw flux at srf (down) - real(r8) fln200(pcols) ! net longwave flux interpolated to 200 mb - real(r8) fln200c(pcols) ! net clearsky longwave flux interpolated to 200 mb - real(r8) fns(pcols,pverp) ! net shortwave flux - real(r8) fcns(pcols,pverp) ! net clear-sky shortwave flux - real(r8) fsn200(pcols) ! fns interpolated to 200 mb - real(r8) fsn200c(pcols) ! fcns interpolated to 200 mb - real(r8) fnl(pcols,pverp) ! net longwave flux - real(r8) fcnl(pcols,pverp) ! net clear-sky longwave flux - real(r8) qtot - real(r8) factor_xy - real(r8) cld_save (pcols,pver) - real(r8) fice (pcols,pver) - real(r8) cliqwp_crm (pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) cicewp_crm (pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) rel_crm (pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) rei_crm (pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) cld_tau_crm(pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) emis_crm (pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) qrl_crm (pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) qrs_crm (pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) qrlc_crm (pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) qrsc_crm (pcols, crm_nx_rad, crm_ny_rad, crm_nz) - real(r8) crm_fsnt (pcols, crm_nx_rad, crm_ny_rad) ! net shortwave fluxes at TOA at CRM grids - real(r8) crm_fsntc (pcols, crm_nx_rad, crm_ny_rad) ! net clear-sky shortwave fluxes at TOA at CRM grids - real(r8) crm_fsns (pcols, crm_nx_rad, crm_ny_rad) ! net shortwave fluxes at surface at CRM grids - real(r8) crm_fsnsc (pcols, crm_nx_rad, crm_ny_rad) ! net clear-sky shortwave fluxes at surface at CRM grids - real(r8) crm_flnt (pcols, crm_nx_rad, crm_ny_rad) ! net longwave fluxes at TOA at CRM grids - real(r8) crm_flntc (pcols, crm_nx_rad, crm_ny_rad) ! net clear-sky longwave fluxes at TOA at CRM grids - real(r8) crm_flns (pcols, crm_nx_rad, crm_ny_rad) ! net longwave fluxes at surface at CRM grids - real(r8) crm_flnsc (pcols, crm_nx_rad, crm_ny_rad) ! net clear-sky longwave fluxes at surface at CRM grids - real(r8) crm_aodvisz(pcols, crm_nx_rad, crm_ny_rad, crm_nz) ! layer aerosol optical depth at 550nm at CRM grids - real(r8) crm_aodvis (pcols, crm_nx_rad, crm_ny_rad) ! AOD at 550nm at CRM grids - real(r8) crm_aod400 (pcols, crm_nx_rad, crm_ny_rad) ! AOD at 400nm at CRM grids - real(r8) crm_aod700 (pcols, crm_nx_rad, crm_ny_rad) ! AOD at 700nm at CRM grids - real(r8) aod400 (pcols) ! AOD at 400nm at CRM grids - real(r8) aod700 (pcols) ! AOD at 700nm at CRM grids - - integer :: nct_tot_icld_vistau(pcols,pver) ! the number of CRM columns that has in-cloud visible sw optical depth - integer :: nct_liq_icld_vistau(pcols,pver) ! the number of CRM column that has liq in-cloud visible sw optical depth - integer :: nct_ice_icld_vistau(pcols,pver) ! the number of CRM column that has ice in-cloud visible sw optical depth - integer :: nct_snow_icld_vistau(pcols,pver) ! the number of CRM column that has snow in-cloud visible sw optical depth - - real(r8) solin_m(pcols, 0:N_DIAG) ! Solar incident flux - real(r8) fsntoa_m(pcols, 0:N_DIAG) ! Net solar flux at TOA - real(r8) fsutoa_m(pcols, 0:N_DIAG) ! upwelling solar flux at TOA - real(r8) fsntoac_m(pcols, 0:N_DIAG) ! Clear sky net solar flux at TOA - real(r8) fsnirt_m(pcols, 0:N_DIAG) ! Near-IR flux absorbed at toa - real(r8) fsnrtc_m(pcols, 0:N_DIAG) ! Clear sky near-IR flux absorbed at toa - real(r8) fsnirtsq_m(pcols, 0:N_DIAG) ! Near-IR flux absorbed at toa >= 0.7 microns - real(r8) fsntc_m(pcols, 0:N_DIAG) ! Clear sky total column abs solar flux - real(r8) fsnsc_m(pcols, 0:N_DIAG) ! Clear sky surface abs solar flux - real(r8) fsdsc_m(pcols, 0:N_DIAG) ! Clear sky surface downwelling solar flux - real(r8) flut_m(pcols, 0:N_DIAG) ! Upward flux at top of model - real(r8) flutc_m(pcols, 0:N_DIAG) ! Upward Clear Sky flux at top of model - real(r8) flntc_m(pcols, 0:N_DIAG) ! Clear sky lw flux at model top - real(r8) flnsc_m(pcols, 0:N_DIAG) ! Clear sky lw flux at srf (up-down) - real(r8) fldsc_m(pcols, 0:N_DIAG) ! Clear sky lw flux at srf (down) - real(r8) flwds_m(pcols, 0:N_DIAG) ! Down longwave flux at surface - real(r8) fsns_m(pcols, 0:N_DIAG) ! Surface solar absorbed flux - real(r8) fsnt_m(pcols, 0:N_DIAG) ! Net column abs solar flux at model top - real(r8) flns_m(pcols, 0:N_DIAG) ! Srf longwave cooling (up-down) flux - real(r8) flnt_m(pcols, 0:N_DIAG) ! Net outgoing lw flux at model top - real(r8) fsds_m(pcols, 0:N_DIAG) ! Surface solar down flux - real(r8) fln200_m(pcols, 0:N_DIAG) ! net longwave flux interpolated to 200 mb - real(r8) fln200c_m(pcols, 0:N_DIAG) ! net clearsky longwave flux interpolated to 200 mb - real(r8) fsn200_m(pcols, 0:N_DIAG) ! fns interpolated to 200 mb - real(r8) fsn200c_m(pcols, 0:N_DIAG) ! fcns interpolated to 200 mb - real(r8) sols_m(pcols, 0:N_DIAG) ! Solar downward visible direct to surface - real(r8) soll_m(pcols, 0:N_DIAG) ! Solar downward near infrared direct to surface - real(r8) solsd_m(pcols, 0:N_DIAG) ! Solar downward visible diffuse to surface - real(r8) solld_m(pcols, 0:N_DIAG) ! Solar downward near infrared diffuse to surface - real(r8) qrs_m(pcols,pver, 0:N_DIAG) - real(r8) qrl_m(pcols,pver, 0:N_DIAG) - real(r8) qrsc_m(pcols,pver, 0:N_DIAG) - real(r8) qrlc_m(pcols,pver, 0:N_DIAG) - logical :: first_column - logical :: last_column - integer :: ii,jj,m - - integer :: ixcldliq, ixcldice - integer :: i_iciwp, i_iclwp, i_icswp - real(r8), pointer, dimension(:, :) :: cicewp - real(r8), pointer, dimension(:, :) :: cliqwp - real(r8), pointer, dimension(:, :) :: csnowp - real(r8) :: cicewp_save(pcols, pver) - real(r8) :: cliqwp_save(pcols, pver) - real(r8) :: csnowp_save(pcols, pver) - real(r8) :: cldfsnow_save(pcols, pver) - real(r8) :: rel_save(pcols, pver) - real(r8) :: rei_save(pcols, pver) - real(r8) :: effl ! droplet effective radius [micrometer] - real(r8) :: effi ! ice crystal effective radius [micrometer] - real(r8) :: effl_fn ! effl for fixed number concentration of nlic = 1.e8 - - real(r8) :: deffi ! ice effective diameter for optics (radiation) - real(r8) :: lamc ! slope of droplet distribution for optics (radiation) - real(r8) :: pgam ! gamma parameter for optics (radiation) - real(r8) :: dest ! snow crystal effective diameters for optics (radiation) (micro-meter) - real(r8), pointer, dimension(:, :) :: dei ! ice effective diameter for optics (radiation) - real(r8), pointer, dimension(:, :) :: mu ! gamma parameter for optics (radiation) - real(r8), pointer, dimension(:, :) :: lambdac ! slope of droplet distribution for optics (radiation) - real(r8), pointer, dimension(:, :) :: des ! snow crystal diameter for optics (mirometer, radiation) - real(r8),allocatable :: dei_save(:,:) - real(r8),allocatable :: mu_save(:,:) - real(r8),allocatable :: lambdac_save(:,:) - real(r8),allocatable :: des_save(:,:) - real(r8),allocatable :: dei_crm(:,:,:,:) ! cloud scale ice effective diameter for optics - real(r8),allocatable :: mu_crm(:,:,:,:) ! cloud scale gamma parameter for optics - real(r8),allocatable :: lambdac_crm(:,:,:,:) ! cloud scale slope of droplet distribution for optics - real(r8),allocatable :: des_crm(:,:,:,:) ! cloud scale snow crystal diameter (micro-meter) -#ifdef MODAL_AERO - real(r8), pointer, dimension(:,:,:) :: dgnumwet ! number mode diameter - real(r8), pointer, dimension(:,:,:) :: qaerwat ! aerosol water -#endif - - real(r8) pbr(pcols,pver) ! Model mid-level pressures (dynes/cm2) - real(r8) pnm(pcols,pverp) ! Model interface pressures (dynes/cm2) - real(r8) eccf ! Earth/sun distance factor - real(r8) lwupcgs(pcols) ! Upward longwave flux in cgs units - - real(r8) dy ! Temporary layer pressure thickness - real(r8) tint(pcols,pverp) ! Model interface temperature - real(r8) :: sfac(1:nswbands) ! time varying scaling factors due to Solar Spectral Irrad at 1 A.U. per band - - real(r8), pointer, dimension(:,:) :: o3 ! Ozone mass mixing ratio - real(r8), pointer, dimension(:,:) :: co2 ! co2 mass mixing ratio - real(r8), dimension(pcols) :: co2_col_mean ! co2 column mean mmr - real(r8), pointer, dimension(:,:) :: sp_hum ! specific humidity - - real(r8), pointer, dimension(:,:,:) :: su => NULL() ! shortwave spectral flux up - real(r8), pointer, dimension(:,:,:) :: sd => NULL() ! shortwave spectral flux down - real(r8), pointer, dimension(:,:,:) :: lu => NULL() ! longwave spectral flux up - real(r8), pointer, dimension(:,:,:) :: ld => NULL() ! longwave spectral flux down - - real(r8), allocatable :: su_m(:,:,:,:) ! shortwave spectral flux up - real(r8), allocatable :: sd_m(:,:,:,:) ! shortwave spectral flux down - real(r8), allocatable :: lu_m(:,:,:,:) ! longwave spectral flux up - real(r8), allocatable :: ld_m(:,:,:,:) ! longwave spectral flux down - - ! Aerosol radiative properties - real(r8) :: aer_tau (pcols,0:pver,nbndsw) ! aerosol extinction optical depth - real(r8) :: aer_tau_w (pcols,0:pver,nbndsw) ! aerosol single scattering albedo * tau - real(r8) :: aer_tau_w_g(pcols,0:pver,nbndsw) ! aerosol assymetry parameter * w * tau - real(r8) :: aer_tau_w_f(pcols,0:pver,nbndsw) ! aerosol forward scattered fraction * w * tau - real(r8) :: aer_lw_abs (pcols,pver,nbndlw) ! aerosol absorption optics depth (LW) - - ! Gathered indicies of day and night columns - ! chunk_column_index = IdxDay(daylight_column_index) - integer :: Nday ! Number of daylight columns - integer :: Nnite ! Number of night columns - integer, dimension(pcols) :: IdxDay ! Indicies of daylight coumns - integer, dimension(pcols) :: IdxNite ! Indicies of night coumns - - integer :: icall ! index through climate/diagnostic radiation calls - integer :: crm_nc_rad_idx, crm_ni_rad_idx, crm_qs_rad_idx, crm_ns_rad_idx - integer :: crm_t_rad_idx, crm_qi_rad_idx, crm_qc_rad_idx, crm_qv_rad_idx, crm_qrad_idx - - logical :: active_calls(0:N_DIAG) - logical :: use_MMF - - type(rrtmg_state_t), pointer :: r_state ! contains the atm concentratiosn in layers needed for RRTMG - -! AeroCOM IND3 output +++mhwang -!MRN: Already defined above -- gives errors with GNU -! real(r8) :: aod400(pcols) ! AOD at 400 nm -! real(r8) :: aod700(pcols) ! AOD at 700 nm - real(r8) :: angstrm(pcols) ! Angstrom coefficient - real(r8) :: aerindex(pcols) ! Aerosol index - integer aod400_idx, aod700_idx, cld_tau_idx - - character(*), parameter :: name = 'radiation_tend' - character(len=16) :: MMF_microphysics_scheme ! MMF_microphysics scheme -!---------------------------------------------------------------------- - - call phys_getopts( use_MMF_out = use_MMF ) - call phys_getopts( MMF_microphysics_scheme_out = MMF_microphysics_scheme) - first_column = .false. - last_column = .false. - - ! In order to populate data structures with CRM state variables, we modify - ! the physics_state object in-place and then restore the input physics_state - ! at the end of the routine. So here we create a copy that we can restore. - if (use_MMF) then - statein_copy = state - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) - endif - - lchnk = state%lchnk - ncol = state%ncol - - if(pergro_mods) then - ilchnk = (lchnk - lastblock) - tot_chnk_till_this_prc(iam) - clm_seed(1:pcols,1:kiss_seed_num) = clm_rand_seed (1:pcols,1:kiss_seed_num,ilchnk) - else - ! For default simulation, clm_seed should never be used, assign it a value which breaks the simulation if used. - clm_seed(1:pcols,1:kiss_seed_num) = huge(1) - endif - - itim = pbuf_old_tim_idx() - - if (cldfsnow_idx > 0) then - call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) - endif - call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) - call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim/), kount=(/pcols,pver,1/) ) - call pbuf_get_field(pbuf, qrs_idx, qrs) - call pbuf_get_field(pbuf, qrl_idx, qrl) - call pbuf_get_field(pbuf, rel_idx, rel) - call pbuf_get_field(pbuf, rei_idx, rei) - call pbuf_get_field(pbuf, dei_idx, dei) - - if (spectralflux) then - call pbuf_get_field(pbuf, su_idx, su) - call pbuf_get_field(pbuf, sd_idx, sd) - call pbuf_get_field(pbuf, lu_idx, lu) - call pbuf_get_field(pbuf, ld_idx, ld) - if(use_MMF) then - allocate(su_m(pcols,pverp,nswbands,0:N_DIAG)) - allocate(sd_m(pcols,pverp,nswbands,0:N_DIAG)) - allocate(lu_m(pcols,pverp,nswbands,0:N_DIAG)) - allocate(ld_m(pcols,pverp,nswbands,0:N_DIAG)) - end if ! use_MMF - end if - - if (use_MMF) then - if (MMF_microphysics_scheme .eq. 'm2005') then - ! ifld = pbuf_get_index('DEI') - ! call pbuf_get_field(pbuf, ifld, dei) - ifld = pbuf_get_index('MU') - call pbuf_get_field(pbuf, ifld, mu) - ifld = pbuf_get_index('LAMBDAC') - call pbuf_get_field(pbuf, ifld, LAMBDAC) - ifld = pbuf_get_index('DES') - call pbuf_get_field(pbuf, ifld, des) - endif - end if ! use_MMF - - if (do_aerocom_ind3) then - cld_tau_idx = pbuf_get_index('cld_tau') - end if - - ! For CRM, make cloud equal to input observations: - if (single_column.and.scm_crm_mode.and.have_cld) then - do k = 1,pver - cld(:ncol,k)= cldobs(k) - enddo - endif - - if (cldfsnow_idx > 0) then - call outfld('CLDFSNOW',cldfsnow,pcols,lchnk) - endif - - ! Cosine solar zenith angle for current time step - call get_rlat_all_p(lchnk, ncol, clat) - call get_rlon_all_p(lchnk, ncol, clon) - calday = get_curr_calday() - call zenith (calday, clat, clon, coszrs, ncol, dt_avg) - - ! Output cosine solar zenith angle - call outfld('COSZRS', coszrs(1:ncol), ncol, lchnk) - - ! The output_rad_data routine is intended to output all of the data needed - ! to run the radiation code offline. This functionality may or may not be - ! supported, and definitely is NOT for SP simulations. - call output_rad_data( pbuf, state, cam_in, coszrs ) - - ! Gather night/day column indices. - Nday = 0 - Nnite = 0 - do i = 1,ncol - if ( coszrs(i) > 0.0_r8 ) then - Nday = Nday + 1 - IdxDay(Nday) = i - else - Nnite = Nnite + 1 - IdxNite(Nnite) = i - end if - end do ! i - - ! Allocate "save" variables that will be used to restore fields that are - ! modified in-place in pbuf to populate with each crm column one at a time - if (use_MMF) then - allocate(dei_save(pcols, pver)) - allocate(dei_crm(pcols, crm_nx_rad, crm_ny_rad, crm_nz)) - if (MMF_microphysics_scheme .eq. 'm2005') then - allocate(mu_save (pcols, pver)) - allocate(lambdac_save (pcols, pver)) - allocate(des_save (pcols, pver)) - allocate(mu_crm (pcols, crm_nx_rad, crm_ny_Rad, crm_nz)) - allocate(lambdac_crm (pcols, crm_nx_rad, crm_ny_Rad, crm_nz)) - allocate(des_crm (pcols, crm_nx_rad, crm_ny_Rad, crm_nz)) - end if - end if - - ! Figure out if we are doing radiation at this timestep. For SP-CAM, these - ! should ALWAYS return true...this is handled in radiation_init() by setting - ! iradsw = iradlw = 1 - dosw = radiation_do('sw') ! do shortwave heating calc this timestep? - dolw = radiation_do('lw') ! do longwave heating calc this timestep? - - ! Initialize averages over CRM columns to zero. These are aggregated over - ! the loop over CRM columns below. - if (use_MMF) then - - ! Get CRM radiative heating from the physics buffer; we need to do this regardless of whether - ! or not we are going to do radiative calculations this timestep, because this is still - ! accessed outside the dosw .or. dolw logical block. - crm_qrad_idx = pbuf_get_index('CRM_QRAD') - call pbuf_get_field(pbuf, crm_qrad_idx, crm_qrad) - - ! Only zero SP fields when we are going to update the longwave or - ! shortwave in case we are NOT going to update the radiation each - ! timestep. - if (dosw .or. dolw) then - solin_m = 0. ; fsntoa_m = 0. - fsutoa_m = 0. ; fsntoac_m = 0. - fsnirt_m = 0. ; fsnrtc_m = 0. - fsnirtsq_m = 0. ; fsntc_m = 0. - fsnsc_m = 0. ; fsdsc_m = 0. - flut_m = 0. ; flutc_m = 0. - flntc_m = 0. ; flnsc_m = 0. - fldsc_m = 0. ; flwds_m = 0. - fsns_m = 0. ; fsnt_m = 0. - flns_m = 0. ; flnt_m = 0. - fsds_m = 0. - fln200_m = 0. ; fln200c_m = 0. - fsn200_m = 0. ; fsn200c_m = 0. - sols_m = 0. ; soll_m = 0. - solsd_m = 0. ; solld_m = 0. - qrs_m = 0. ; qrl_m = 0. - qrsc_m = 0. ; qrlc_m = 0. - emis = 0 - qrs_crm = 0. ; qrl_crm = 0. - qrsc_crm = 0. ; qrlc_crm = 0. - emis_crm = 0. ; cld_tau_crm= 0. - crm_aodvisz= 0. ; crm_aodvis = 0. - crm_aod400 = 0. ; crm_aod700 = 0. - aod400 = 0. ; aod700 = 0. - crm_fsnt = 0. ; crm_fsntc = 0. - crm_fsns = 0. ; crm_fsnsc = 0. - crm_flnt = 0. ; crm_flntc = 0. - crm_flns = 0. ; crm_flnsc = 0. - tot_cld_vistau = 0 - tot_icld_vistau = 0. ; nct_tot_icld_vistau = 0. - liq_icld_vistau = 0. ; nct_liq_icld_vistau = 0. - ice_icld_vistau = 0. ; nct_ice_icld_vistau = 0. - snow_icld_vistau = 0. ; nct_snow_icld_vistau = 0. - if (spectralflux) then - su_m = 0. ; sd_m = 0. - lu_m = 0. ; ld_m = 0. - end if - - i_iciwp = pbuf_get_index('ICIWP') - i_iclwp = pbuf_get_index('ICLWP') - i_icswp = pbuf_get_index('ICSWP') - call pbuf_get_field(pbuf, i_iciwp, cicewp) - call pbuf_get_field(pbuf, i_iclwp, cliqwp) - ! call pbuf_get_field(pbuf, i_icswp, csnowp) - cicewp_save = cicewp ! save to restore later - cliqwp_save = cliqwp ! save to restore later - ! csnowp_save = csnowp ! save to restore later - - if (MMF_microphysics_scheme .eq. 'm2005') then - call pbuf_get_field(pbuf, i_icswp, csnowp) - csnowp_save = csnowp ! save to restore later - end if - - crm_t_rad_idx = pbuf_get_index('CRM_T_RAD') - crm_qc_rad_idx = pbuf_get_index('CRM_QC_RAD') - crm_qi_rad_idx = pbuf_get_index('CRM_QI_RAD') - crm_qv_rad_idx = pbuf_get_index('CRM_QV_RAD') - call pbuf_get_field(pbuf, crm_t_rad_idx, t_rad) - call pbuf_get_field(pbuf, crm_qc_rad_idx, qc_rad) - call pbuf_get_field(pbuf, crm_qi_rad_idx, qi_rad) - call pbuf_get_field(pbuf, crm_qv_rad_idx, qv_rad) - - ! Zero out radiative heating - crm_qrad=0. - - if (MMF_microphysics_scheme .eq. 'm2005') then - crm_nc_rad_idx = pbuf_get_index('CRM_NC_RAD') - call pbuf_get_field(pbuf, crm_nc_rad_idx, nc_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx_rad, crm_ny_rad, crm_nz/)) - crm_ni_rad_idx = pbuf_get_index('CRM_NI_RAD') - call pbuf_get_field(pbuf, crm_ni_rad_idx, ni_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx_rad, crm_ny_rad, crm_nz/)) - crm_qs_rad_idx = pbuf_get_index('CRM_QS_RAD') - call pbuf_get_field(pbuf, crm_qs_rad_idx, qs_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx_rad, crm_ny_rad, crm_nz/)) - crm_ns_rad_idx = pbuf_get_index('CRM_NS_RAD') - call pbuf_get_field(pbuf, crm_ns_rad_idx, ns_rad, start=(/1,1,1,1/), kount=(/pcols,crm_nx_rad, crm_ny_rad, crm_nz/)) - endif - - ! Get cloud fraction averaged over the CRM time integration - call pbuf_get_field(pbuf, pbuf_get_index('CRM_CLD_RAD'), cld_rad) - call outfld('CRM_CLD_RAD', cld_rad(1:ncol,:,:,:), state%ncol, state%lchnk) - - cicewp(1:ncol,1:pver) = 0. - cliqwp(1:ncol,1:pver) = 0. - - factor_xy = 1./real( crm_nx_rad*crm_ny_rad ,r8) - - cld_save = cld ! save to restore later - rel_save = rel ! save to restroe later - rei_save = rei ! save to restore later - dei_save = dei ! save to restore later - cld = 0.0_r8 - rel = 0.0_r8 - rei = 0.0_r8 - dei = 0.0_r8 - if (cldfsnow_idx > 0) then - cldfsnow = 0.0_r8 - cldfsnow_save = cldfsnow - end if - if (MMF_microphysics_scheme .eq. 'm2005') then - mu_save = mu - lambdac_save = lambdac - des_save = des - mu = 0.0_r8 - lambdac = 0.0_r8 - des = 0.0_r8 - endif - - end if ! dosw .or. dolw - endif ! MMF - - if (dosw .or. dolw) then - - ! construct an RRTMG state object - r_state => rrtmg_state_create( state, cam_in ) - - ! For CRM, make cloud liquid water path equal to input observations - if(single_column.and.scm_crm_mode.and.have_clwp)then - call endrun('cloud water path must be passed through radiation interface') - !do k=1,pver - ! cliqwp(:ncol,k) = clwpobs(k) - !end do - endif - - ! calculate effective radius - moved outside of ii,jj loops for 1-moment microphysics - if (MMF_microphysics_scheme .eq. 'sam1mom') then - call cldefr( lchnk, ncol, state%t, rel, rei, state%ps, state%pmid, landfrac, icefrac, snowh ) - end if - - ! Start loop over CRM columns; the strategy here is to loop over each CRM - ! column and separately call the radiative transfer codes with optical - ! properties calculated from CRM fields for each of those columns. Note - ! that here we loop over "crm_nx_rad" rather than "crm_nx". This is to - ! allow the flexibility for the radiation to be calculated on a reduced - ! resolution relative to the CRM by grouping (averaging) adjacent columns - ! together. - do jj=1,crm_ny_rad - do ii=1,crm_nx_rad - - if (use_MMF) then - first_column = ii.eq.1.and.jj.eq.1 - last_column = ii.eq.crm_nx_rad.and.jj.eq.crm_ny_rad - - do m=1,crm_nz - k = pver-m+1 - do i=1,ncol - - ! Overwrite cloud fraction with CRM cloud fraction - cld(i,k) = cld_rad(i,ii,jj,m) - - ! Calculate water paths and fraction of ice - if (cld(i,k) > 0) then - qtot = qc_rad(i,ii,jj,m) + qi_rad(i,ii,jj,m) - fice(i,k) = qi_rad(i,ii,jj,m)/qtot - cicewp(i,k) = qi_rad(i,ii,jj,m)*state%pdel(i,k)/gravit & - / max(0.01_r8,cld(i,k)) ! In-cloud ice water path. - cliqwp(i,k) = qc_rad(i,ii,jj,m)*state%pdel(i,k)/gravit & - / max(0.01_r8,cld(i,k)) ! In-cloud liquid water path. - else - fice(i,k)= 0. - cicewp(i,k) = 0. ! In-cloud ice water path. - cliqwp(i,k) = 0. ! In-cloud liquid water path. - end if - - ! snow water-related variables: - ! snow water is an important component in m2005 microphysics, and is therefore taken - ! into account in the radiative calculation (snow water path is several times larger - ! than ice water path in m2005 globally). - if (MMF_microphysics_scheme .eq. 'm2005') then - if( qs_rad(i, ii, jj, m).gt.1.0e-7) then - cldfsnow(i,k) = 0.99_r8 - csnowp(i,k) = qs_rad(i,ii,jj,m)*state%pdel(i,k)/gravit & - / max(0.001_r8,cldfsnow(i,k)) ! In-cloud ice water path. - else - cldfsnow(i,k) = 0.0 - csnowp(i,k) = 0.0 - end if - end if - - ! Update ice water, liquid water, water vapor, and temperature in state - state%q(i,k,ixcldice) = qi_rad(i,ii,jj,m) - state%q(i,k,ixcldliq) = qc_rad(i,ii,jj,m) - state%q(i,k,1) = max(1.e-9_r8,qv_rad(i,ii,jj,m)) - state%t(i,k) = t_rad(i, ii, jj, m) - - end do ! i - end do ! m - - ! update effective radius - if (MMF_microphysics_scheme .eq. 'm2005') then - do m=1,crm_nz - k = pver-m+1 - do i=1,ncol - call m2005_effradius(qc_rad(i,ii,jj,m), nc_rad(i,ii,jj,m), qi_rad(i,ii,jj,m), & - ni_rad(i,ii,jj,m), qs_rad(i,ii,jj,m), ns_rad(i,ii,jj,m), & - 1.0_r8, state%pmid(i,k), state%t(i,k), effl, effi, effl_fn, deffi, lamc, pgam, dest) - rel(i,k) = effl - rei(i,k) = effi - dei(i,k) = deffi - mu(i,k) = pgam - lambdac(i,k) = lamc - des(i,k) = dest - dei_crm(i,ii,jj,m) = dei(i,k) - mu_crm(i,ii,jj,m) = mu(i,k) - lambdac_crm(i,ii,jj,m) = lambdac(i,k) - des_crm(i,ii,jj,m) = des(i,k) - - rel_crm(i,ii,jj,m) = rel(i,k) - rei_crm(i,ii,jj,m) = rei(i,k) - end do ! i - end do ! m - else if (MMF_microphysics_scheme .eq. 'sam1mom') then - ! for sam1mom, rel and rei are calculated above, and are the same for all CRM columns - do m=1,crm_nz - k = pver-m+1 - rel_crm(:ncol,ii,jj,m)=rel(:ncol,k) - rei_crm(:ncol,ii,jj,m)=rei(:ncol,k) - - dei(:ncol,k) = rei(:ncol,k) * 2.0_r8 - ! whannah - calculation of dei below is taken from m2005_effradius() - ! dei(:ncol,k) = rei(:ncol,k) * 500._r8/917._r8 * 2._r8 - dei_crm(:ncol,ii,jj,m) = dei(:ncol,k) - end do ! m - end if ! sam1mom - - endif ! use_MMF - - call t_startf('cldoptics') - if (dosw) then - select case (icecldoptics) - case ('ebertcurry') - call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.false.) - case ('mitchell') - call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f) - case default - call endrun('iccldoptics must be one either ebertcurry or mitchell') - end select - select case (liqcldoptics) - case ('slingo') - call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.false.) - case ('gammadist') - call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f) - case default - call endrun('liqcldoptics must be either slingo or gammadist') - end select - cld_tau (:,1:ncol,:) = liq_tau (:,1:ncol,:) + ice_tau (:,1:ncol,:) - cld_tau_w (:,1:ncol,:) = liq_tau_w (:,1:ncol,:) + ice_tau_w (:,1:ncol,:) - cld_tau_w_g(:,1:ncol,:) = liq_tau_w_g(:,1:ncol,:) + ice_tau_w_g(:,1:ncol,:) - cld_tau_w_f(:,1:ncol,:) = liq_tau_w_f(:,1:ncol,:) + ice_tau_w_f(:,1:ncol,:) - - if (cldfsnow_idx > 0) then - ! add in snow - call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, snow_tau_w_f) - do i=1,ncol - do k=1,pver - cldfprime(i,k)=max(cld(i,k),cldfsnow(i,k)) - if(cldfprime(i,k) > 0.)then - c_cld_tau (1:nbndsw,i,k) = (cldfsnow(i,k)*snow_tau (1:nbndsw,i,k) & - + cld(i,k)*cld_tau (1:nbndsw,i,k))/cldfprime(i,k) - c_cld_tau_w (1:nbndsw,i,k) = (cldfsnow(i,k)*snow_tau_w (1:nbndsw,i,k) & - + cld(i,k)*cld_tau_w (1:nbndsw,i,k))/cldfprime(i,k) - c_cld_tau_w_g(1:nbndsw,i,k) = (cldfsnow(i,k)*snow_tau_w_g(1:nbndsw,i,k) & - + cld(i,k)*cld_tau_w_g (1:nbndsw,i,k))/cldfprime(i,k) - c_cld_tau_w_f(1:nbndsw,i,k) = (cldfsnow(i,k)*snow_tau_w_f(1:nbndsw,i,k) & - + cld(i,k)*cld_tau_w_f (1:nbndsw,i,k))/cldfprime(i,k) - else - c_cld_tau (1:nbndsw,i,k) = 0._r8 - c_cld_tau_w (1:nbndsw,i,k) = 0._r8 - c_cld_tau_w_g(1:nbndsw,i,k) = 0._r8 - c_cld_tau_w_f(1:nbndsw,i,k) = 0._r8 - endif - enddo - enddo - else ! cldfsnow_idx > 0 - c_cld_tau (1:nbndsw,1:ncol,:) = cld_tau (:,1:ncol,:) - c_cld_tau_w (1:nbndsw,1:ncol,:) = cld_tau_w (:,1:ncol,:) - c_cld_tau_w_g(1:nbndsw,1:ncol,:) = cld_tau_w_g(:,1:ncol,:) - c_cld_tau_w_f(1:nbndsw,1:ncol,:) = cld_tau_w_f(:,1:ncol,:) - endif ! cldfsnow_idx > 0 - - ! Save cloud optical depth for CRM column to output later - if (use_MMF) then - do m=1,crm_nz - k = pver-m+1 - do i=1,ncol - cld_tau_crm(i,ii,jj,m) = cld_tau(rrtmg_sw_cloudsim_band,i,k) - end do ! i - end do ! m - endif - - if(do_aerocom_ind3) then - call pbuf_set_field(pbuf,cld_tau_idx,cld_tau(rrtmg_sw_cloudsim_band, :, :)) - end if - - endif - - if (dolw) then - select case (icecldoptics) - case ('ebertcurry') - call ec_ice_get_rad_props_lw(state, pbuf, ice_lw_abs, oldicewp=.false.) - case ('mitchell') - call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs) - case default - call endrun('iccldoptics must be one either ebertcurry or mitchell') - end select - select case (liqcldoptics) - case ('slingo') - call slingo_liq_get_rad_props_lw(state, pbuf, liq_lw_abs, oldliqwp=.false.) - case ('gammadist') - call liquid_cloud_get_rad_props_lw(state, pbuf, liq_lw_abs) - case default - call endrun('liqcldoptics must be either slingo or gammadist') - end select - cld_lw_abs(:,1:ncol,:) = liq_lw_abs(:,1:ncol,:) + ice_lw_abs(:,1:ncol,:) - - if (cldfsnow_idx > 0) then - ! add in snow - call snow_cloud_get_rad_props_lw(state, pbuf, snow_lw_abs) - do i=1,ncol - do k=1,pver - cldfprime(i,k)=max(cld(i,k),cldfsnow(i,k)) - if(cldfprime(i,k) > 0.)then - c_cld_lw_abs(1:nbndlw,i,k)= & - (cldfsnow(i,k)*snow_lw_abs(1:nbndlw,i,k) + cld(i,k)*cld_lw_abs(1:nbndlw,i,k))/cldfprime(i,k) - else - c_cld_lw_abs(1:nbndlw,i,k)= 0._r8 - endif - enddo - enddo - else ! cldfsnow_idx > 0 - c_cld_lw_abs(1:nbndlw,1:ncol,:)=cld_lw_abs(:,1:ncol,:) - endif ! cldfsnow_idx > 0 - - ! Calculate longwave emissivity - emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs(rrtmg_lw_cloudsim_band,:ncol,:)) - - ! Save emissivity for CRM - if (use_MMF) then - do m = 1,crm_nz - k = pver-m+1 - do i = 1,ncol - emis_crm(i,ii,jj,m) = emis(i,k) - end do ! i - end do ! m - endif ! use_MMF - - endif ! dolw - - if (.not.(cldfsnow_idx > 0)) then - cldfprime(1:ncol,:)=cld(1:ncol,:) - endif - - call t_stopf('cldoptics') - - ! construct cgs unit reps of pmid and pint and get "eccf" - earthsundistancefactor - call radinp(ncol, state%pmid, state%pint, pbr, pnm, eccf) - - ! Calculate interface temperatures (following method - ! used in radtpl for the longwave), using surface upward flux and - ! stebol constant in mks units - do i = 1,ncol - tint(i,1) = state%t(i,1) - tint(i,pverp) = sqrt(sqrt(cam_in%lwup(i)/stebol)) - do k = 2,pver - dy = (state%lnpint(i,k) - state%lnpmid(i,k)) / (state%lnpmid(i,k-1) - state%lnpmid(i,k)) - tint(i,k) = state%t(i,k) - dy * (state%t(i,k) - state%t(i,k-1)) - end do - end do - - ! Solar radiation computation - if (dosw) then - call t_startf ('rad_sw') - - ! Calculate solar variability factor - call get_variability(sfac) - - ! Get the active climate/diagnostic shortwave calculations - call rad_cnst_get_call_list(active_calls) - - ! Loop over diagnostic cases (each of which can contain different - ! radiative constituents. The climate (icall==0) calculation must - ! occur last, so we loop from N_DIAG to 0. - do icall = N_DIAG, 0, -1 - - if (active_calls(icall)) then - - ! Update the concentrations in the RRTMG state object - call rrtmg_state_update( state, pbuf, icall, r_state ) - - ! Calculate the aerosol optical properties - call aer_rad_props_sw( icall, state, pbuf, nnite, idxnite, is_cmip6_volc, & - aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f) - - ! Run the shortwave radiation driver - call t_startf ('rad_rrtmg_sw') - call rad_rrtmg_sw( & - lchnk, ncol, num_rrtmg_levs, r_state, & - state%pmid, cldfprime, & - aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f, & - eccf, coszrs, solin, sfac, & - cam_in%asdir, cam_in%asdif, cam_in%aldir, cam_in%aldif, & - qrs, qrsc, fsnt, fsntc, fsntoa, fsutoa, & - fsntoac, fsnirt, fsnrtc, fsnirtsq, fsns, & - fsnsc, fsdsc, fsds, cam_out%sols, cam_out%soll, & - cam_out%solsd,cam_out%solld,fns, fcns, & - Nday, Nnite, IdxDay, IdxNite, clm_seed, & - su, sd, & - E_cld_tau=c_cld_tau, E_cld_tau_w=c_cld_tau_w, E_cld_tau_w_g=c_cld_tau_w_g, E_cld_tau_w_f=c_cld_tau_w_f, & - old_convert = .false.) - call t_stopf ('rad_rrtmg_sw') - - ! Output net fluxes at 200 mb - call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcns, fsn200c) - call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fns, fsn200) - - ! Calculate diagnostic quantities - do i=1,ncol - swcf(i)=fsntoa(i) - fsntoac(i) - fsutoac(i) = solin(i) - fsntoac(i) - end do - - ! Aggregate grid-mean averages from cloud-scale fluxes and heating rates - if (use_MMF) then - do i = 1,ncol - qrs_m (i,:pver, icall) = qrs_m(i,:pver, icall) + qrs(i,:pver)*factor_xy - qrsc_m (i,:pver, icall) = qrsc_m(i,:pver, icall) + qrsc(i,:pver)*factor_xy - solin_m (i, icall) = solin_m (i, icall)+solin (i)*factor_xy - fsds_m (i, icall) = fsds_m (i, icall)+fsds (i)*factor_xy - fsnirt_m (i, icall) = fsnirt_m (i, icall)+fsnirt (i)*factor_xy - fsnrtc_m (i, icall) = fsnrtc_m (i, icall)+fsnrtc (i)*factor_xy - fsnirtsq_m(i, icall) = fsnirtsq_m(i, icall)+fsnirtsq(i)*factor_xy - fsnt_m (i, icall) = fsnt_m (i, icall)+fsnt (i)*factor_xy - fsns_m (i, icall) = fsns_m (i, icall)+fsns (i)*factor_xy - fsntc_m (i, icall) = fsntc_m (i, icall)+fsntc (i)*factor_xy - fsnsc_m (i, icall) = fsnsc_m (i, icall)+fsnsc (i)*factor_xy - fsdsc_m (i, icall) = fsdsc_m (i, icall)+fsdsc (i)*factor_xy - fsntoa_m (i, icall) = fsntoa_m (i, icall)+fsntoa (i)*factor_xy - fsutoa_m (i, icall) = fsutoa_m (i, icall)+fsutoa (i)*factor_xy - fsntoac_m (i, icall) = fsntoac_m (i, icall)+fsntoac (i)*factor_xy - sols_m (i, icall) = sols_m (i, icall)+cam_out%sols (i)*factor_xy - soll_m (i, icall) = soll_m (i, icall)+cam_out%soll (i)*factor_xy - solsd_m (i, icall) = solsd_m (i, icall)+cam_out%solsd(i)*factor_xy - solld_m (i, icall) = solld_m (i, icall)+cam_out%solld(i)*factor_xy - fsn200_m (i, icall) = fsn200_m (i, icall)+fsn200 (i)*factor_xy - fsn200c_m (i, icall) = fsn200c_m (i, icall)+fsn200c(i)*factor_xy - if (spectralflux) then - su_m(i,:,:,icall) = su_m(i,:,:,icall) + su(i,:,:)*factor_xy - sd_m(i,:,:,icall) = sd_m(i,:,:,icall) + sd(i,:,:)*factor_xy - end if - end do ! i = 1,ncol - - if(icall.eq.0) then ! for the climate call - do i=1, ncol - crm_fsnt (i,ii,jj) = fsnt(i) - crm_fsntc (i,ii,jj) = fsntc(i) - crm_fsns (i,ii,jj) = fsns(i) - crm_fsnsc (i,ii,jj) = fsnsc(i) - crm_aodvis(i,ii,jj) = sum(aer_tau(i, :, idx_sw_diag)) - crm_aod400(i,ii,jj) = sum(aer_tau(i, :, idx_sw_diag+1)) - crm_aod700(i,ii,jj) = sum(aer_tau(i, :, idx_sw_diag-1)) - aod400(i) = aod400(i)+crm_aod400(i,ii,jj) * factor_xy - aod700(i) = aod700(i)+crm_aod700(i,ii,jj) * factor_xy - end do - do m=1,crm_nz - k = pver-m+1 - qrs_crm(:ncol,ii,jj,m) = qrs(:ncol,k) / cpair - qrsc_crm(:ncol,ii,jj,m) = qrsc(:ncol,k) / cpair - crm_aodvisz(:ncol, ii, jj, m) = aer_tau(:ncol,k,idx_sw_diag) - end do - - do i=1, ncol - do k=1, pver - if(c_cld_tau(idx_sw_diag,i,k).gt.1.0e-10) then - tot_icld_vistau(i,k) = tot_icld_vistau(i,k) + c_cld_tau(idx_sw_diag,i,k) - nct_tot_icld_vistau(i,k) = nct_tot_icld_vistau(i,k) + 1 - end if - if(liq_tau(idx_sw_diag,i,k).gt.1.0e-10) then - liq_icld_vistau(i,k) = liq_icld_vistau(i,k) + liq_tau(idx_sw_diag,i,k) - nct_liq_icld_vistau(i,k) = nct_liq_icld_vistau(i,k) + 1 - end if - if(ice_tau(idx_sw_diag,i,k).gt.1.0e-10) then - ice_icld_vistau(i,k) = ice_icld_vistau(i,k) + ice_tau(idx_sw_diag,i,k) - nct_ice_icld_vistau(i,k) = nct_ice_icld_vistau(i,k) + 1 - end if - if(snow_tau(idx_sw_diag,i,k).gt.1.0e-10) then - snow_icld_vistau(i,k) = snow_icld_vistau(i,k) + snow_tau(idx_sw_diag,i,k) - nct_snow_icld_vistau(i,k) = nct_snow_icld_vistau(i,k) + 1 - end if - end do - end do - end if ! for the climate call - - if(last_column) then - do i=1, ncol - qrs(i,:pver) = qrs_m(i,:pver, icall) - qrsc(i,:pver) = qrsc_m(i,:pver, icall) - solin(i) = solin_m(i, icall) - fsds(i) = fsds_m(i, icall) - fsnirt(i)= fsnirt_m(i, icall) - fsnrtc(i)= fsnrtc_m(i, icall) - fsnirtsq(i)= fsnirtsq_m(i, icall) - fsnt(i) = fsnt_m(i, icall) - fsns(i) = fsns_m(i, icall) - fsntc(i) = fsntc_m(i, icall) - fsnsc(i) = fsnsc_m(i, icall) - fsdsc(i) = fsdsc_m(i, icall) - fsntoa(i)=fsntoa_m(i, icall) - fsutoa(i)=fsutoa_m(i, icall) - fsntoac(i)=fsntoac_m(i, icall) - cam_out%sols(i) =sols_m(i, icall) - cam_out%soll(i) =soll_m(i, icall) - cam_out%solsd(i) =solsd_m(i, icall) - cam_out%solld(i) =solld_m(i, icall) - fsn200(i) = fsn200_m(i, icall) - fsn200c(i) = fsn200c_m(i, icall) - if (spectralflux) then - su(i,:,:) = su_m(i,:,:,icall) - sd(i,:,:) = sd_m(i,:,:,icall) - end if - swcf(i)=fsntoa(i) - fsntoac(i) - fsutoac(i) = solin(i) - fsntoac(i) - end do - end if ! last_column - end if ! (use_MMF) - - ! Dump shortwave radiation information to history tape buffer (diagnostics) - if ( (use_MMF .and. last_column) .or. .not. use_MMF) then - ftem(:ncol,:pver) = qrs(:ncol,:pver)/cpair - call outfld('QRS'//diag(icall),ftem ,pcols,lchnk) - ftem(:ncol,:pver) = qrsc(:ncol,:pver)/cpair - call outfld('QRSC'//diag(icall),ftem ,pcols,lchnk) - call outfld('SOLIN'//diag(icall),solin ,pcols,lchnk) - call outfld('FSDS'//diag(icall),fsds ,pcols,lchnk) - call outfld('FSNIRTOA'//diag(icall),fsnirt,pcols,lchnk) - call outfld('FSNRTOAC'//diag(icall),fsnrtc,pcols,lchnk) - call outfld('FSNRTOAS'//diag(icall),fsnirtsq,pcols,lchnk) - call outfld('FSNT'//diag(icall),fsnt ,pcols,lchnk) - call outfld('FSNS'//diag(icall),fsns ,pcols,lchnk) - call outfld('FSNTC'//diag(icall),fsntc ,pcols,lchnk) - call outfld('FSNSC'//diag(icall),fsnsc ,pcols,lchnk) - call outfld('FSDSC'//diag(icall),fsdsc ,pcols,lchnk) - call outfld('FSNTOA'//diag(icall),fsntoa,pcols,lchnk) - call outfld('FSUTOA'//diag(icall),fsutoa,pcols,lchnk) - call outfld('FSNTOAC'//diag(icall),fsntoac,pcols,lchnk) - call outfld('SOLS'//diag(icall),cam_out%sols ,pcols,lchnk) - call outfld('SOLL'//diag(icall),cam_out%soll ,pcols,lchnk) - call outfld('SOLSD'//diag(icall),cam_out%solsd ,pcols,lchnk) - call outfld('SOLLD'//diag(icall),cam_out%solld ,pcols,lchnk) - call outfld('FSN200'//diag(icall),fsn200,pcols,lchnk) - call outfld('FSN200C'//diag(icall),fsn200c,pcols,lchnk) - call outfld('SWCF'//diag(icall),swcf ,pcols,lchnk) - end if ! (use_MMF .and. last_column) .or .not. use_MMF - - if(do_aerocom_ind3) then - aerindex = 0.0 - angstrm = 0.0 - aod400 = 0.0 - aod700 = 0.0 - do i=1, ncol - aod400(i) = sum(aer_tau(i, :, idx_sw_diag+1)) - aod700(i) = sum(aer_tau(i, :, idx_sw_diag-1)) - if(aod400(i).lt.1.0e4 .and. aod700(i).lt.1.e4 .and. & - aod400(i).gt.1.0e-10 .and. aod700(i).gt.1.0e-10) then - angstrm(i) = (log (aod400(i))-log(aod700(i)))/(log(0.700)-log(0.400)) - else - angstrm(i) = fillvalue - end if - if(angstrm(i).ne.fillvalue) then - aerindex(i) = angstrm(i)*sum(aer_tau(i,:,idx_sw_diag)) - else - aerindex(i) = fillvalue - end if - end do - do i = 1, nnite - angstrm(idxnite(i)) = fillvalue - aod400(idxnite(i)) = fillvalue - aod700(idxnite(i)) = fillvalue - aerindex(idxnite(i)) = fillvalue - end do - if(icall.eq.0) then ! only for climatology run - call outfld('angstrm', angstrm, pcols, lchnk) - call outfld('aod400', aod400, pcols, lchnk) - call outfld('aod700', aod700, pcols, lchnk) - call outfld('aerindex', aerindex, pcols, lchnk) - end if - end if ! do_aerocom_ind3 - - end if ! (active_calls(icall)) - end do ! icall - - if(use_MMF .and. last_column) then - do i = 1, nnite - crm_aodvis(idxnite(i), :, :) = fillvalue - crm_aod400(idxnite(i), :, :) = fillvalue - crm_aod700(idxnite(i), :, :) = fillvalue - aod400(idxnite(i)) = fillvalue - aod700(idxnite(i)) = fillvalue - crm_aodvisz(idxnite(i), :, :, :) = fillvalue - end do - call outfld('CRM_FSNT', crm_fsnt, pcols, lchnk) - call outfld('CRM_FSNTC', crm_fsntc, pcols, lchnk) - call outfld('CRM_FSNS', crm_fsns, pcols, lchnk) - call outfld('CRM_FSNSC', crm_fsnsc, pcols, lchnk) - call outfld('CRM_AODVIS', crm_aodvis, pcols, lchnk) - call outfld('CRM_AOD400', crm_aod400, pcols, lchnk) - call outfld('CRM_AOD700', crm_aod700, pcols, lchnk) - call outfld('AOD400', aod400, pcols, lchnk) - call outfld('AOD700', aod700, pcols, lchnk) - call outfld('CRM_AODVISZ', crm_aodvisz, pcols, lchnk) - - do i=1,ncol - do k=1,pver - tot_cld_vistau(i,k) = tot_icld_vistau(i,k) * factor_xy - if(nct_tot_icld_vistau(i,k).ge.1) then - tot_icld_vistau(i,k) = tot_icld_vistau(i,k)/nct_tot_icld_vistau(i,k) - else - tot_icld_vistau(i,k) = 0.0_r8 - end if - if(nct_liq_icld_vistau(i,k).ge.1) then - liq_icld_vistau(i,k) = liq_icld_vistau(i,k)/nct_liq_icld_vistau(i,k) - else - liq_icld_vistau(i,k) = 0.0_r8 - end if - if(nct_ice_icld_vistau(i,k).ge.1) then - ice_icld_vistau(i,k) = ice_icld_vistau(i,k)/nct_ice_icld_vistau(i,k) - else - ice_icld_vistau(i,k) = 0.0_r8 - end if - if(nct_snow_icld_vistau(i,k).ge.1) then - snow_icld_vistau(i,k) = snow_icld_vistau(i,k)/nct_snow_icld_vistau(i,k) - else - snow_icld_vistau(i,k) = 0.0_r8 - end if - end do ! k - end do ! i - else if (.not. use_MMF) then - ! Output cloud optical depth fields for the visible band - tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) - liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) - ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) - if (cldfsnow_idx > 0) then - snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) - endif - ! multiply by total cloud fraction to get gridbox value - tot_cld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)*cldfprime(:ncol,:) - endif ! use_MMF .and. last_column - - ! add fillvalue for night columns - if ( (use_MMF .and. last_column) .or. .not. use_MMF) then - do i = 1, Nnite - tot_cld_vistau(IdxNite(i),:) = fillvalue - tot_icld_vistau(IdxNite(i),:) = fillvalue - liq_icld_vistau(IdxNite(i),:) = fillvalue - ice_icld_vistau(IdxNite(i),:) = fillvalue - if (cldfsnow_idx > 0) then - snow_icld_vistau(IdxNite(i),:) = fillvalue - endif - end do - - call outfld('TOT_CLD_VISTAU', tot_cld_vistau, pcols, lchnk) - call outfld('TOT_ICLD_VISTAU', tot_icld_vistau, pcols, lchnk) - call outfld('LIQ_ICLD_VISTAU', liq_icld_vistau, pcols, lchnk) - call outfld('ICE_ICLD_VISTAU', ice_icld_vistau, pcols, lchnk) - if (cldfsnow_idx > 0) then - call outfld('SNOW_ICLD_VISTAU', snow_icld_vistau, pcols, lchnk) - endif - end if - - call t_stopf ('rad_sw') - - end if ! dosw - - if( (use_MMF .and. last_column) .or. .not. use_MMF) then - ! Output aerosol mmr - call rad_cnst_out(0, state, pbuf) - end if - - ! Longwave radiation computation - if (dolw) then - - call t_startf ('rad_lw') - - ! Convert upward longwave flux units to CGS - do i=1,ncol - lwupcgs(i) = cam_in%lwup(i)*1000._r8 - if(single_column.and.scm_crm_mode.and.have_tg) & - lwupcgs(i) = 1000*stebol*tground(1)**4 - end do - - ! Get the active climate/diagnostic shortwave calculations - call rad_cnst_get_call_list(active_calls) - - ! Loop over diagnostic cases (each of which can contain different - ! radiative constituents. The climate (icall==0) calculation must - ! occur last, so we loop from N_DIAG to 0. - do icall = N_DIAG, 0, -1 - if (active_calls(icall)) then - - ! Update the concentrations in the RRTMG state object - call rrtmg_state_update( state, pbuf, icall, r_state) - - ! Calculate aerosol optical properties - call aer_rad_props_lw(is_cmip6_volc, icall, state, pbuf, aer_lw_abs) - - call t_startf ('rad_rrtmg_lw') - call rad_rrtmg_lw( & - lchnk, ncol, num_rrtmg_levs, r_state, & - state%pmid, aer_lw_abs, cldfprime, c_cld_lw_abs, & - qrl, qrlc, & - flns, flnt, flnsc, flntc, cam_out%flwds, & - flut, flutc, fnl, fcnl, fldsc, & - clm_seed, lu, ld ) - call t_stopf ('rad_rrtmg_lw') - - do i=1,ncol - lwcf(i)=flutc(i) - flut(i) - end do - - ! Output fluxes at 200 mb - call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fnl, fln200) - call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcnl, fln200c) - - ! Aggregate grid-mean averages from cloud-scale fluxes and heating rates - if (use_MMF) then - do i=1, ncol - qrl_m (i,:pver, icall) = qrl_m (i,:pver, icall) + qrl (i,:pver)*factor_xy - qrlc_m(i,:pver, icall) = qrlc_m(i,:pver, icall) + qrlc(i,:pver)*factor_xy - flnt_m (i, icall) = flnt_m (i, icall)+flnt(i) *factor_xy - flut_m (i, icall) = flut_m (i, icall)+flut(i) *factor_xy - flutc_m (i, icall) = flutc_m (i, icall)+flutc(i) *factor_xy - flntc_m (i, icall) = flntc_m (i, icall)+flntc(i) *factor_xy - flns_m (i, icall) = flns_m (i, icall)+flns(i) *factor_xy - flnsc_m (i, icall) = flnsc_m (i, icall)+flnsc(i) *factor_xy - fldsc_m (i, icall) = fldsc_m (i, icall)+fldsc(i) *factor_xy - flwds_m (i, icall) = flwds_m (i, icall)+cam_out%flwds(i) *factor_xy - fln200_m (i, icall) = fln200_m (i, icall)+fln200(i) *factor_xy - fln200c_m(i, icall) = fln200c_m(i, icall)+fln200c(i) *factor_xy - if (spectralflux) then - lu_m(i,:,:,icall) = lu_m(i,:,:,icall) + lu(i,:,:)*factor_xy - ld_m(i,:,:,icall) = ld_m(i,:,:,icall) + ld(i,:,:)*factor_xy - end if - - ! Only save the CRM fluxes for the case that affects the - ! climate (icall == 0) - if(icall.eq.0) then - crm_flnt (i,ii,jj) = flnt(i) - crm_flntc(i,ii,jj) = flntc(i) - crm_flns (i,ii,jj) = flns(i) - crm_flnsc(i,ii,jj) = flnsc(i) - do m=1,crm_nz - k = pver-m+1 - qrl_crm(:ncol,ii,jj,m) = qrl(:ncol,k) / cpair - qrlc_crm(:ncol,ii,jj,m) = qrlc(:ncol,k) / cpair - end do - end if ! icall == 0 - - end do ! i = 1,ncol - - ! Set GCM fluxes to grid-means of the cloud-scale fluxes if this - ! is the last column (since the aggregated averages will - ! represent the full grid-mean by now) - if(last_column) then - do i = 1,ncol - qrl (i,:pver) = qrl_m(i,:pver, icall) - qrlc(i,:pver) = qrlc_m(i,:pver, icall) - flnt (i) = flnt_m (i, icall) - flut (i) = flut_m (i, icall) - flutc(i) = flutc_m(i, icall) - flntc(i) = flntc_m(i, icall) - flns (i) = flns_m (i, icall) - flnsc(i) = flnsc_m(i, icall) - fldsc(i) = fldsc_m(i, icall) - cam_out%flwds(i) = flwds_m(i, icall) - fln200 (i) = fln200_m (i, icall) - fln200c(i) = fln200c_m(i, icall) - if (spectralflux) then - lu(i,:,:) = lu_m(i,:,:,icall) - ld(i,:,:) = ld_m(i,:,:,icall) - end if - lwcf(i)=flutc(i) - flut(i) - end do ! i = 1,ncol - endif ! last_column - - endif ! use_SPACM - - ! Dump longwave radiation information to history tape buffer (diagnostics) - if ( (use_MMF .and. last_column ) .or. .not. use_MMF) then - call outfld('QRL'//diag(icall),qrl (:ncol,:)/cpair,ncol,lchnk) - call outfld('QRLC'//diag(icall),qrlc(:ncol,:)/cpair,ncol,lchnk) - call outfld('FLNT'//diag(icall),flnt ,pcols,lchnk) - call outfld('FLUT'//diag(icall),flut ,pcols,lchnk) - call outfld('FLUTC'//diag(icall),flutc ,pcols,lchnk) - call outfld('FLNTC'//diag(icall),flntc ,pcols,lchnk) - call outfld('FLNS'//diag(icall),flns ,pcols,lchnk) - - call outfld('FLDSC'//diag(icall),fldsc ,pcols,lchnk) - call outfld('FLNSC'//diag(icall),flnsc ,pcols,lchnk) - call outfld('LWCF'//diag(icall),lwcf ,pcols,lchnk) - call outfld('FLN200'//diag(icall),fln200,pcols,lchnk) - call outfld('FLN200C'//diag(icall),fln200c,pcols,lchnk) - call outfld('FLDS'//diag(icall),cam_out%flwds ,pcols,lchnk) - end if - if (use_MMF .and. last_column ) then - if(icall.eq.0) then ! the climate call - call outfld('CRM_FLNT', crm_flnt, pcols, lchnk) - call outfld('CRM_FLNTC', crm_flntc, pcols, lchnk) - call outfld('CRM_FLNS', crm_flns, pcols, lchnk) - call outfld('CRM_FLNSC', crm_flnsc, pcols, lchnk) - end if ! the climate call - end if - - end if ! active_calls(icall) - end do ! icall - - call t_stopf ('rad_lw') - - end if !dolw - end do ! ii = 1,crm_nx_rad - end do ! jj = 1,crm_nx_rad - - ! Restore pbuf and state to values as input to this routine before we - ! modified them in-place to populate with CRM column values - if (use_MMF) then - cld = cld_save - cicewp = cicewp_save - cliqwp = cliqwp_save - if (cldfsnow_idx > 0) then - csnowp = csnowp_save - cldfsnow = cldfsnow_save - end if - rel = rel_save - rei = rei_save - state = statein_copy - dei = dei_save - deallocate(dei_save) - if (MMF_microphysics_scheme .eq. 'm2005') then - mu = mu_save - lambdac = lambdac_save - des = des_save - deallocate (mu_save, lambdac_save, des_save) - endif - endif ! use_MMF - - ! Calculate net CRM heating rate from shortwave and longwave heating rates - if (use_MMF) then - do m = 1,crm_nz - do i = 1,ncol - crm_qrad(i,:,:,m) = (qrs_crm(i,:,:,m) + qrl_crm(i,:,:,m)) - end do - end do - endif ! use_MMF - - ! deconstruct the RRTMG state object - call rrtmg_state_destroy(r_state) - - ! mji/hirsrtm - Add call to HIRSRTM package - ! HIRS brightness temperature calculation in 7 infra-red channels and 4 microwave - ! channels as a diagnostic to compare to TOV/MSU satellite data. - ! Done if dohirs set to .true. at time step frequency ihirsfq - nstep = get_nstep() - if ( dohirs .and. (mod(nstep-1,ihirsfq) .eq. 0) ) then - - do i= 1, ncol - ts(i) = sqrt(sqrt(cam_in%lwup(i)/stebol)) - ! Set oro (land/sea flag) for compatibility with landfrac/icefrac/ocnfrac - ! oro=0 (sea or ice); oro=1 (land) - if (landfrac(i).ge.0.001) then - oro(i)=1. - else - oro(i)=0. - endif - ! Convert pressure from Pa to hPa - do k = 1, pver - pintmb(i,k) = state%pint(i,k)*1.e-2_r8 - end do - pintmb(i,pverp) = state%pint(i,pverp)*1.e-2_r8 - end do - - ! Get constituent mixing ratios (specific humidity, ozone mass mixing - ! ratio, CO2 mass mixing ratio - call rad_cnst_get_gas(0,'H2O', state, pbuf, sp_hum) - call rad_cnst_get_gas(0,'O3', state, pbuf, o3) - call rad_cnst_get_gas(0,'CO2', state, pbuf, co2) - - call calc_col_mean(state, co2, co2_col_mean) - - ! Call the hirsrtm driver - call t_startf ('hirstrm') - call hirsrtm( lchnk ,ncol , & - pintmb ,state%t ,sp_hum ,co2_col_mean, & - o3 ,ts ,oro ,tb_ir ,britemp ) - call t_stopf ('hirstrm') - - ! Send outputs to history buffer - do i = 1, pnb_hirs - call outfld(hirsname(i),tb_ir(1,i),pcols,lchnk) - end do - do i = 1, pnf_msu - call outfld(msuname(i),britemp(1,i),pcols,lchnk) - end do - - end if - - call outfld('EMIS ',emis ,pcols ,lchnk ) - - ! Run the CFMIP Observation Simulator Package (COSP) - ! For the time being, the MMF stuff is not coupled with the COSP - ! simulator, so bypass this code if we are using SP/MMF (for now) - if (.not. use_MMF) then - - !! compute grid-box mean SW and LW snow optical depth for use by COSP - gb_snow_tau(:,:) = 0._r8 - gb_snow_lw(:,:) = 0._r8 - if (cldfsnow_idx > 0) then - do i=1,ncol - do k=1,pver - if(cldfsnow(i,k) > 0.)then - gb_snow_tau(i,k) = snow_tau(rrtmg_sw_cloudsim_band,i,k)*cldfsnow(i,k) - gb_snow_lw(i,k) = snow_lw_abs(rrtmg_lw_cloudsim_band,i,k)*cldfsnow(i,k) - end if - enddo - enddo - end if - - if (docosp) then - !! cosp_cnt referenced for each chunk... cosp_cnt(lchnk) - !! advance counter for this timestep - cosp_cnt(lchnk) = cosp_cnt(lchnk) + 1 - - !! if counter is the same as cosp_nradsteps, run cosp and reset counter - if (cosp_nradsteps .eq. cosp_cnt(lchnk)) then - !call should be compatible with camrt radiation.F90 interface too, should be with (in),optional - ! N.B.: For snow optical properties, the GRID-BOX MEAN shortwave and longwave optical depths are passed. - - call t_startf ('cosp_run') - call cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & - cld_tau(rrtmg_sw_cloudsim_band,:,:),& - snow_tau=gb_snow_tau,snow_emis=gb_snow_lw) - cosp_cnt(lchnk) = 0 !! reset counter - call t_stopf ('cosp_run') - - end if - end if - endif ! use_MMF - - if (use_MMF .and. MMF_microphysics_scheme .eq. 'm2005') then - call outfld('CRM_MU ', mu_crm , pcols, lchnk) - call outfld('CRM_DES ', des_crm , pcols, lchnk) - call outfld('CRM_LAMBDA', lambdac_crm, pcols, lchnk) - deallocate(des_crm, mu_crm, lambdac_crm) - endif - - if (use_MMF) then - call outfld('CRM_TAU ', cld_tau_crm, pcols, lchnk) - call outfld('CRM_EMS ', emis_crm, pcols, lchnk) - call outfld('CRM_DEI ', dei_crm, pcols, lchnk) - deallocate(dei_crm) - call outfld('CRM_REL ', rel_crm, pcols, lchnk) - call outfld('CRM_REI ', rei_crm, pcols, lchnk) - call outfld('CRM_QRL ', qrl_crm, pcols, lchnk) - call outfld('CRM_QRS ', qrs_crm, pcols, lchnk) - call outfld('CRM_QRLC ', qrlc_crm, pcols, lchnk) - call outfld('CRM_QRSC ', qrsc_crm, pcols, lchnk) - endif - - else ! if (dosw .or. dolw) then - - ! If conserve_energy is true, then heating rates are multiplied by dp at - ! the end of this routine to carry Q*dp across timesteps to conserve - ! energy. Thus, if this flag is set, we need to divide by dp here before - ! working with Q below because it was multiplied by dp in a previous - ! call. - if (conserve_energy) then - do k = 1,pver - do i = 1, ncol - qrs(i,k) = qrs(i,k)/state%pdel(i,k) - qrl(i,k) = qrl(i,k)/state%pdel(i,k) - end do - end do - if (use_MMF) then - do m = 1,crm_nz - k = pver - m + 1 - do i = 1,ncol - crm_qrad(i,:,:,m) = crm_qrad(i,:,:,m) / state%pdel(i,k) - end do - end do - end if - end if - - end if ! if (dosw .or. dolw) - - ! Compute net radiative heating tendency - call t_startf ('radheat_tend') - call radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, & - fsnt, flns, flnt, cam_in%asdir, net_flx) - call t_stopf ('radheat_tend') - - ! Compute heating rate for dtheta/dt - do k=1,pver - do i=1,ncol - ftem(i,k) = (qrs(i,k) + qrl(i,k)) / cpair * (1.e5_r8/state%pmid(i,k))**cappa - end do - end do - call outfld('HR', ftem, pcols, lchnk) - - ! convert radiative heating rates to Q*dp for energy conservation - if (conserve_energy) then - do k =1 , pver - do i = 1, ncol - qrs(i,k) = qrs(i,k)*state%pdel(i,k) - qrl(i,k) = qrl(i,k)*state%pdel(i,k) - end do - end do - if (use_MMF) then - do m = 1,crm_nz - k = pver - m + 1 - do i = 1,ncol - crm_qrad(i,:,:,m) = crm_qrad(i,:,:,m) * state%pdel(i,k) - end do - end do - call outfld('CRM_QRAD', crm_qrad(1:ncol,:,:,:), ncol, state%lchnk) - end if - end if - - ! write kissvec seeds for random numbers - if (pergro_mods) then - do iseed = 1, kiss_seed_num - do i = 1, ncol - rad_randn_seedrst(i,iseed,lchnk) = clm_seed(i,iseed) - enddo - enddo - endif - - ! Compute net surface radiative flux for use by surface temperature code. - ! Note that units have already been converted to mks in RADCTL. Since - ! fsns and flwds are in the buffer, array values will be carried across - ! timesteps when the radiation code is not invoked. - !cam_out%srfrad(:ncol) = fsns(:ncol) + cam_out%flwds(:ncol) - !call outfld('SRFRAD ',cam_out%srfrad,pcols,lchnk) - cam_out%netsw(:ncol) = fsns(:ncol) - - end subroutine radiation_tend - -!=============================================================================== - -subroutine radinp(ncol, pmid, pint, pmidrd, pintrd, eccf) -!----------------------------------------------------------------------- -! -! Purpose: -! Set latitude and time dependent arrays for input to solar -! and longwave radiation. -! Convert model pressures to cgs. -! -! Author: CCM1, CMS Contact J. Kiehl -!----------------------------------------------------------------------- - use shr_orb_mod - use time_manager, only: get_curr_calday - -!------------------------------Arguments-------------------------------- -! -! Input arguments -! - integer, intent(in) :: ncol ! number of atmospheric columns - - real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model mid-levels (pascals) - real(r8), intent(in) :: pint(pcols,pverp) ! Pressure at model interfaces (pascals) -! -! Output arguments -! - real(r8), intent(out) :: pmidrd(pcols,pver) ! Pressure at mid-levels (dynes/cm*2) - real(r8), intent(out) :: pintrd(pcols,pverp) ! Pressure at interfaces (dynes/cm*2) - real(r8), intent(out) :: eccf ! Earth-sun distance factor - -! -!---------------------------Local variables----------------------------- -! - integer i ! Longitude loop index - integer k ! Vertical loop index - - real(r8) :: calday ! current calendar day - real(r8) :: delta ! Solar declination angle -!----------------------------------------------------------------------- -! - calday = get_curr_calday() - call shr_orb_decl (calday ,eccen ,mvelpp ,lambm0 ,obliqr , & - delta ,eccf) - -! -! Convert pressure from pascals to dynes/cm2 -! - do k=1,pver - do i=1,ncol - pmidrd(i,k) = pmid(i,k)*10.0_r8 - pintrd(i,k) = pint(i,k)*10.0_r8 - end do - end do - do i=1,ncol - pintrd(i,pverp) = pint(i,pverp)*10.0_r8 - end do - -end subroutine radinp - -!=============================================================================== - -subroutine calc_col_mean(state, mmr_pointer, mean_value) -!----------------------------------------------------------------------- -! -! Compute the column mean mass mixing ratio. -! -!----------------------------------------------------------------------- - - use cam_logfile, only: iulog - - type(physics_state), intent(in) :: state - real(r8), dimension(:,:), pointer :: mmr_pointer ! mass mixing ratio (lev) - real(r8), dimension(pcols), intent(out) :: mean_value ! column mean mmr - - integer :: i, k, ncol - real(r8) :: ptot(pcols) - !----------------------------------------------------------------------- - - ncol = state%ncol - mean_value = 0.0_r8 - ptot = 0.0_r8 - - do k=1,pver - do i=1,ncol - mean_value(i) = mean_value(i) + mmr_pointer(i,k)*state%pdeldry(i,k) - ptot(i) = ptot(i) + state%pdeldry(i,k) - end do - end do - do i=1,ncol - mean_value(i) = mean_value(i) / ptot(i) - end do - -end subroutine calc_col_mean - -!=============================================================================== - -end module radiation - diff --git a/components/eam/src/physics/crm/rrtmg/rrtmg_state.F90 b/components/eam/src/physics/crm/rrtmg/rrtmg_state.F90 deleted file mode 100644 index cb4e4314a4de..000000000000 --- a/components/eam/src/physics/crm/rrtmg/rrtmg_state.F90 +++ /dev/null @@ -1,238 +0,0 @@ -!-------------------------------------------------------------------------------- -! Manages the absorber concentrations in the layers RRTMG operates -! including an extra layer over the model if needed. -! -! Creator: Francis Vitt -! 9 May 2011 -!-------------------------------------------------------------------------------- -module rrtmg_state - - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver, pverp - - implicit none - private - save - - public :: rrtmg_state_t - public :: rrtmg_state_init - public :: rrtmg_state_create - public :: rrtmg_state_update - public :: rrtmg_state_destroy - public :: num_rrtmg_levs - - type rrtmg_state_t - - real(r8), allocatable :: h2ovmr(:,:) ! h2o volume mixing ratio - real(r8), allocatable :: o3vmr(:,:) ! o3 volume mixing ratio - real(r8), allocatable :: co2vmr(:,:) ! co2 volume mixing ratio - real(r8), allocatable :: ch4vmr(:,:) ! ch4 volume mixing ratio - real(r8), allocatable :: o2vmr(:,:) ! o2 volume mixing ratio - real(r8), allocatable :: n2ovmr(:,:) ! n2o volume mixing ratio - real(r8), allocatable :: cfc11vmr(:,:) ! cfc11 volume mixing ratio - real(r8), allocatable :: cfc12vmr(:,:) ! cfc12 volume mixing ratio - real(r8), allocatable :: cfc22vmr(:,:) ! cfc22 volume mixing ratio - real(r8), allocatable :: ccl4vmr(:,:) ! ccl4 volume mixing ratio - - real(r8), allocatable :: pmidmb(:,:) ! Level pressure (hPa) - real(r8), allocatable :: pintmb(:,:) ! Model interface pressure (hPa) - real(r8), allocatable :: tlay(:,:) ! mid point temperature - real(r8), allocatable :: tlev(:,:) ! interface temperature - - end type rrtmg_state_t - - integer :: num_rrtmg_levs ! number of pressure levels greate than 1.e-4_r8 mbar - - real(r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor - real(r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide - real(r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone - real(r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane - real(r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide - real(r8), parameter :: amdo2 = 0.905140_r8 ! Molecular weight of dry air / oxygen - real(r8), parameter :: amdc1 = 0.210852_r8 ! Molecular weight of dry air / CFC11 - real(r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12 - -contains - -!-------------------------------------------------------------------------------- -! sets the number of model levels RRTMG operates -!-------------------------------------------------------------------------------- - subroutine rrtmg_state_init - - use ref_pres,only : pref_edge - implicit none - - ! The following cuts off RRTMG at roughly the point where it becomes - ! invalid due to low pressure. - num_rrtmg_levs = count( pref_edge(:) > 1._r8 ) ! pascals (1.e-2 mbar) - - end subroutine rrtmg_state_init - -!-------------------------------------------------------------------------------- -! creates (alloacates) an rrtmg_state object -!-------------------------------------------------------------------------------- - - function rrtmg_state_create( pstate, cam_in ) result( rstate ) - use physics_types, only: physics_state - use camsrfexch, only: cam_in_t - use physconst, only: stebol - implicit none - - type(physics_state), intent(in) :: pstate - type(cam_in_t), intent(in) :: cam_in - - type(rrtmg_state_t), pointer :: rstate - - real(r8) dy ! Temporary layer pressure thickness - real(r8) :: tint(pcols,pverp) ! Model interface temperature - integer :: ncol, i, kk, k - allocate( rstate ) - - allocate( rstate%h2ovmr(pcols,num_rrtmg_levs) ) - allocate( rstate%o3vmr(pcols,num_rrtmg_levs) ) - allocate( rstate%co2vmr(pcols,num_rrtmg_levs) ) - allocate( rstate%ch4vmr(pcols,num_rrtmg_levs) ) - allocate( rstate%o2vmr(pcols,num_rrtmg_levs) ) - allocate( rstate%n2ovmr(pcols,num_rrtmg_levs) ) - allocate( rstate%cfc11vmr(pcols,num_rrtmg_levs) ) - allocate( rstate%cfc12vmr(pcols,num_rrtmg_levs) ) - allocate( rstate%cfc22vmr(pcols,num_rrtmg_levs) ) - allocate( rstate%ccl4vmr(pcols,num_rrtmg_levs) ) - - allocate( rstate%pmidmb(pcols,num_rrtmg_levs) ) - allocate( rstate%pintmb(pcols,num_rrtmg_levs+1) ) - allocate( rstate%tlay(pcols,num_rrtmg_levs) ) - allocate( rstate%tlev(pcols,num_rrtmg_levs+1) ) - - ncol = pstate%ncol - - ! Calculate interface temperatures (following method - ! used in radtpl for the longwave), using surface upward flux and - ! stebol constant in mks units - do i = 1,ncol - tint(i,1) = pstate%t(i,1) - tint(i,pverp) = sqrt(sqrt(cam_in%lwup(i)/stebol)) - do k = 2,pver - dy = (pstate%lnpint(i,k) - pstate%lnpmid(i,k)) / (pstate%lnpmid(i,k-1) - pstate%lnpmid(i,k)) - tint(i,k) = pstate%t(i,k) - dy * (pstate%t(i,k) - pstate%t(i,k-1)) - end do - end do - - do k = 1, num_rrtmg_levs - - kk = max(k + (pverp-num_rrtmg_levs)-1,1) - - rstate%pmidmb(:ncol,k) = pstate%pmid(:ncol,kk) * 1.e-2_r8 - rstate%pintmb(:ncol,k) = pstate%pint(:ncol,kk) * 1.e-2_r8 - - rstate%tlay(:ncol,k) = pstate%t(:ncol,kk) - rstate%tlev(:ncol,k) = tint(:ncol,kk) - - enddo - - ! bottom interface - rstate%pintmb(:ncol,num_rrtmg_levs+1) = pstate%pint(:ncol,pverp) * 1.e-2_r8 ! mbar - rstate%tlev(:ncol,num_rrtmg_levs+1) = tint(:ncol,pverp) - - ! top layer thickness - if (num_rrtmg_levs==pverp) then - rstate%pmidmb(:ncol,1) = 0.5_r8 * rstate%pintmb(:ncol,2) - rstate%pintmb(:ncol,1) = 1.e-4_r8 ! mbar - endif - - endfunction rrtmg_state_create - -!-------------------------------------------------------------------------------- -! updates the concentration fields -!-------------------------------------------------------------------------------- - subroutine rrtmg_state_update(pstate,pbuf,icall,rstate) - use physics_types, only: physics_state - use physics_buffer, only: physics_buffer_desc - use rad_constituents, only: rad_cnst_get_gas - - implicit none - - type(physics_state), intent(in), target :: pstate - type(physics_buffer_desc), pointer :: pbuf(:) - integer, intent(in) :: icall ! index through climate/diagnostic radiation calls - type(rrtmg_state_t), pointer :: rstate - - real(r8), pointer, dimension(:,:) :: sp_hum ! specific humidity - real(r8), pointer, dimension(:,:) :: n2o ! nitrous oxide mass mixing ratio - real(r8), pointer, dimension(:,:) :: ch4 ! methane mass mixing ratio - real(r8), pointer, dimension(:,:) :: o2 ! O2 mass mixing ratio - real(r8), pointer, dimension(:,:) :: cfc11 ! cfc11 mass mixing ratio - real(r8), pointer, dimension(:,:) :: cfc12 ! cfc12 mass mixing ratio - real(r8), pointer, dimension(:,:) :: o3 ! Ozone mass mixing ratio - real(r8), pointer, dimension(:,:) :: co2 ! co2 mass mixing ratio - - integer :: ncol, i, kk, k - - ncol = pstate%ncol - - ! Get specific humidity - call rad_cnst_get_gas(icall,'H2O', pstate, pbuf, sp_hum) - ! Get oxygen mass mixing ratio. - call rad_cnst_get_gas(icall,'O2', pstate, pbuf, o2) - ! Get ozone mass mixing ratio. - call rad_cnst_get_gas(icall,'O3', pstate, pbuf, o3) - ! Get CO2 mass mixing ratio - call rad_cnst_get_gas(icall,'CO2', pstate, pbuf, co2) - ! Get N2O mass mixing ratio - call rad_cnst_get_gas(icall,'N2O', pstate, pbuf, n2o) - ! Get CH4 mass mixing ratio - call rad_cnst_get_gas(icall,'CH4', pstate, pbuf, ch4) - ! Get CFC mass mixing ratios - call rad_cnst_get_gas(icall,'CFC11', pstate, pbuf, cfc11) - call rad_cnst_get_gas(icall,'CFC12', pstate, pbuf, cfc12) - - do k = 1, num_rrtmg_levs - - kk = max(k + (pverp-num_rrtmg_levs)-1,1) - - rstate%ch4vmr(:ncol,k) = ch4(:ncol,kk) * amdm - rstate%h2ovmr(:ncol,k) = (sp_hum(:ncol,kk) / (1._r8 - sp_hum(:ncol,kk))) * amdw - rstate%o3vmr(:ncol,k) = o3(:ncol,kk) * amdo - rstate%co2vmr(:ncol,k) = co2(:ncol,kk) * amdc - rstate%ch4vmr(:ncol,k) = ch4(:ncol,kk) * amdm - rstate%o2vmr(:ncol,k) = o2(:ncol,kk) * amdo2 - rstate%n2ovmr(:ncol,k) = n2o(:ncol,kk) * amdn - rstate%cfc11vmr(:ncol,k) = cfc11(:ncol,kk) * amdc1 - rstate%cfc12vmr(:ncol,k) = cfc12(:ncol,kk) * amdc2 - rstate%cfc22vmr(:ncol,k) = 0._r8 - rstate%ccl4vmr(:ncol,k) = 0._r8 - - enddo - - end subroutine rrtmg_state_update - -!-------------------------------------------------------------------------------- -! de-allocates an rrtmg_state object -!-------------------------------------------------------------------------------- - subroutine rrtmg_state_destroy(rstate) - - implicit none - - type(rrtmg_state_t), pointer :: rstate - - deallocate(rstate%h2ovmr) - deallocate(rstate%o3vmr) - deallocate(rstate%co2vmr) - deallocate(rstate%ch4vmr) - deallocate(rstate%o2vmr) - deallocate(rstate%n2ovmr) - deallocate(rstate%cfc11vmr) - deallocate(rstate%cfc12vmr) - deallocate(rstate%cfc22vmr) - deallocate(rstate%ccl4vmr) - - deallocate(rstate%pmidmb) - deallocate(rstate%pintmb) - deallocate(rstate%tlay) - deallocate(rstate%tlev) - - nullify(rstate) - - endsubroutine rrtmg_state_destroy - -end module rrtmg_state diff --git a/components/eam/src/physics/crm/samxx/cpp_interface_mod.F90 b/components/eam/src/physics/crm/samxx/cpp_interface_mod.F90 index 0d2b3a48830d..eba9ce81656b 100644 --- a/components/eam/src/physics/crm/samxx/cpp_interface_mod.F90 +++ b/components/eam/src/physics/crm/samxx/cpp_interface_mod.F90 @@ -15,7 +15,7 @@ subroutine crm(ncrms_in, pcols_in, dt_gl, plev, crm_input_bflxls, crm_input_wndl crm_input_ul_esmt, crm_input_vl_esmt, & crm_input_t_vt, crm_input_q_vt, crm_input_u_vt, & crm_state_u_wind, crm_state_v_wind, crm_state_w_wind, crm_state_temperature, & - crm_state_qt, crm_state_qp, crm_state_qn, crm_rad_qrad, crm_rad_temperature, & + crm_state_qv, crm_state_qp, crm_state_qn, crm_rad_qrad, crm_rad_temperature, & crm_rad_qv, crm_rad_qc, crm_rad_qi, crm_rad_cld, crm_output_subcycle_factor, & crm_output_prectend, crm_output_precstend, crm_output_cld, crm_output_cldtop, & crm_output_gicewp, crm_output_gliqwp, crm_output_mctot, crm_output_mcup, crm_output_mcdn, & @@ -53,7 +53,7 @@ subroutine crm(ncrms_in, pcols_in, dt_gl, plev, crm_input_bflxls, crm_input_wndl crm_input_ul_esmt, crm_input_vl_esmt, & crm_input_t_vt, crm_input_q_vt, & crm_state_u_wind, crm_state_v_wind, crm_state_w_wind, crm_state_temperature, & - crm_state_qt, crm_state_qp, crm_state_qn, crm_rad_qrad, crm_rad_temperature, & + crm_state_qv, crm_state_qp, crm_state_qn, crm_rad_qrad, crm_rad_temperature, & crm_rad_qv, crm_rad_qc, crm_rad_qi, crm_rad_cld, crm_output_subcycle_factor, & crm_output_prectend, crm_output_precstend, crm_output_cld, crm_output_cldtop, & crm_output_gicewp, crm_output_gliqwp, crm_output_mctot, crm_output_mcup, crm_output_mcdn, & diff --git a/components/eam/src/physics/crm/samxx/crm.cpp b/components/eam/src/physics/crm/samxx/crm.cpp index b557b16695d7..29447a4681e3 100644 --- a/components/eam/src/physics/crm/samxx/crm.cpp +++ b/components/eam/src/physics/crm/samxx/crm.cpp @@ -15,7 +15,7 @@ extern "C" void crm(int ncrms_in, int pcols_in, real dt_gl, int plev, real *crm_ real *crm_input_t_vt_p, real *crm_input_q_vt_p, real *crm_input_u_vt_p, real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_state_w_wind_p, real *crm_state_temperature_p, - real *crm_state_qt_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_qrad_p, + real *crm_state_qv_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_qrad_p, real *crm_rad_temperature_p, real *crm_rad_qv_p, real *crm_rad_qc_p, real *crm_rad_qi_p, real *crm_rad_cld_p, real *crm_output_subcycle_factor_p, @@ -67,12 +67,12 @@ extern "C" void crm(int ncrms_in, int pcols_in, real dt_gl, int plev, real *crm_ crm_input_ul_esmt_p, crm_input_vl_esmt_p, crm_input_t_vt_p, crm_input_q_vt_p, crm_input_u_vt_p, crm_state_u_wind_p, crm_state_v_wind_p, crm_state_w_wind_p, crm_state_temperature_p, - crm_state_qt_p, crm_state_qp_p, crm_state_qn_p, crm_rad_qrad_p, crm_output_subcycle_factor_p, + crm_state_qv_p, crm_state_qp_p, crm_state_qn_p, crm_rad_qrad_p, crm_output_subcycle_factor_p, lat0_p, long0_p, gcolp_p, crm_output_cltot_p, crm_output_clhgh_p, crm_output_clmed_p, crm_output_cllow_p); copy_outputs(crm_state_u_wind_p, crm_state_v_wind_p, crm_state_w_wind_p, crm_state_temperature_p, - crm_state_qt_p, crm_state_qp_p, crm_state_qn_p, crm_rad_temperature_p, + crm_state_qv_p, crm_state_qp_p, crm_state_qn_p, crm_rad_temperature_p, crm_rad_qv_p, crm_rad_qc_p, crm_rad_qi_p, crm_rad_cld_p, crm_output_subcycle_factor_p, crm_output_prectend_p, crm_output_precstend_p, crm_output_cld_p, crm_output_cldtop_p, crm_output_gicewp_p, crm_output_gliqwp_p, @@ -110,7 +110,7 @@ extern "C" void crm(int ncrms_in, int pcols_in, real dt_gl, int plev, real *crm_ post_timeloop(); copy_outputs_and_destroy(crm_state_u_wind_p, crm_state_v_wind_p, crm_state_w_wind_p, crm_state_temperature_p, - crm_state_qt_p, crm_state_qp_p, crm_state_qn_p, crm_rad_temperature_p, + crm_state_qv_p, crm_state_qp_p, crm_state_qn_p, crm_rad_temperature_p, crm_rad_qv_p, crm_rad_qc_p, crm_rad_qi_p, crm_rad_cld_p, crm_output_subcycle_factor_p, crm_output_prectend_p, crm_output_precstend_p, crm_output_cld_p, crm_output_cldtop_p, crm_output_gicewp_p, crm_output_gliqwp_p, diff --git a/components/eam/src/physics/crm/samxx/post_timeloop.cpp b/components/eam/src/physics/crm/samxx/post_timeloop.cpp index 14d849b10510..1f1ad7f6c198 100644 --- a/components/eam/src/physics/crm/samxx/post_timeloop.cpp +++ b/components/eam/src/physics/crm/samxx/post_timeloop.cpp @@ -53,7 +53,7 @@ void post_timeloop() { YAKL_SCOPE( crm_state_v_wind , :: crm_state_v_wind ); YAKL_SCOPE( crm_state_w_wind , :: crm_state_w_wind ); YAKL_SCOPE( crm_state_temperature , :: crm_state_temperature ); - YAKL_SCOPE( crm_state_qt , :: crm_state_qt ); + YAKL_SCOPE( crm_state_qv , :: crm_state_qv ); YAKL_SCOPE( crm_state_qp , :: crm_state_qp ); YAKL_SCOPE( crm_state_qn , :: crm_state_qn ); YAKL_SCOPE( micro_field , :: micro_field ); @@ -359,7 +359,7 @@ void post_timeloop() { crm_state_v_wind(k,j,i,icrm) = v(k,j+offy_v,i+offx_v,icrm); crm_state_w_wind(k,j,i,icrm) = w(k,j+offy_w,i+offx_w,icrm); crm_state_temperature(k,j,i,icrm) = tabs(k,j,i,icrm); - crm_state_qt(k,j,i,icrm) = micro_field(0,k,j+offy_s,i+offx_s,icrm); + crm_state_qv(k,j,i,icrm) = micro_field(0,k,j+offy_s,i+offx_s,icrm) - qn(k,j,i,icrm); crm_state_qp(k,j,i,icrm) = micro_field(1,k,j+offy_s,i+offx_s,icrm); crm_state_qn(k,j,i,icrm) = qn(k,j,i,icrm); crm_output_tk(k,j,i,icrm) = sgs_field_diag(0,k,j+offy_d,i+offx_d,icrm); diff --git a/components/eam/src/physics/crm/samxx/pre_timeloop.cpp b/components/eam/src/physics/crm/samxx/pre_timeloop.cpp index 8f137d71d38d..2ad051a1d335 100644 --- a/components/eam/src/physics/crm/samxx/pre_timeloop.cpp +++ b/components/eam/src/physics/crm/samxx/pre_timeloop.cpp @@ -50,7 +50,7 @@ void pre_timeloop() { YAKL_SCOPE( crm_state_w_wind , :: crm_state_w_wind ); YAKL_SCOPE( crm_state_temperature , :: crm_state_temperature ); YAKL_SCOPE( micro_field , :: micro_field ); - YAKL_SCOPE( crm_state_qt , :: crm_state_qt ); + YAKL_SCOPE( crm_state_qv , :: crm_state_qv ); YAKL_SCOPE( crm_state_qp , :: crm_state_qp ); YAKL_SCOPE( crm_state_qn , :: crm_state_qn ); YAKL_SCOPE( qn , :: qn ); @@ -316,7 +316,7 @@ void pre_timeloop() { // for (int i=0; i(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { - micro_field(0,k,j+offy_s,i+offx_s,icrm) = crm_state_qt(k,j,i,icrm); + micro_field(0,k,j+offy_s,i+offx_s,icrm) = crm_state_qv(k,j,i,icrm)+crm_state_qn(k,j,i,icrm); micro_field(1,k,j+offy_s,i+offx_s,icrm) = crm_state_qp(k,j,i,icrm); qn(k,j,i,icrm) = crm_state_qn(k,j,i,icrm); }); diff --git a/components/eam/src/physics/crm/samxx/vars.cpp b/components/eam/src/physics/crm/samxx/vars.cpp index e89fc3f6eacf..91f85177012f 100644 --- a/components/eam/src/physics/crm/samxx/vars.cpp +++ b/components/eam/src/physics/crm/samxx/vars.cpp @@ -685,7 +685,7 @@ void create_and_copy_inputs(real *crm_input_bflxls_p, real *crm_input_wndls_p, r real *crm_input_ul_esmt_p, real *crm_input_vl_esmt_p, real *crm_input_t_vt_p, real *crm_input_q_vt_p, real *crm_input_u_vt_p, real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_state_w_wind_p, real *crm_state_temperature_p, - real *crm_state_qt_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_qrad_p, real *crm_output_subcycle_factor_p, + real *crm_state_qv_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_qrad_p, real *crm_output_subcycle_factor_p, real *lat0_p, real *long0_p, int *gcolp_p, real *crm_output_cltot_p, real *crm_output_clhgh_p, real *crm_output_clmed_p, real *crm_output_cllow_p) { @@ -713,7 +713,7 @@ void create_and_copy_inputs(real *crm_input_bflxls_p, real *crm_input_wndls_p, r realHost4d crm_state_v_wind = realHost4d( "crm_state_v_wind ",crm_state_v_wind_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_w_wind = realHost4d( "crm_state_w_wind ",crm_state_w_wind_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_temperature = realHost4d( "crm_state_temperature ",crm_state_temperature_p , crm_nz, crm_ny , crm_nx , pcols); - realHost4d crm_state_qt = realHost4d( "crm_state_qt ",crm_state_qt_p , crm_nz, crm_ny , crm_nx , pcols); + realHost4d crm_state_qv = realHost4d( "crm_state_qv ",crm_state_qv_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_qp = realHost4d( "crm_state_qp ",crm_state_qp_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_qn = realHost4d( "crm_state_qn ",crm_state_qn_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_rad_qrad = realHost4d( "crm_rad_qrad ",crm_rad_qrad_p , crm_nz, crm_ny_rad, crm_nx_rad, pcols); @@ -750,7 +750,7 @@ void create_and_copy_inputs(real *crm_input_bflxls_p, real *crm_input_wndls_p, r ::crm_state_v_wind = real4d( "crm_state_v_wind ", crm_nz, crm_ny , crm_nx , pcols); ::crm_state_w_wind = real4d( "crm_state_w_wind ", crm_nz, crm_ny , crm_nx , pcols); ::crm_state_temperature = real4d( "crm_state_temperature ", crm_nz, crm_ny , crm_nx , pcols); - ::crm_state_qt = real4d( "crm_state_qt ", crm_nz, crm_ny , crm_nx , pcols); + ::crm_state_qv = real4d( "crm_state_qv ", crm_nz, crm_ny , crm_nx , pcols); ::crm_state_qp = real4d( "crm_state_qp ", crm_nz, crm_ny , crm_nx , pcols); ::crm_state_qn = real4d( "crm_state_qn ", crm_nz, crm_ny , crm_nx , pcols); ::crm_rad_qrad = real4d( "crm_rad_qrad ", crm_nz, crm_ny_rad, crm_nx_rad, pcols); @@ -861,7 +861,7 @@ void create_and_copy_inputs(real *crm_input_bflxls_p, real *crm_input_wndls_p, r crm_state_v_wind .deep_copy_to(::crm_state_v_wind ); crm_state_w_wind .deep_copy_to(::crm_state_w_wind ); crm_state_temperature .deep_copy_to(::crm_state_temperature ); - crm_state_qt .deep_copy_to(::crm_state_qt ); + crm_state_qv .deep_copy_to(::crm_state_qv ); crm_state_qp .deep_copy_to(::crm_state_qp ); crm_state_qn .deep_copy_to(::crm_state_qn ); crm_rad_qrad .deep_copy_to(::crm_rad_qrad ); @@ -878,7 +878,7 @@ void create_and_copy_inputs(real *crm_input_bflxls_p, real *crm_input_wndls_p, r void copy_outputs(real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_state_w_wind_p, real *crm_state_temperature_p, - real *crm_state_qt_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_temperature_p, + real *crm_state_qv_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_temperature_p, real *crm_rad_qv_p, real *crm_rad_qc_p, real *crm_rad_qi_p, real *crm_rad_cld_p, real *crm_output_subcycle_factor_p, real *crm_output_prectend_p, real *crm_output_precstend_p, real *crm_output_cld_p, real *crm_output_cldtop_p, real *crm_output_gicewp_p, real *crm_output_gliqwp_p, real *crm_output_mctot_p, real *crm_output_mcup_p, real *crm_output_mcdn_p, @@ -902,7 +902,7 @@ void copy_outputs(real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_ realHost4d crm_state_v_wind = realHost4d( "crm_state_v_wind ",crm_state_v_wind_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_w_wind = realHost4d( "crm_state_w_wind ",crm_state_w_wind_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_temperature = realHost4d( "crm_state_temperature ",crm_state_temperature_p , crm_nz, crm_ny , crm_nx , pcols); - realHost4d crm_state_qt = realHost4d( "crm_state_qt ",crm_state_qt_p , crm_nz, crm_ny , crm_nx , pcols); + realHost4d crm_state_qv = realHost4d( "crm_state_qv ",crm_state_qv_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_qp = realHost4d( "crm_state_qp ",crm_state_qp_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_qn = realHost4d( "crm_state_qn ",crm_state_qn_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_rad_temperature = realHost4d( "crm_rad_temperature ",crm_rad_temperature_p , crm_nz, crm_ny_rad, crm_nx_rad, pcols); @@ -987,7 +987,7 @@ void copy_outputs(real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_ crm_state_v_wind .deep_copy_to( ::crm_state_v_wind ); crm_state_w_wind .deep_copy_to( ::crm_state_w_wind ); crm_state_temperature .deep_copy_to( ::crm_state_temperature ); - crm_state_qt .deep_copy_to( ::crm_state_qt ); + crm_state_qv .deep_copy_to( ::crm_state_qv ); crm_state_qp .deep_copy_to( ::crm_state_qp ); crm_state_qn .deep_copy_to( ::crm_state_qn ); crm_rad_temperature .deep_copy_to( ::crm_rad_temperature ); @@ -1072,7 +1072,7 @@ void copy_outputs(real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_ void copy_outputs_and_destroy(real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_state_w_wind_p, real *crm_state_temperature_p, - real *crm_state_qt_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_temperature_p, + real *crm_state_qv_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_temperature_p, real *crm_rad_qv_p, real *crm_rad_qc_p, real *crm_rad_qi_p, real *crm_rad_cld_p, real *crm_output_subcycle_factor_p, real *crm_output_prectend_p, real *crm_output_precstend_p, real *crm_output_cld_p, real *crm_output_cldtop_p, real *crm_output_gicewp_p, real *crm_output_gliqwp_p, real *crm_output_mctot_p, real *crm_output_mcup_p, real *crm_output_mcdn_p, @@ -1097,7 +1097,7 @@ void copy_outputs_and_destroy(real *crm_state_u_wind_p, real *crm_state_v_wind_p realHost4d crm_state_v_wind = realHost4d( "crm_state_v_wind ",crm_state_v_wind_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_w_wind = realHost4d( "crm_state_w_wind ",crm_state_w_wind_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_temperature = realHost4d( "crm_state_temperature ",crm_state_temperature_p , crm_nz, crm_ny , crm_nx , pcols); - realHost4d crm_state_qt = realHost4d( "crm_state_qt ",crm_state_qt_p , crm_nz, crm_ny , crm_nx , pcols); + realHost4d crm_state_qv = realHost4d( "crm_state_qv ",crm_state_qv_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_qp = realHost4d( "crm_state_qp ",crm_state_qp_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_state_qn = realHost4d( "crm_state_qn ",crm_state_qn_p , crm_nz, crm_ny , crm_nx , pcols); realHost4d crm_rad_temperature = realHost4d( "crm_rad_temperature ",crm_rad_temperature_p , crm_nz, crm_ny_rad, crm_nx_rad, pcols); @@ -1183,7 +1183,7 @@ void copy_outputs_and_destroy(real *crm_state_u_wind_p, real *crm_state_v_wind_p ::crm_state_v_wind .deep_copy_to(crm_state_v_wind ); ::crm_state_w_wind .deep_copy_to(crm_state_w_wind ); ::crm_state_temperature .deep_copy_to(crm_state_temperature ); - ::crm_state_qt .deep_copy_to(crm_state_qt ); + ::crm_state_qv .deep_copy_to(crm_state_qv ); ::crm_state_qp .deep_copy_to(crm_state_qp ); ::crm_state_qn .deep_copy_to(crm_state_qn ); ::crm_rad_temperature .deep_copy_to(crm_rad_temperature ); @@ -1288,7 +1288,7 @@ void copy_outputs_and_destroy(real *crm_state_u_wind_p, real *crm_state_v_wind_p ::crm_state_v_wind = real4d(); ::crm_state_w_wind = real4d(); ::crm_state_temperature = real4d(); - ::crm_state_qt = real4d(); + ::crm_state_qv = real4d(); ::crm_state_qp = real4d(); ::crm_state_qn = real4d(); ::crm_rad_qrad = real4d(); @@ -1742,7 +1742,7 @@ real4d crm_state_u_wind; real4d crm_state_v_wind; real4d crm_state_w_wind; real4d crm_state_temperature; -real4d crm_state_qt; +real4d crm_state_qv; real4d crm_state_qp; real4d crm_state_qn; real4d crm_rad_qrad; diff --git a/components/eam/src/physics/crm/samxx/vars.h b/components/eam/src/physics/crm/samxx/vars.h index d7b289db32dc..a47f6e772c26 100644 --- a/components/eam/src/physics/crm/samxx/vars.h +++ b/components/eam/src/physics/crm/samxx/vars.h @@ -60,14 +60,14 @@ void create_and_copy_inputs(real *crm_input_bflxls_p, real *crm_input_wndls_p, r real *crm_input_ul_esmt_p, real *crm_input_vl_esmt_p, real *crm_input_t_vt_p, real *crm_input_q_vt_p, real *crm_input_u_vt_p, real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_state_w_wind_p, real *crm_state_temperature_p, - real *crm_state_qt_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_qrad_p, real *crm_output_subcycle_factor_p, + real *crm_state_qv_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_qrad_p, real *crm_output_subcycle_factor_p, real *lat0_p, real *long0_p, int *gcolp_p, real *crm_output_cltot_p, real *crm_output_clhgh_p, real *crm_output_clmed_p, real *crm_output_cllow_p); void copy_outputs(real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_state_w_wind_p, real *crm_state_temperature_p, - real *crm_state_qt_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_temperature_p, + real *crm_state_qv_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_temperature_p, real *crm_rad_qv_p, real *crm_rad_qc_p, real *crm_rad_qi_p, real *crm_rad_cld_p, real *crm_output_subcycle_factor_p, real *crm_output_prectend_p, real *crm_output_precstend_p, real *crm_output_cld_p, real *crm_output_cldtop_p, real *crm_output_gicewp_p, real *crm_output_gliqwp_p, real *crm_output_mctot_p, real *crm_output_mcup_p, real *crm_output_mcdn_p, @@ -90,7 +90,7 @@ void copy_outputs(real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_ void copy_outputs_and_destroy(real *crm_state_u_wind_p, real *crm_state_v_wind_p, real *crm_state_w_wind_p, real *crm_state_temperature_p, - real *crm_state_qt_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_temperature_p, + real *crm_state_qv_p, real *crm_state_qp_p, real *crm_state_qn_p, real *crm_rad_temperature_p, real *crm_rad_qv_p, real *crm_rad_qc_p, real *crm_rad_qi_p, real *crm_rad_cld_p, real *crm_output_subcycle_factor_p, real *crm_output_prectend_p, real *crm_output_precstend_p, real *crm_output_cld_p, real *crm_output_cldtop_p, real *crm_output_gicewp_p, real *crm_output_gliqwp_p, real *crm_output_mctot_p, real *crm_output_mcup_p, real *crm_output_mcdn_p, @@ -449,7 +449,7 @@ extern real4d crm_state_u_wind; extern real4d crm_state_v_wind; extern real4d crm_state_w_wind; extern real4d crm_state_temperature; -extern real4d crm_state_qt; +extern real4d crm_state_qv; extern real4d crm_state_qp; extern real4d crm_state_qn; extern real4d crm_rad_qrad; diff --git a/components/eam/tools/mkatmsrffile/test_mkatmsrffile.sh b/components/eam/tools/mkatmsrffile/test_mkatmsrffile.sh new file mode 100755 index 000000000000..a2b718103a69 --- /dev/null +++ b/components/eam/tools/mkatmsrffile/test_mkatmsrffile.sh @@ -0,0 +1,157 @@ +#!/bin/bash + +display_help() { + echo "Usage: $0 " >&2 + echo + echo " -e, --e3sm_root Specify location of E3SM" + echo " -h, --help Display this message" + echo " -i, --inputdata_root Specify location of climate inputdata" + echo " -r, --reference_files Specify location where files" + + echo " 1x1d.nc, ne30np4_pentagons.091226.nc," + echo " map_1x1_to_ne30np4_aave.nc" + echo " are located" + echo + echo "NOTE: requires tempestremap and ESMF tools to be in PATH environment variable" +} + +e3sm_root="default" +test_root="default" +inputdata_root="default" +reference_files="default" + +for arg in "$@" +do +case $arg in + -e=*|--e3sm_root=*) + e3sm_root="${arg#*=}" + shift + ;; + + -i=*|--inputdata_root=*) + inputdata_root="${arg#*=}" + shift + ;; + + -r=*|--reference_files=*) + reference_files="${arg#*=}" + shift + ;; + + -*) + display_help + exit 1; + ;; + + -h|--help) + display_help + exit 0; + ;; + +esac +done + +if [[ ${e3sm_root} == "default" ]]; then + echo "Error: e3sm_root not set" >&2 + display_help + exit 1; +fi + +if [[ ${inputdata_root} == "default" ]]; then + echo "Error: inputdata_root not set" >&2 + display_help + exit 1; +fi + +if [[ ${reference_files} == "default" ]]; then + echo "Error: reference_files not set" >&2 + display_help + exit 1; +fi + +output_root=$PWD +cime_root=${e3sm_root}/cime + +# Add testing bin to path +PATH=${test_root}/bin:${PATH} + +# We will redirect verbose test log output to a file; remove any existing +# versions of this file first +test_log=${PWD}/test.out +rm -f ${test_log} + + +srf_file=${reference_files}/1x1d.nc +atm_file=${reference_files}/ne30np4_pentagons.091226.nc +land_file=${inputdata_root}/atm/cam/chem/trop_mozart/dvel/regrid_vegetation.nc +soilw_file=${inputdata_root}/atm/cam/chem/trop_mozart/dvel/clim_soilw.nc +srf2atm_file=${reference_files}/map_1x1_to_ne30np4_aave.nc + +for i in ${srf_file} ${atm_file} ${land_file} ${soilw_file} ${srf2atm_file} +do + if [ ! -f $i ]; then + echo "Error: file ${i} not found" >&2 + exit 1 + fi +done + +output_file=${PWD}/atmsrf_ne30np4.nc + +echo "build mkatmsrrfile in ${PWD}/builds ..." >> ${test_log} +mkdir -p builds +cd builds +${cime_root}/CIME/scripts/configure --mpilib mpich --macros-format Makefile >> ${test_log} 2>&1 + +if [ ! -f .env_mach_specific.sh ]; then + if [ ! -f .env_mach_specific.sh ]; then + echo "ERROR running ${cime_root}/CIME/scripts/configure" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 + fi +fi +cp ${e3sm_root}/components/eam/tools/mkatmsrffile/* . + +# Edit Makefile to use variables created by configure +sed "s:^FFLAGS:#FFLAGS:g" Makefile | sed "s:^INC:#INC^:g" | sed "s:^LIB:#LIB:g" > Makefile.tmp +echo "include Macros.make" > Makefile +echo 'FC=${MPIFC}' >> Makefile +echo 'LIB=${SLIBS}' >> Makefile +echo 'FFLAGS+=-I${NETCDF_PATH}/include' >> Makefile +cat Makefile.tmp >> Makefile + +cat < nml_atmsrf +&input +srfFileName = '${srf_file}' +atmFileName = '${atm_file}' +landFileName = '${land_file}' +soilwFileName = '${soilw_file}' +srf2atmFmapname = '${srf2atm_file}' +outputFileName = '${output_file}' +/ + +EOF + + + +# + +(. .env_mach_specific.sh && export FC=gfortran && export LIB_NETCDF=${NETCDF_FORTRAN_PATH}/lib && export INC_NETCDF=${NETCDF_FORTRAN_PATH/include} && make) >> ${test_log} 2>&1 +if [ ! -f mkatmsrffile ]; then + echo "ERROR building mkatmsrffile" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +rm -f ${output_file} +echo "Running mkatmsrffile" >> ${test_log} 2>&1 +(. .env_mach_specific.sh && ./mkatmsrffile ) >> ${test_log} + +if [ ! -f ${output_file} ]; then + echo "Error: file ${i} not found" >&2 + exit 1 +else + echo "output file ${i} created" >> ${test_log} 2>&1 +fi + + +exit 0 diff --git a/components/eam/tools/topo_tool/cube_to_target/test_cube_to_target.sh b/components/eam/tools/topo_tool/cube_to_target/test_cube_to_target.sh new file mode 100755 index 000000000000..7122fed5fe1c --- /dev/null +++ b/components/eam/tools/topo_tool/cube_to_target/test_cube_to_target.sh @@ -0,0 +1,161 @@ +#!/bin/bash + +display_help() { + echo "Usage: $0 " >&2 + echo + echo " -e, --e3sm_root Specify location of E3SM" + echo " -h, --help Display this message" + echo " -i, --inputdata_root Specify location of climate inputdata" + echo +} + + +# get arguments +# Need --e3sm_root= +# --reference_files= +# --inputdata_root= + +e3sm_root="default" +test_root="default" +inputdata_root="default" + +for arg in "$@" +do +case $arg in + -e=*|--e3sm_root=*) + e3sm_root="${arg#*=}" + shift + ;; + + -i=*|--inputdata_root=*) + inputdata_root="${arg#*=}" + shift + ;; + + -*) + display_help + exit 1; + ;; + + -h|--help) + display_help + exit 0; + ;; + +esac +done + +if [[ ${e3sm_root} == "default" ]]; then + echo "Error: e3sm_root not set" >&2 + display_help + exit 1; +fi + +if [[ ${inputdata_root} == "default" ]]; then + echo "Error: inputdata_root not set" >&2 + display_help + exit 1; +fi + +output_root=$PWD +cime_root=${e3sm_root}/cime + +# Add testing bin to path +PATH=${test_root}/bin:${PATH} + +# We will redirect verbose test log output to a file; remove any existing +# versions of this file first +test_log=${PWD}/test.out +rm -f ${test_log} + + +generatecsmesh=`which GenerateCSMesh` +generatevolumetricmesh=`which GenerateVolumetricMesh` +convertmeshtoscrip=`which ConvertMeshToSCRIP` + +if [ "${generatecsmesh}x" == "x" ]; then + echo "ERROR: tempestremap tool GenerateCSMesh not found in PATH" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +if [ "${generatevolumetricmesh}x" == "x" ]; then + echo "ERROR: tempestremap tool GenerateVolumetricMesh not found in PATH" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +if [ "${convertmeshtoscrip}x" == "x" ]; then + echo "ERROR: tempestremap tool ConvertMeshToScrip not found in PATH" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + + +meshfile=ne30.g +gridfile=ne30pg4.g +scripfile=ne30pg4_scrip.nc +target_grid=${reference_files}/ne30pg4_scrip.nc +input_topo=${inputdata_root}/atm/cam/topo/USGS-topo-cube3000.nc +output_topo=${PWD}/output.nc + +echo "Running ${generatecsmesh}" >> ${test_log} 2>&1 +(${generatecsmesh} --alt --res 30 --file ${meshfile}) >> ${test_log} 2>&1 +if [ ! -f ${meshfile} ]; then + echo "ERROR: GenerateCSMesh: no ${meshfile} file created" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +echo "Running ${generatevolumetricmesh}" >> ${test_log} 2>&1 +(${generatevolumetricmesh} --in ${meshfile} --out ${gridfile}) >> ${test_log} 2>&1 +if [ ! -f ${gridfile} ]; then + echo "ERROR: GenerateVolumetricMesh: no ${gridfile} file created" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +echo "Running ${convertmeshtoscrip}" >> ${test_log} 2>&1 +(${convertmeshtoscrip} --in ${meshfile} --out ${scripfile}) >> ${test_log} 2>&1 +if [ ! -f ${scripfile} ]; then + echo "ERROR: ConvertMeshToSCRIP: no ${scripfile} file created" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + + +echo "build cube_to_data in ${PWD}/builds ..." >> ${test_log} +mkdir -p builds +cd builds +${cime_root}/CIME/scripts/configure --mpilib mpich --macros-format Makefile >> ${test_log} 2>&1 + +if [ ! -f .env_mach_specific.sh ]; then + if [ ! -f .env_mach_specific.sh ]; then + echo "ERROR running ${cime_root}/CIME/scripts/configure" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 + fi +fi + +cp ${e3sm_root}/components/eam/tools/topo_tool/cube_to_target/* . +#Edit Makefile to use macros defined by configure in Macros.make +sed "s:^FFLAGS:#FFLAGS:g" Makefile | sed "s:^LDFLAGS:#LDFLAGS:g" > Makefile.tmp +echo "include Macros.make" > Makefile +echo 'FC=${MPIFC}' >> Makefile +echo 'LDFLAGS=${SLIBS}' >> Makefile +echo 'FFLAGS+=-I${NETCDF_PATH}/include' >> Makefile +cat Makefile.tmp >> Makefile + +# Compile +(. .env_mach_specific.sh && export FC=gfortran && export LIB_NETCDF=${NETCDF_FORTRAN_PATH}/lib && export INC_NETCDF=${NETCDF_FORTRAN_PATH/include} && make) >> ${test_log} 2>&1 + +if [ ! -f cube_to_target ]; then + echo "ERROR building cube_to_target" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +echo "Running cube_to_target" >> ${test_log} 2>&1 +(. .env_mach_specific.sh && ./build/cube_to_target --target-grid ${target_grid} --input-topography ${input_topo} --output-topography ${output_topo} ) >> ${test_log} + +exit 0 diff --git a/components/elm/tools/mksurfdata_map/test_mksurfdat.sh b/components/elm/tools/mksurfdata_map/test_mksurfdat.sh new file mode 100755 index 000000000000..89025b09726b --- /dev/null +++ b/components/elm/tools/mksurfdata_map/test_mksurfdat.sh @@ -0,0 +1,196 @@ +#!/bin/bash + +display_help() { + echo "Usage: $0 " >&2 + echo + echo " -e, --e3sm_root Specify location of E3SM" + echo " -h, --help Display this message" + echo " -i, --inputdata_root Specify location of climate inputdata" + echo + echo "NOTE: requires tempestremap and ESMF tools to be in PATH environment variable" +} + +# get arguments +# Need --e3sm_root= +# --inputdata_root= + +# test mkdurfdat.pl to generate land surface data +# See step 7 in +# https://acme-climate.atlassian.net/wiki/spaces/DOC/pages/872579110/Running+E3SM+on+New+Grids + +e3sm_root="default" +test_root="default" +inputdata_root="default" + +for arg in "$@" +do +case $arg in + -e=*|--e3sm_root=*) + e3sm_root="${arg#*=}" + shift + ;; + + -i=*|--inputdata_root=*) + inputdata_root="${arg#*=}" + shift + ;; + + -*) + display_help + exit 1; + ;; + + -h|--help) + display_help + exit 0; + ;; + +esac +done + +if [[ ${inputdata_root} == "default" ]]; then + echo "Error: inputdata_root not set" >&2 + display_help + exit 1; +fi +if [[ ${e3sm_root} == "default" ]]; then + echo "Error: e3sm_root not set" >&2 + display_help + exit 1; +fi + +output_root=$PWD +cime_root=${e3sm_root}/cime + +# Add testing bin to path +PATH=${test_root}/bin:${PATH} + +# We will redirect verbose test log output to a file; remove any existing +# versions of this file first +test_log=${PWD}/test.out +rm -f ${test_log} +mkdir -p src +cd src + +########### +### 1 ### Create mapping files for each land surface type if needed +########### + +# a) +# Obtain or generate a target grid file in SCRIP format. For these example, we will use a ne1024pg2 grid file, +# which we will need to create (note that most np4 grid files can be found within the inputdata repository, for +# example, the ne1024np4 grid file is at +# https://web.lcrc.anl.gov/public/e3sm/mapping/grids/ne1024np4_scrip_c20191023.nc) + +generatecsmesh=$(which GenerateCSMesh) +generatevolumetricmesh=$(which GenerateVolumetricMesh) +convertmeshtoscrip=$(which ConvertMeshToSCRIP) +esmfregridweightgen=$(which ESMF_RegridWeightGen) + +#test for tempestremap and ESMF tools +if [ "${esmfregridweightgen}x" == "x" ]; then + echo "ERROR: ESMF tool ESMF_RegridWeightGen not found in PATH" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +if [ "${generatecsmesh}x" == "x" ]; then + echo "ERROR: tempestremap tool GenerateCSMesh not found in PATH" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +if [ "${generatevolumetricmesh}x" == "x" ]; then + echo "ERROR: tempestremap tool GenerateVolumetricMesh not found in PATH" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +if [ "${convertmeshtoscrip}x" == "x" ]; then + echo "ERROR: tempestremap tool ConvertMeshToScrip not found in PATH" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + + + +# These files will be created +meshfile=ne4.g +gridfile=ne4pg4.g +scripfile=ne4pg4_scrip.nc + +echo "Running ${generatecsmesh}" >> ${test_log} 2>&1 +(${generatecsmesh} --alt --res 4 --file ${meshfile}) >> ${test_log} 2>&1 +if [ ! -f ${meshfile} ]; then + echo "ERROR: GenerateCSMesh: no ${meshfile} file created" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +echo "Running ${generatevolumetricmesh}" >> ${test_log} 2>&1 +(${generatevolumetricmesh} --in ${meshfile} --out ${gridfile} --np 4 --uniform) >> ${test_log} 2>&1 +if [ ! -f ${gridfile} ]; then + echo "ERROR: GenerateVolumetricMesh: no ${gridfile} file created" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +echo "Running ${convertmeshtoscrip}" >> ${test_log} 2>&1 +(${convertmeshtoscrip} --in ${meshfile} --out ${scripfile}) >> ${test_log} 2>&1 +if [ ! -f ${scripfile} ]; then + echo "ERROR: ConvertExodusToSCRIP: no ${scripfile} file created" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + + + +# b) +# Get list of input grid files for each land surface input data file. This is done by running the +# components/clm/tools/shared/mkmapdata/mkmapdata.sh script in debug mode to output a list of needed +# files (along with the commands that will be used to generate each map file; also make sure GRIDFILE +# is set to the SCRIP file from the above step): +mkmapdata=${e3sm_root}/components/elm/tools/mkmapdata/mkmapdata.sh +if [ ! -f ${makemapdata} ]; then + echo "ERROR: mkmapdata.sh not found" + exit 1 +fi + + +# Gen env_mach_specific +${cime_root}/CIME/scripts/configure --mpilib mpich --macros-format Makefile >> ${test_log} 2>&1 + +echo "Running ${mkmapdata}" >> ${test_log} 2>&1 +(. .env_mach_specific.sh && set -x && ${mkmapdata} --gridfile ${scripfile} --inputdata-path ${inputdata_root} --res ne4pg4 --gridtype global --output-filetype 64bit_offset) >> ${test_log} 2>&1 + + +# d) Create mapping file + +############## +#### 3 ##### +############## +echo "build mksurfdata_map" >> ${test_log} 2>&1 +today=$(date +%y%m%d) +cp ${e3sm_root}/components/elm/tools/mksurfdata_map/src/* . +cat <> .env_mach_specific.sh +export USER_FC="$(awk '/MPIFC :=/ {$1=$2=""; print $0}' Macros.make)" +export USER_CPPDEFS="$(awk '/CPPDEFS :=/ {$1=$2=$3=""; print $0}' Macros.make)" +export USER_FFLAGS="$(awk '/FFLAGS :=/ {$1=$2=""; print $0}' Macros.make)" +export USER_LDFLAGS="$(awk '/SLIBS :=/ {$1=$2=$3=""; print $0}' Macros.make)" +export LIB_NETCDF=$NETCDF_PATH/lib +export INC_NETCDF=$NETCDF_PATH/include +EOF +sed -i 's|\.\./\.\./\.\.|..|' Makefile.common +(. .env_mach_specific.sh && make) >> ${test_log} 2>&1 +if [ ! -f ${mksurfdat_map} ]; then + echo "ERROR finding/building mksurfdata_map" >&2 + echo "cat ${test_log} for more info" >&2 + exit 1 +fi + +echo "Running mksurfdata.pl" >> ${test_log} 2>&1 +echo "${e3sm_root}/components/elm/tools/mksurfdata_map/mksurfdata.pl -res usrspec -usr_gname ne4pg4 -usr_gdate ${today} -y 2010 -d -dinlc ${inputdata_root} -usr_mapdir ${PWD}" >> ${test_log} 2>&1 +(. .env_mach_specific.sh && ${e3sm_root}/components/elm/tools/mksurfdata_map/mksurfdata.pl -res usrspec -usr_gname ne4pg4 -usr_gdate ${today} -y 2010 -d -dinlc ${inputdata_root} -usr_mapdir ${PWD}) >> ${test_log} 2>&1 + + +exit 0 diff --git a/components/mpas-ocean/cime_config/config_pes.xml b/components/mpas-ocean/cime_config/config_pes.xml index e73b0210815d..ed198705a09f 100644 --- a/components/mpas-ocean/cime_config/config_pes.xml +++ b/components/mpas-ocean/cime_config/config_pes.xml @@ -554,6 +554,43 @@ + + + mpas-ocean: SO RRM, compset=DATM+MPASO, 8 nodes, 128x1c8 ~3.3 sypd + 128 + + 1024 + 1024 + 1024 + 1024 + 1024 + 1 + 128 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + 8 + + + mpas-ocean: SO RRM, compset=DATM+MPASO, 75 nodes, ~2.6 SYPD diff --git a/components/ww3/bld/build-namelist b/components/ww3/bld/build-namelist index 2c4866e47959..314949671c4f 100755 --- a/components/ww3/bld/build-namelist +++ b/components/ww3/bld/build-namelist @@ -287,6 +287,7 @@ foreach my $attr (keys %xmlvars) { my $DIN_LOC_ROOT = $xmlvars{'DIN_LOC_ROOT'}; my $WAV_GRID = $xmlvars{'WAV_GRID'}; +my $WAV_SPEC = $xmlvars{'WAV_SPEC'}; (-d $DIN_LOC_ROOT) or mkdir $DIN_LOC_ROOT; if ($print>=2) { @@ -314,17 +315,29 @@ if ($NML_TYPE eq "ww3") { } if ($NML_TYPE eq "ww3_grid") { - if (${WAV_GRID} eq "wQU225EC60to30sp32x36") { - add_default($nl, 'spectrum%xfr', 'val'=>1.10); - add_default($nl, 'spectrum%freq1', 'val'=>0.05); - add_default($nl, 'spectrum%nk', 'val'=>32); + if (${WAV_GRID} eq "wQU225EC60to30") { #only highest WW3 spectral resolution for E3SM V1 grid + add_default($nl, 'spectrum%xfr', 'val'=>1.07); + add_default($nl, 'spectrum%freq1', 'val'=>0.035); + add_default($nl, 'spectrum%nk', 'val'=>50); add_default($nl, 'spectrum%nth', 'val'=>36); } - else { - add_default($nl, 'spectrum%xfr'); - add_default($nl, 'spectrum%freq1'); - add_default($nl, 'spectrum%nk'); - add_default($nl, 'spectrum%nth'); + elsif (${WAV_SPEC} eq "sp25x36") { + add_default($nl, 'spectrum%xfr', 'val'=>1.147); + add_default($nl, 'spectrum%freq1', 'val'=>0.035); + add_default($nl, 'spectrum%nk', 'val'=>25); + add_default($nl, 'spectrum%nth', 'val'=>36); + } + elsif (${WAV_SPEC} eq "sp50x36") { + add_default($nl, 'spectrum%xfr', 'val'=>1.07); + add_default($nl, 'spectrum%freq1', 'val'=>0.035); + add_default($nl, 'spectrum%nk', 'val'=>50); + add_default($nl, 'spectrum%nth', 'val'=>36); + } + elsif (${WAV_SPEC} eq "sp36x36") { #default : wQU225EC30to60E2r2sp36x36 + add_default($nl, 'spectrum%xfr','val'=>1.10); + add_default($nl, 'spectrum%freq1','val'=>0.035); + add_default($nl, 'spectrum%nk','val'=>36); + add_default($nl, 'spectrum%nth','val'=>36); } add_default($nl, 'spectrum%thoff'); @@ -385,8 +398,8 @@ if ($NML_TYPE eq "ww3_grid_nml") { add_default($nl, 'icedisp'); add_default($nl, 'rwndc'); - add_default($nl, 'uostfilelocal', 'val'=>"'${DIN_LOC_ROOT}/wav/ww3/obstructions_local.${WAV_GRID}.in'"); - add_default($nl, 'uostfileshadow', 'val'=>"'${DIN_LOC_ROOT}/wav/ww3/obstructions_shadow.${WAV_GRID}.in'"); + add_default($nl, 'uostfilelocal', 'val'=>"'${DIN_LOC_ROOT}/wav/ww3/obstructions_local.${WAV_GRID}${WAV_SPEC}.in'"); + add_default($nl, 'uostfileshadow', 'val'=>"'${DIN_LOC_ROOT}/wav/ww3/obstructions_shadow.${WAV_GRID}${WAV_SPEC}.in'"); } diff --git a/components/ww3/bld/namelist_files/namelist_defaults_ww3_grid.xml b/components/ww3/bld/namelist_files/namelist_defaults_ww3_grid.xml index 32b9cc50d911..e8bb1d42b243 100644 --- a/components/ww3/bld/namelist_files/namelist_defaults_ww3_grid.xml +++ b/components/ww3/bld/namelist_files/namelist_defaults_ww3_grid.xml @@ -30,7 +30,7 @@ attributes to express the dependency. 450.0 30.0 -wQU225EC60to30 +wQU225EC30to60E2r2 ww3_grid_namelists.nml UNST SPHE diff --git a/components/ww3/cime_config/buildnml b/components/ww3/cime_config/buildnml index 351d0d370364..8e7cd2ea84ec 100755 --- a/components/ww3/cime_config/buildnml +++ b/components/ww3/cime_config/buildnml @@ -32,6 +32,7 @@ def buildnml(case, caseroot, compname): compset = case.get_value("COMPSET") wav_grid = case.get_value("WAV_GRID") wav_only = case.get_value("WAV_ONLY") + wav_spec = case.get_value("WAV_SPEC") ww3_bldnml_opts = case.get_value("WW3_BLDNML_OPTS") ww3_namelist_opts = case.get_value("WW3_NAMELIST_OPTS") rundir = case.get_value("RUNDIR") @@ -50,8 +51,12 @@ def buildnml(case, caseroot, compname): # Verify wav grid is supported #-------------------------------------------------------------------- - wav_grid_supported = ("null", "wQU225EC60to30sp32x36", "wQU225EC60to30", "wQU100", "wQU225EC30to60E2r2") - expect(wav_grid in wav_grid_supported, "WAV_GRID '{}' is not supported in ww3. Choose from: '{}'".format(wav_grid,' ,'.join(wav_grid_supported))) + wav_grid_supported = ("null", + "wQU225EC60to30sp50x36", + "wQU225EC30to60E2r2sp50x36", + "wQU225EC30to60E2r2sp36x36", + "wQU225EC30to60E2r2sp25x36") + expect((wav_grid+wav_spec) in wav_grid_supported, "Combination of WAV_GRID {} and WAV_SPEC {} is not supported in ww3. Choose from: '{}'".format(wav_grid,wav_spec,wav_grid_supported) ) #-------------------------------------------------------------------- # Generate input data file @@ -61,8 +66,8 @@ def buildnml(case, caseroot, compname): input_list.write("mesh = {}/wav/ww3/{}.msh\n".format(din_loc_root,wav_grid)) input_list.write("stations = {}/wav/ww3/stations.txt\n".format(din_loc_root)) - input_list.write("uostfilelocal = {}/wav/ww3/obstructions_local.{}.in\n".format(din_loc_root,wav_grid)) - input_list.write("uostfileshadow = {}/wav/ww3/obstructions_shadow.{}.in\n".format(din_loc_root,wav_grid)) + input_list.write("uostfilelocal = {}/wav/ww3/obstructions_local.{}{}.in\n".format(din_loc_root,wav_grid,wav_spec)) + input_list.write("uostfileshadow = {}/wav/ww3/obstructions_shadow.{}{}.in\n".format(din_loc_root,wav_grid,wav_spec)) #-------------------------------------------------------------------- # Invoke ww3 build-namelist - output will go in $CASEBUILD/ww3conf diff --git a/components/ww3/cime_config/config_component.xml b/components/ww3/cime_config/config_component.xml index edb932a6ab71..27523b8f42d9 100644 --- a/components/ww3/cime_config/config_component.xml +++ b/components/ww3/cime_config/config_component.xml @@ -28,6 +28,23 @@ Option to determine wave only run + + char + sp50x36,sp36x36,sp25x36 + sp36x36 + + sp36x36 + sp25x36 + sp36x36 + sp50x36 + + case_comp + env_case.xml + Option to set WW3 Spectral Resolution. + + + + ========================================= WW3 naming conventions diff --git a/components/ww3/cime_config/config_compsets.xml b/components/ww3/cime_config/config_compsets.xml index 35beafc25db4..2ab33e978570 100644 --- a/components/ww3/cime_config/config_compsets.xml +++ b/components/ww3/cime_config/config_compsets.xml @@ -11,37 +11,37 @@ VWW3-IAF - 2000_DATM%IAF_SLND_SICE_SOCN_SROF_SGLC_WW3 + 2000_DATM%IAF_SLND_SICE_SOCN_SROF_SGLC_WW3%sp36x36 VWW3-CFSv2 - 2000_DATM%CFSv2_SLND_SICE_SOCN_SROF_SGLC_WW3 + 2000_DATM%CFSv2_SLND_SICE_SOCN_SROF_SGLC_WW3%sp36x36 VWW3-CFSR - 2000_DATM%CFSR_SLND_SICE_SOCN_SROF_SGLC_WW3 + 2000_DATM%CFSR_SLND_SICE_SOCN_SROF_SGLC_WW3%sp36x36 GMPAS-IAF-WW3 - 2000_DATM%IAF_SLND_MPASSI_MPASO%DATMFORCED_DROF%IAF_SGLC_WW3 + 2000_DATM%IAF_SLND_MPASSI_MPASO%DATMFORCED_DROF%IAF_SGLC_WW3%sp36x36 GMPAS-JRA1p4-WW3 - 2000_DATM%JRA-1p4-2018_SLND_MPASSI_MPASO%DATMFORCED_DROF%JRA-1p4-2018_SGLC_WW3 + 2000_DATM%JRA-1p4-2018_SLND_MPASSI_MPASO%DATMFORCED_DROF%JRA-1p4-2018_SGLC_WW3%sp36x36 WCYCLSSP585-WW3 - SSP585SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_WW3 + SSP585SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_WW3%sp36x36 WCYCL1850-WW3 - 1850SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_WW3 + 1850SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_WW3%sp36x36