diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 9f33913cd..97cfef798 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -8,7 +8,7 @@ Explicitly state what tests were run on these changes, or if any are still pendi ## Dependencies: Add any links to parent PRs (e.g. SCM and/or UFS PRs) or submodules (e.g. rte-rrtmgp). For example: - NCAR/ccpp-framework# -- NOAA-EMC/fv3atm# +- NOAA-EMC/ufsatm# - ufs-community/ufs-weather-model/# ## Documentation: diff --git a/CMakeLists.txt b/CMakeLists.txt index 98f3bf0f9..5afd86200 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -81,8 +81,8 @@ get_filename_component(LOCAL_CURRENT_SOURCE_DIR ${FULL_PATH_TO_CMAKELISTS} DIREC #------------------------------------------------------------------------------ -# List of files that need to be compiled without OpenMP -set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/gas-optics/mo_gas_optics.F90 +# List of files that should be compiled with RTE-RRTMGP compilation flags +set(SCHEMES_RTERRTMGP ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/gas-optics/mo_gas_optics.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/gas-optics/mo_gas_optics_constants.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/gas-optics/mo_gas_concentrations.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/gas-optics/mo_gas_optics_util_string.F90 @@ -109,6 +109,9 @@ set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte- ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_kind.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_optical_props.F90) +# List of files that need to be compiled without OpenMP (currently a copy of SCHEMES_RTERRTMGP) +set(SCHEMES_OPENMP_OFF ${SCHEMES_RTERRTMGP}) + # List of files that need to be compiled with different precision set(SCHEMES_DYNAMICS) @@ -124,11 +127,19 @@ if(SCHEMES_DYNAMICS) list(REMOVE_ITEM SCHEMES ${SCHEMES_DYNAMICS}) endif() +# Remove files that need to be compiled with different flags for RTE-RRTMGP from list +# of files with standard compiler flags, and assign special flags +if(SCHEMES_RTERRTMGP) + SET_PROPERTY(SOURCE ${SCHEMES_RTERRTMGP} + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_RTERRTMGP}") + list(REMOVE_ITEM SCHEMES ${SCHEMES_RTERRTMGP}) +endif() + # Remove files that need to be compiled without OpenMP from list # of files with standard compiler flags, and assign no-OpenMP flags if(SCHEMES_OPENMP_OFF) SET_PROPERTY(SOURCE ${SCHEMES_OPENMP_OFF} - APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_RTERRTMGP}") + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_OPENMP_OFF}") list(REMOVE_ITEM SCHEMES ${SCHEMES_OPENMP_OFF}) endif() @@ -184,7 +195,7 @@ endif() set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_INSTALL_INCLUDEDIR}) -add_library(ccpp_physics STATIC ${SCHEMES} ${SCHEMES_OPENMP_OFF} ${SCHEMES_DYNAMICS} ${CAPS}) +add_library(ccpp_physics STATIC ${SCHEMES} ${SCHEMES_RTERRTMGP} ${SCHEMES_OPENMP_OFF} ${SCHEMES_DYNAMICS} ${CAPS}) set_target_properties(ccpp_physics PROPERTIES VERSION ${PROJECT_VERSION} SOVERSION ${PROJECT_VERSION_MAJOR}) diff --git a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 index 2fd963d57..5da78d9ec 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 @@ -3960,7 +3960,7 @@ subroutine neg_check(name,j,dt,q,outq,outt,outu,outv, & ,intent (in ) :: & dt real(kind=kind_phys) :: names,scalef,thresh,qmem,qmemf,qmem2,qtest,qmem1 - integer :: icheck + integer :: i,k,icheck ! ! first do check on vertical heating rate ! diff --git a/physics/CONV/SAMF/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f index 48bbc5840..1ccff17e5 100644 --- a/physics/CONV/SAMF/samfdeepcnv.f +++ b/physics/CONV/SAMF/samfdeepcnv.f @@ -1673,9 +1673,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if(totflg) return !! c -c estimate the onvective overshooting as the level +c Estimate the convective overshooting as the level c where the [aafac * cloud work function] becomes zero, -c which is the final cloud top +c which is the final cloud top. c !> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. do i = 1, im diff --git a/physics/CONV/SAS/sascnvn.F b/physics/CONV/SAS/sascnvn.F index 4e3dfcc41..8a78d63ff 100644 --- a/physics/CONV/SAS/sascnvn.F +++ b/physics/CONV/SAS/sascnvn.F @@ -974,9 +974,9 @@ subroutine sascnvn_run( if(totflg) return !! ! -! estimate the onvective overshooting as the level +! Estimate the convective overshooting as the level ! where the [aafac * cloud work function] becomes zero, -! which is the final cloud top +! which is the final cloud top. ! !> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. do i = 1, im @@ -1001,7 +1001,7 @@ subroutine sascnvn_run( & dz1 * (g / (cp * to(i,k))) & * dbyo(i,k) / (1. + gamma) & * rfact -!NRL MNM: Limit overshooting not to be deeper than the actual cloud +!NRL MNM: Limit overshooting not to be deeper than half the actual cloud tem = 0.5 * (zi(i,ktcon(i))-zi(i,kbcon(i))) tem1 = zi(i,k)-zi(i,ktcon(i)) if(aa2(i) < 0. .or. tem1 >= tem) then diff --git a/physics/GWD/ugwpv1_gsldrag.F90 b/physics/GWD/ugwpv1_gsldrag.F90 index b9c56d6bf..863f72b9c 100644 --- a/physics/GWD/ugwpv1_gsldrag.F90 +++ b/physics/GWD/ugwpv1_gsldrag.F90 @@ -304,7 +304,7 @@ end subroutine ugwpv1_gsldrag_finalize !! \htmlinclude ugwpv1_gsldrag_run.html !! subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, & - fhzero, kdt, ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, & + kdt, ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, & do_gsl_drag_ss, do_gsl_drag_tofd, & do_gwd_opt_psl, psl_gwd_dx_factor, & do_ngw_ec, do_ugwp_v1, do_ugwp_v1_orog_only, & @@ -366,7 +366,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, logical, intent (in) :: do_ugwp_v1_w_gsldrag ! combination of ORO and NGW schemes integer, intent(in) :: me, master, im, levs, ntrac,lonr - real(kind=kind_phys), intent(in) :: dtp, fhzero + real(kind=kind_phys), intent(in) :: dtp real(kind=kind_phys), intent(in) :: ak(:), bk(:) integer, intent(in) :: kdt, jdat(:) ! option for psl gwd diff --git a/physics/GWD/ugwpv1_gsldrag.meta b/physics/GWD/ugwpv1_gsldrag.meta index 24d8b0688..934d5b138 100644 --- a/physics/GWD/ugwpv1_gsldrag.meta +++ b/physics/GWD/ugwpv1_gsldrag.meta @@ -352,14 +352,6 @@ type = real kind = kind_phys intent = in -[fhzero] - standard_name = period_of_diagnostics_reset - long_name = hours between clearing of diagnostic buckets - units = h - dimensions = () - type = real - kind = kind_phys - intent = in [kdt] standard_name = index_of_timestep long_name = current forecast iteration diff --git a/physics/GWD/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 index 05f9030a8..aeaa54471 100644 --- a/physics/GWD/unified_ugwp.F90 +++ b/physics/GWD/unified_ugwp.F90 @@ -244,7 +244,7 @@ end subroutine unified_ugwp_finalize !! \htmlinclude unified_ugwp_run.html !! ! \section det_unified_ugwp GFS Unified GWP Scheme Detailed Algorithm - subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt, & + subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, & lonr, oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, & varss,oc1ss,oa4ss,ol4ss,dx,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl,dusfc_ss, & dvsfc_ss,dusfc_fd,dvsfc_fd,dtaux2d_ms,dtauy2d_ms,dtaux2d_bl,dtauy2d_bl, & @@ -290,7 +290,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt real(kind=kind_phys), intent(in), dimension(:,:) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil real(kind=kind_phys), intent(in), dimension(:,:) :: prsi, phii real(kind=kind_phys), intent(in), dimension(:,:) :: q1 - real(kind=kind_phys), intent(in) :: dtp, fhzero, cdmbgwd(:), alpha_fd + real(kind=kind_phys), intent(in) :: dtp, cdmbgwd(:), alpha_fd integer, intent(in) :: jdat(:) logical, intent(in) :: do_tofd, ldiag_ugwp, ugwp_seq_update diff --git a/physics/GWD/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta index fe66b4b4b..62db52127 100644 --- a/physics/GWD/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -331,14 +331,6 @@ type = real kind = kind_phys intent = in -[fhzero] - standard_name = period_of_diagnostics_reset - long_name = hours between clearing of diagnostic buckets - units = h - dimensions = () - type = real - kind = kind_phys - intent = in [kdt] standard_name = index_of_timestep long_name = current forecast iteration diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 index 97d9b138d..ce2a2a9e2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 @@ -24,7 +24,7 @@ subroutine GFS_MP_generic_post_run( cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, & snow_cpl, pwat, frzr, frzrb, frozr, frozrb, tsnowp, tsnowpb, rhonewsn1, exticeden, & drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & - graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, & + graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, num_diag_buckets, & dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d,dqdt_qmicro, lssav, num_dfi_radar, & fh_dfi_radar,index_of_process_dfi_radar, ix_dfi_radar, dfi_radar_tten, radar_tten_limits, fhour, prevsq, & iopt_lake, iopt_lake_clm, lkm, use_lake_model, errmsg, errflg) @@ -39,6 +39,7 @@ subroutine GFS_MP_generic_post_run( logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, cpllnd, progsigma, exticeden integer, intent(in) :: index_of_temperature,index_of_process_mp,use_lake_model(:) integer, intent(in) :: imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf + integer, intent(in) :: num_diag_buckets integer, dimension (:), intent(in) :: htop real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour, con_t0c real(kind=kind_phys), intent(in) :: radar_tten_limits(:) @@ -58,8 +59,9 @@ subroutine GFS_MP_generic_post_run( real(kind=kind_phys), dimension(:), intent(in ) :: sr real(kind=kind_phys), dimension(:), intent(inout) :: rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, & - srflag, cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, & - totprcpb, toticeb, totsnwb, totgrpb, pwat + srflag, cnvprcp, totprcp, totice, totsnw, totgrp, & + toticeb, totsnwb, totgrpb, pwat + real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvprcpb, totprcpb real(kind=kind_phys), dimension(:), intent(inout), optional :: rain_cpl, rainc_cpl, snow_cpl real(kind=kind_phys), dimension(:,:,:), intent(inout), optional :: dtend @@ -101,7 +103,7 @@ subroutine GFS_MP_generic_post_run( real(kind=kind_phys), parameter :: p850 = 85000.0_kind_phys ! *DH - integer :: i, k, ic, itrac, idtend, itime, idtend_radar, idtend_mp + integer :: i, k, ic, itrac, idtend, itime, idtend_radar, idtend_mp, ib real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys real(kind=kind_phys) :: crain, csnow, onebg, tem, total_precip, tem1, tem2, ttend @@ -451,7 +453,7 @@ subroutine GFS_MP_generic_post_run( if_save_fields: if (lssav) then ! if (Model%me == 0) print *,'in phys drive, kdt=',Model%kdt, & -! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & +! 'totprcpb=', Diag%totprcpb(1,1),'totprcp=',Diag%totprcp(1), & ! 'rain=',Diag%rain(1) do i=1,im cnvprcp (i) = cnvprcp (i) + rainc(i) @@ -460,12 +462,16 @@ subroutine GFS_MP_generic_post_run( totsnw (i) = totsnw (i) + snow(i) totgrp (i) = totgrp (i) + graupel(i) - cnvprcpb(i) = cnvprcpb(i) + rainc(i) - totprcpb(i) = totprcpb(i) + rain(i) toticeb (i) = toticeb (i) + ice(i) totsnwb (i) = totsnwb (i) + snow(i) totgrpb (i) = totgrpb (i) + graupel(i) enddo + do ib=1,num_diag_buckets + do i=1,im + cnvprcpb(i,ib) = cnvprcpb(i,ib) + rainc(i) + totprcpb(i,ib) = totprcpb(i,ib) + rain(i) + enddo + enddo if_tendency_diagnostics: if (ldiag3d) then idtend = dtidx(index_of_temperature,index_of_process_mp) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta index 15ad5f6b3..ea1b456e3 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta @@ -590,7 +590,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket long_name = cumulative convective precipitation in bucket units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_diagnostic_buckets) type = real kind = kind_phys intent = inout @@ -598,7 +598,7 @@ standard_name = accumulated_lwe_thickness_of_precipitation_amount_in_bucket long_name = accumulated total precipitation in bucket units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_diagnostic_buckets) type = real kind = kind_phys intent = inout @@ -798,6 +798,13 @@ type = real kind = kind_phys intent = in +[num_diag_buckets] + standard_name = number_of_diagnostic_buckets + long_name = number of diagnostic bucket reset periods + units = count + dimensions = () + type = integer + intent = in [num_dfi_radar] standard_name = number_of_radar_derived_temperature_or_convection_suppression_intervals long_name = number of time ranges with radar-derived microphysics temperature tendencies or radar-derived convection suppression diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 index 8102d70eb..21de71ecb 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 @@ -11,7 +11,7 @@ module GFS_SCNV_generic_post subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & frain, gu0, gv0, gt0, gq0, save_u, save_v, save_t, save_q, & clw, shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, nsamftrac, & - rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & + rainc, cnvprcp, cnvw_phy_f3d, cnvc_phy_f3d, & dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & index_of_process_scnv, ntqv, flag_for_scnv_generic_tend, & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc,ntsigma, & @@ -41,7 +41,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & logical, intent(in) :: shcnvcw real(kind=kind_phys), dimension(:), intent(in) :: rain1 real(kind=kind_phys), dimension(:, :), intent(in) :: cnvw, cnvc - real(kind=kind_phys), dimension(:), intent(inout) :: rainc, cnvprcp, cnvprcpb + real(kind=kind_phys), dimension(:), intent(inout) :: rainc, cnvprcp ! The following arrays may not be allocated, depending on certain flags and microphysics schemes. ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta index f90fccf01..02b6bbe54 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta @@ -256,14 +256,6 @@ type = real kind = kind_phys intent = inout -[cnvprcpb] - standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket - long_name = cumulative convective precipitation in bucket - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout [cnvw_phy_f3d] standard_name = convective_cloud_condensate_mixing_ratio long_name = convective cloud water mixing ratio in the phy_f3d array diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 index b381c9e9c..ae92a4789 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 @@ -398,9 +398,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & nthreads, blkno, errmsg, errflg) -#ifdef MPI use mpi_f08 -#endif #ifdef _OPENMP use omp_lib #endif @@ -433,13 +431,8 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, errmsg = '' errflg = 0 -#ifdef MPI mpirank = Model%me mpisize = Model%ntasks -#else - mpirank = 0 - mpisize = 1 -#endif #ifdef _OPENMP omprank = OMP_GET_THREAD_NUM() ompsize = nthreads @@ -451,9 +444,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, #ifdef _OPENMP !$OMP BARRIER #endif -#ifdef MPI ! call MPI_BARRIER(Model%communicator,ierr) -#endif do impi=0,mpisize-1 do iomp=0,ompsize-1 @@ -950,17 +941,13 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, !$OMP BARRIER #endif end do -#ifdef MPI ! call MPI_BARRIER(Model%communicator,ierr) -#endif end do #ifdef _OPENMP !$OMP BARRIER #endif -#ifdef MPI ! call MPI_BARRIER(Model%communicator,ierr) -#endif end subroutine GFS_diagtoscreen_run @@ -997,9 +984,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & nthreads, blkno, errmsg, errflg) -#ifdef MPI use mpi_f08 -#endif #ifdef _OPENMP use omp_lib #endif @@ -1032,13 +1017,8 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup errmsg = '' errflg = 0 -#ifdef MPI mpirank = Model%me call MPI_COMM_SIZE(Model%communicator, mpisize, ierr) -#else - mpirank = 0 - mpisize = 1 -#endif #ifdef _OPENMP omprank = OMP_GET_THREAD_NUM() ompsize = nthreads @@ -1050,31 +1030,17 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup #ifdef _OPENMP !$OMP BARRIER #endif -#ifdef MPI ! call MPI_BARRIER(Model%communicator,ierr) -#endif do impi=0,mpisize-1 do iomp=0,ompsize-1 if (mpirank==impi .and. omprank==iomp) then ! Print static variables - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ipr ', Interstitial%ipr ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%itc ', Interstitial%itc ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%latidxprnt ', Interstitial%latidxprnt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%levi ', Interstitial%levi ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lmk ', Interstitial%lmk ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lmp ', Interstitial%lmp ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nbdlw ', Interstitial%nbdlw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nbdsw ', Interstitial%nbdsw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nf_aelw ', Interstitial%nf_aelw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nf_aesw ', Interstitial%nf_aesw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nsamftrac ', Interstitial%nsamftrac ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nscav ', Interstitial%nscav ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nspc1 ', Interstitial%nspc1 ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ntiwx ', Interstitial%ntiwx ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nvdiff ', Interstitial%nvdiff ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%phys_hydrostatic ', Interstitial%phys_hydrostatic ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%skip_macro ', Interstitial%skip_macro ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%trans_aero ', Interstitial%trans_aero ) ! Print all other variables call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjsfculw_land ', Interstitial%adjsfculw_land ) @@ -1114,7 +1080,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cmm_land ', Interstitial%cmm_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cmm_water ', Interstitial%cmm_water ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnvc ', Interstitial%cnvc ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnvw ', Interstitial%cnvw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ctei_r ', Interstitial%ctei_r ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ctei_rml ', Interstitial%ctei_rml ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cumabs ', Interstitial%cumabs ) @@ -1167,7 +1132,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10_ice ', Interstitial%fm10_ice ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10_land ', Interstitial%fm10_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10_water ', Interstitial%fm10_water ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%frain ', Interstitial%frain ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%frland ', Interstitial%frland ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fscav ', Interstitial%fscav ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fswtr ', Interstitial%fswtr ) @@ -1388,17 +1352,13 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup !$OMP BARRIER #endif end do -#ifdef MPI ! call MPI_BARRIER(Model%communicator,ierr) -#endif end do #ifdef _OPENMP !$OMP BARRIER #endif -#ifdef MPI ! call MPI_BARRIER(Model%communicator,ierr) -#endif end subroutine GFS_interstitialtoscreen_run diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 index d66c1f19f..2af01115c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 @@ -4,7 +4,6 @@ !>\defgroup mod_GFS_phys_time_vary GFS Physics Time Update !! This module contains GFS physics time vary subroutines including stratospheric water vapor, !! aerosol, IN&CCN and surface properties updates. -!> @{ module GFS_phys_time_vary use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec @@ -15,7 +14,7 @@ module GFS_phys_time_vary use module_h2ophys, only: ty_h2ophys use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm, iamin, iamax, jamin, jamax - use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf, & + use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf, & read_aerdata_dl, aerinterpol_dl, read_aerdataf_dl use iccn_def, only : ciplin, ccnin, ci_pres @@ -35,13 +34,12 @@ module GFS_phys_time_vary dwsat_table,dksat_table,psisat_table, & isurban_table,isbarren_table, & isice_table,iswater_table + implicit none private - public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_timestep_finalize, GFS_phys_time_vary_finalize - - logical :: is_initialized = .false. + public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_finalize real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys @@ -57,10 +55,11 @@ module GFS_phys_time_vary !! \htmlinclude GFS_phys_time_vary_init.html !! !>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm -!! @{ +!> @{ subroutine GFS_phys_time_vary_init ( & - me, master, ntoz, h2o_phys, iaerclm,iaermdl, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & - jindx1_o3, jindx2_o3, ddy_o3, ozphys, h2ophys, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & + me, master, ntoz, h2o_phys, iaerclm, iaermdl, iccn, iflip, im, levs, & + nx, ny, idate, xlat_d, xlon_d, & + jindx1_o3, jindx2_o3, ddy_o3, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & @@ -73,12 +72,13 @@ subroutine GFS_phys_time_vary_init ( smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & lkm, use_lake_model, lakefrac, lakedepth, iopt_lake, iopt_lake_clm, iopt_lake_flake, & - lakefrac_threshold, lakedepth_threshold, errmsg, errflg) + lakefrac_threshold, lakedepth_threshold, ozphys, h2ophys, is_initialized, errmsg, & + errflg) implicit none ! Interface variables - integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny, iaermdl + integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny, levs, iaermdl logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start integer, intent(in) :: idate(:), iopt_lake, iopt_lake_clm, iopt_lake_flake real(kind_phys), intent(in) :: fhour, lakefrac_threshold, lakedepth_threshold @@ -91,9 +91,10 @@ subroutine GFS_phys_time_vary_init ( integer, intent(inout), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) real(kind_phys), intent(inout), optional :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(in) :: h2opl(:,:,:) + integer, intent(inout), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) real(kind_phys), intent(inout), optional :: ddy_aer(:), ddx_aer(:) - real(kind_phys), intent(in) :: aer_nm(:,:,:) + real(kind_phys), intent(out) :: aer_nm(:,:,:) integer, intent(inout), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) real(kind_phys), intent(inout), optional :: ddy_ci(:), ddx_ci(:) integer, intent(inout) :: imap(:), jmap(:) @@ -125,39 +126,39 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(inout), optional :: fwetxy(:) real(kind_phys), intent(inout), optional :: sneqvoxy(:) real(kind_phys), intent(inout), optional :: alboldxy(:) - real(kind_phys), intent(inout), optional :: qsnowxy(:) - real(kind_phys), intent(inout), optional :: wslakexy(:) + real(kind_phys), intent(inout), optional :: qsnowxy(:) + real(kind_phys), intent(inout), optional :: wslakexy(:) real(kind_phys), intent(inout) :: albdvis_lnd(:) real(kind_phys), intent(inout) :: albdnir_lnd(:) real(kind_phys), intent(inout) :: albivis_lnd(:) real(kind_phys), intent(inout) :: albinir_lnd(:) - real(kind_phys), intent(inout), optional :: albdvis_ice(:) - real(kind_phys), intent(inout), optional :: albdnir_ice(:) - real(kind_phys), intent(inout), optional :: albivis_ice(:) - real(kind_phys), intent(inout), optional :: albinir_ice(:) + real(kind_phys), intent(inout), optional :: albdvis_ice(:) + real(kind_phys), intent(inout), optional :: albdnir_ice(:) + real(kind_phys), intent(inout), optional :: albivis_ice(:) + real(kind_phys), intent(inout), optional :: albinir_ice(:) real(kind_phys), intent(inout) :: emiss_lnd(:) real(kind_phys), intent(inout) :: emiss_ice(:) - real(kind_phys), intent(inout), optional :: taussxy(:) - real(kind_phys), intent(inout), optional :: waxy(:) - real(kind_phys), intent(inout), optional :: wtxy(:) - real(kind_phys), intent(inout), optional :: zwtxy(:) - real(kind_phys), intent(inout), optional :: xlaixy(:) - real(kind_phys), intent(inout), optional :: xsaixy(:) - real(kind_phys), intent(inout), optional :: lfmassxy(:) - real(kind_phys), intent(inout), optional :: stmassxy(:) - real(kind_phys), intent(inout), optional :: rtmassxy(:) - real(kind_phys), intent(inout), optional :: woodxy(:) - real(kind_phys), intent(inout), optional :: stblcpxy(:) - real(kind_phys), intent(inout), optional :: fastcpxy(:) - real(kind_phys), intent(inout), optional :: smcwtdxy(:) - real(kind_phys), intent(inout), optional :: deeprechxy(:) - real(kind_phys), intent(inout), optional :: rechxy(:) - real(kind_phys), intent(inout), optional :: snowxy(:) - real(kind_phys), intent(inout), optional :: snicexy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout), optional :: snliqxy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout), optional :: tsnoxy (:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout), optional :: smoiseq(:,:) - real(kind_phys), intent(inout), optional :: zsnsoxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: taussxy(:) + real(kind_phys), intent(inout), optional :: waxy(:) + real(kind_phys), intent(inout), optional :: wtxy(:) + real(kind_phys), intent(inout), optional :: zwtxy(:) + real(kind_phys), intent(inout), optional :: xlaixy(:) + real(kind_phys), intent(inout), optional :: xsaixy(:) + real(kind_phys), intent(inout), optional :: lfmassxy(:) + real(kind_phys), intent(inout), optional :: stmassxy(:) + real(kind_phys), intent(inout), optional :: rtmassxy(:) + real(kind_phys), intent(inout), optional :: woodxy(:) + real(kind_phys), intent(inout), optional :: stblcpxy(:) + real(kind_phys), intent(inout), optional :: fastcpxy(:) + real(kind_phys), intent(inout), optional :: smcwtdxy(:) + real(kind_phys), intent(inout), optional :: deeprechxy(:) + real(kind_phys), intent(inout), optional :: rechxy(:) + real(kind_phys), intent(inout), optional :: snowxy(:) + real(kind_phys), intent(inout), optional :: snicexy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: snliqxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: tsnoxy (:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: smoiseq(:,:) + real(kind_phys), intent(inout), optional :: zsnsoxy(:,lsnow_lsm_lbound:) real(kind_phys), intent(inout) :: slc(:,:) real(kind_phys), intent(inout) :: smc(:,:) real(kind_phys), intent(inout) :: stc(:,:) @@ -166,9 +167,11 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: canopy(:) real(kind_phys), intent(in) :: tg3(:) integer, intent(in) :: stype(:) + real(kind_phys), intent(in) :: con_t0c integer, intent(in) :: nthrds + logical, intent(inout) :: is_initialized character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -196,34 +199,28 @@ subroutine GFS_phys_time_vary_init ( !> - Call read_aerdata() to read aerosol climatology if (iaerclm) then - ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 - ! and used to allocate aer_nm matches the value defined in aerclm_def - if (size(aer_nm, dim=3).ne.ntrcaerm) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & - ntrcaerm, " /= ", size(aer_nm, dim=3) - errflg = 1 - else - ! Update the value of ntrcaer in aerclm_def with the value defined - ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If iaerclm is .true., then ntrcaer == ntrcaerm - ntrcaer = size(aer_nm, dim=3) - ! Read aerosol climatology - if(iaermdl==1) then - call read_aerdata (me,master,iflip,idate,errmsg,errflg) - elseif(iaermdl==6) then - call read_aerdata_dl (me,master,iflip,idate,fhour,errmsg,errflg) - end if - endif - if (errflg /= 0) return + ntrcaer = ntrcaerm + if(iaermdl == 1) then + call read_aerdata (me,master,iflip,idate,errmsg,errflg) + elseif (iaermdl == 6) then + call read_aerdata_dl(me,master,iflip, & + idate,fhour, errmsg,errflg) + end if + if(errflg/=0) return + else if(iaermdl ==2 ) then + do ix=1,ntrcaerm + do j=1,levs + do i=1,im + aer_nm(i,j,ix) = 1.e-20_kind_phys + end do + end do + end do + ntrcaer = ntrcaerm else - ! Update the value of ntrcaer in aerclm_def with the value defined - ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If iaerclm is .false., then ntrcaer == 1 - ntrcaer = size(aer_nm, dim=3) + ntrcaer = 1 endif -!> - Call iccninterp::read_cidata() to read IN and CCN data +!> - Call read_cidata() to read IN and CCN data if (iccn == 1) then call read_cidata (me,master) ! No consistency check needed for in/ccn data, all values are @@ -233,19 +230,22 @@ subroutine GFS_phys_time_vary_init ( !> - Call tau_amf dats for ugwp_v1 if (do_ugwp_v1) then call read_tau_amf(me, master, errmsg, errflg) + if(errflg/=0) return endif !> - Initialize soil vegetation (needed for sncovr calculation further down) call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) + if(errflg/=0) return !> - read in NoahMP table (needed for NoahMP init) if(lsm == lsm_noahmp) then - call read_mp_table_parameters(errmsg, errflg) + call read_mp_table_parameters(errmsg, errflg) + if(errflg/=0) return endif !> - Setup spatial interpolation indices for ozone physics. if (ntoz > 0) then - call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) + call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif !> - Call setindxh2o() to initialize stratospheric water vapor data @@ -315,8 +315,9 @@ subroutine GFS_phys_time_vary_init ( sncovr_ice(:) = sncovr(:) endif endif - + if (errflg/=0) return + if (iaerclm) then if (iaermdl==1) then call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg) @@ -477,10 +478,8 @@ subroutine GFS_phys_time_vary_init ( endif if (vegtyp == 15) then ! land ice in MODIS/IGBP - if (weasd(ix) < 0.1_kind_phys) then - weasd(ix) = 0.1_kind_phys - snd = 0.01_kind_phys - endif + weasd(ix) = 600.0_kind_phys ! 600mm SWE for glacier + snd = 2.0_kind_phys ! 2m snow depth for glacier endif if (snd < 0.025_kind_phys ) then @@ -525,7 +524,7 @@ subroutine GFS_phys_time_vary_init ( ! using stc and tgxy to linearly interpolate the snow temp for each layer do is = isnow,0 - tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(stc(ix,1)-tgxy(ix)) + tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(stc(ix,1)-tgxy(ix)) snliqxy(ix,is) = zero snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd enddo @@ -596,24 +595,25 @@ subroutine GFS_phys_time_vary_init ( endif noahmp_init endif lsm_init - ! Lake model +!Lake model if(lkm>0 .and. iopt_lake>0) then - ! A lake model is enabled. - do i = 1, im - !if (lakefrac(i) > 0.0 .and. lakedepth(i) > 1.0 ) then - ! The lake data must say there's a lake here (lakefrac) with a depth (lakedepth) - if (lakefrac(i) > lakefrac_threshold .and. lakedepth(i) > lakedepth_threshold ) then - ! This is a lake point. Inform the other schemes to use a lake model, and possibly nsst (lkm) - use_lake_model(i) = lkm - cycle - else - ! Not a valid lake point. - use_lake_model(i) = 0 - endif - enddo + ! A lake model is enabled. + do i = 1, im + !if (lakefrac(i) > 0.0 .and. lakedepth(i) > 1.0 ) then + + ! The lake data must say there's a lake here (lakefrac) with a depth (lakedepth) + if (lakefrac(i) > lakefrac_threshold .and. lakedepth(i) > lakedepth_threshold ) then + ! This is a lake point. Inform the other schemes to use a lake model, and possibly nsst (lkm) + use_lake_model(i) = lkm + cycle + else + ! Not a valid lake point. + use_lake_model(i) = 0 + endif + enddo else - ! Lake model is disabled or settings are invalid. - use_lake_model = 0 + ! Lake model is disabled or settings are invalid. + use_lake_model = 0 endif is_initialized = .true. @@ -645,21 +645,21 @@ function find_eq_smc(bexp, dwsat, dksat, ddz, smcmax) result(smc) end function find_eq_smc end subroutine GFS_phys_time_vary_init -!! @} +!> @} !> \section arg_table_GFS_phys_time_vary_timestep_init Argument Table !! \htmlinclude GFS_phys_time_vary_timestep_init.html !! !>\section gen_GFS_phys_time_vary_timestep_init GFS_phys_time_vary_timestep_init General Algorithm -!! @{ +!> @{ subroutine GFS_phys_time_vary_timestep_init ( & me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & - imfdeepcnv, cal_pre, random_clds, ozphys, h2ophys, ntoz, h2o_phys, iaerclm, iaermdl, iccn, clstp, & + imfdeepcnv, cal_pre, random_clds, ntoz, h2o_phys, iaerclm, iaermdl, iccn, clstp, & jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & - imap, jmap, prsl, seed0, rann, do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau,& - tau_amf, nthrds, errmsg, errflg) + imap, jmap, prsl, seed0, rann, nthrds, ozphys, h2ophys, do_ugwp_v1, jindx1_tau, & + jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, is_initialized, errmsg, errflg) implicit none @@ -670,14 +670,14 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(in) :: fhswr, fhour logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm real(kind_phys), intent(out) :: clstp - integer, intent(in), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(in), optional :: ddy_o3(:), ddy_h(:) + integer, intent(in), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in), optional :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) - integer, intent(in), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) - real(kind_phys), intent(in), optional :: ddy_aer(:), ddx_aer(:) + integer, intent(in), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(in), optional :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(inout) :: aer_nm(:,:,:) - integer, intent(in), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) - real(kind_phys), intent(in), optional :: ddy_ci(:), ddx_ci(:) + integer, intent(in), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(in), optional :: ddy_ci(:), ddx_ci(:) real(kind_phys), intent(inout) :: in_nm(:,:), ccn_nm(:,:) integer, intent(in) :: imap(:), jmap(:) real(kind_phys), intent(in) :: prsl(:,:) @@ -685,12 +685,13 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(inout) :: rann(:,:) logical, intent(in) :: do_ugwp_v1 - integer, intent(in), optional :: jindx1_tau(:), jindx2_tau(:) - real(kind_phys), intent(in), optional :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(in), optional :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(in), optional :: ddy_j1tau(:), ddy_j2tau(:) real(kind_phys), intent(inout) :: tau_amf(:) type(ty_ozphys), intent(in) :: ozphys type(ty_h2ophys), intent(in) :: h2ophys integer, intent(in) :: nthrds + logical, intent(in) :: is_initialized character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -701,7 +702,6 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys) :: rannie(cny) real(kind_phys) :: rndval(cnx*cny*nrcm) real(kind_dbl_prec) :: rinc(5) - real(kind_sngl_prec) :: rinc4(5) ! Initialize CCPP error handling variables errmsg = '' @@ -763,13 +763,7 @@ subroutine GFS_phys_time_vary_timestep_init ( idat(5)=idate(1) rinc=0. rinc(2)=fhour - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL w3movdat(rinc4,idat,jdat) - else - CALL w3movdat(rinc,idat,jdat) - endif + CALL w3movdat(rinc,idat,jdat) jdow = 0 jdoy = 0 jday = 0 @@ -779,14 +773,14 @@ subroutine GFS_phys_time_vary_timestep_init ( !> - Update ozone concentration. if (ntoz > 0) then - call find_photochemistry_index(ozphys%ntime, ozphys%time, rjday, n1, n2) + call find_photochem_time_index(ozphys%ntime, ozphys%time, rjday, n1, n2) call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) endif !> - Update stratospheric h2o concentration. if (h2o_phys) then - call find_photochemistry_index(h2ophys%ntime, h2ophys%time, rjday, n1, n2) + call find_photochem_time_index(h2ophys%ntime, h2ophys%time, rjday, n1, n2) call h2ophys%update(jindx1_h, jindx2_h, ddy_h, rjday, n1, n2, h2opl) endif @@ -813,37 +807,23 @@ subroutine GFS_phys_time_vary_timestep_init ( ! move into OpenMP parallel section above if (iaermdl==1) then call aerinterpol (me, master, nthrds, im, idate, & - fhour, iflip, jindx1_aer, jindx2_aer, & - ddy_aer, iindx1_aer, & - iindx2_aer, ddx_aer, & - levs, prsl, aer_nm, errmsg, errflg) - elseif (iaermdl==6) then - call aerinterpol_dl (me, master, nthrds, im, idate, & - fhour, iflip, jindx1_aer, jindx2_aer, & - ddy_aer, iindx1_aer, & - iindx2_aer, ddx_aer, & - levs, prsl, aer_nm, errmsg, errflg) + fhour, iflip, jindx1_aer, jindx2_aer, & + ddy_aer, iindx1_aer, & + iindx2_aer, ddx_aer, & + levs, prsl, aer_nm, errmsg, errflg) + else if (iaermdl==6) then + call aerinterpol_dl (me, master, nthrds, im, idate, & + fhour, iflip, jindx1_aer, jindx2_aer, & + ddy_aer, iindx1_aer, & + iindx2_aer, ddx_aer, & + levs, prsl, aer_nm, errmsg, errflg) endif + if(errflg /= 0) return endif - -! Not needed for SCM: -!> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs - ! if (nscyc > 0) then - ! if (mod(kdt,nscyc) == 1) THEN - ! call gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, & - ! input_nml_file, lsoil, lsoil_lsm, kice, idate, ialb, isot, ivegsrc, & - ! use_ufo, nst_anl, fhcyc, phour, landfrac, lakefrac, min_seaice, min_lakeice,& - ! frac_grid, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, tsfc, & - ! tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, & - ! zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, & - ! stype, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf, & - ! xlat_d, xlon_d, slmsk, imap, jmap) - ! endif - ! endif contains !> Find the time indexes on either side of current time - subroutine find_photochemistry_index(ntime, time, rjday, n1, n2) + subroutine find_photochem_time_index(ntime, time, rjday, n1, n2) implicit none !> The number of times provided in the parameter file integer, intent(in) :: ntime @@ -863,40 +843,21 @@ subroutine find_photochemistry_index(ntime, time, rjday, n1, n2) enddo n1 = n2 - 1 if (n2 > ntime) n2 = n2 - ntime - end subroutine find_photochemistry_index + end subroutine find_photochem_time_index end subroutine GFS_phys_time_vary_timestep_init -!! @} - -!> \section arg_table_GFS_phys_time_vary_timestep_finalize Argument Table -!! \htmlinclude GFS_phys_time_vary_timestep_finalize.html -!! -!>\section gen_GFS_phys_time_vary_timestep_finalize GFS_phys_time_vary_timestep_finalize General Algorithm -!! @{ - subroutine GFS_phys_time_vary_timestep_finalize (errmsg, errflg) - - implicit none - - ! Interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - end subroutine GFS_phys_time_vary_timestep_finalize -!! @} +!> @} !> \section arg_table_GFS_phys_time_vary_finalize Argument Table !! \htmlinclude GFS_phys_time_vary_finalize.html !! - subroutine GFS_phys_time_vary_finalize(errmsg, errflg) + subroutine GFS_phys_time_vary_finalize(is_initialized, errmsg, errflg) implicit none ! Interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + logical, intent(inout) :: is_initialized + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! Initialize CCPP error handling variables errmsg = '' @@ -923,4 +884,3 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) end subroutine GFS_phys_time_vary_finalize end module GFS_phys_time_vary -!> @} diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index 8c4159ce6..e86858a3f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -78,6 +78,13 @@ dimensions = () type = integer intent = in +[levs] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in [nx] standard_name = number_of_points_in_x_direction_for_this_MPI_rank long_name = number of points in x direction for this MPI rank @@ -115,20 +122,6 @@ type = real kind = kind_phys intent = in -[ozphys] - standard_name = dataset_for_ozone_physics - long_name = dataset for NRL ozone physics - units = mixed - dimensions = () - type = ty_ozphys - intent = in -[h2ophys] - standard_name = dataset_for_h2o_photochemistry_physics - long_name = dataset for NRL h2o photochemistry physics - units = mixed - dimensions = () - type = ty_h2ophys - intent = in [jindx1_o3] standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation low index for ozone @@ -252,7 +245,7 @@ dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys - intent = in + intent = out [jindx1_ci] standard_name = lower_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the y direction @@ -1034,6 +1027,27 @@ type = real kind = kind_phys intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed + dimensions = () + type = ty_h2ophys + intent = in +[is_initialized] + standard_name = flag_for_gfs_phys_time_vary_interstitial_initialization + long_name = flag carrying interstitial initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1054,6 +1068,13 @@ [ccpp-arg-table] name = GFS_phys_time_vary_finalize type = scheme +[is_initialized] + standard_name = flag_for_gfs_phys_time_vary_interstitial_initialization + long_name = flag carrying interstitial initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1479,6 +1500,13 @@ type = real kind = kind_phys intent = inout +[nthrds] + standard_name = number_of_openmp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer + intent = in [do_ugwp_v1] standard_name = flag_for_ugwp_version_1 long_name = flag to activate ver 1 CIRES UGWP @@ -1542,12 +1570,12 @@ dimensions = () type = ty_h2ophys intent = in -[nthrds] - standard_name = number_of_openmp_threads - long_name = number of OpenMP threads available for physics schemes - units = count +[is_initialized] + standard_name = flag_for_gfs_phys_time_vary_interstitial_initialization + long_name = flag carrying interstitial initialization status + units = flag dimensions = () - type = integer + type = logical intent = in [errmsg] standard_name = ccpp_error_message @@ -1564,23 +1592,3 @@ dimensions = () type = integer intent = out - -######################################################################## -[ccpp-arg-table] - name = GFS_phys_time_vary_timestep_finalize - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 index ddc3f7b54..1d6349571 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 @@ -28,13 +28,12 @@ module GFS_radiation_post !! \htmlinclude GFS_radiation_post_run.html !! !! This routine needs to be called AFTER the RRTMG (radlw_main.F90 and radsw_main.F90) -!! or the RRTMGP (rrtmgp_lw_main.F90 and rrtmgp_sw_main.F90) radiaiton schemes in the +!! or the RRTMGP (rrtmgp_lw_main.F90 and rrtmgp_sw_main.F90) radiation schemes in the !! CCPP enabled UFS. !! !! For RRTMG, not much is done here, since the scheme outputs the fields needed by the !! UFS. For example, RRTMG provides the heating-rate profiles and has been modified to use !! UFS native DDTs for storing the fluxes. -!! fluxes. !! !! For RRTMGP*: !! - The all-sky radiation tendency is computed. The clear-sky tendency is computed, if diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 index 5e8c5bc9d..9c0caa104 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 @@ -47,7 +47,7 @@ end subroutine GFS_radiation_surface_init !! \htmlinclude GFS_radiation_surface_run.html !! subroutine GFS_radiation_surface_run ( & - ialb, im, nf_albd, frac_grid, lslwr, lsswr, lsm, lsm_noahmp, & + ialb, im, frac_grid, lslwr, lsswr, lsm, lsm_noahmp, & lsm_ruc, xlat, xlon, slmsk, lndp_type, n_var_lndp, sfc_alb_pert,& lndp_var_list, lndp_prt_list, landfrac, snodl, snodi, sncovr, & sncovr_ice, fice, zorl, hprime, tsfg, tsfa, tisfc, coszen, & @@ -59,12 +59,11 @@ subroutine GFS_radiation_surface_run ( & semisbase, semis, sfcalb, sfc_alb_dif, errmsg, errflg) use module_radiation_surface, only: f_zero, f_one, & - epsln, & setemis, setalb implicit none - integer, intent(in) :: im, nf_albd, ialb + integer, intent(in) :: im, ialb logical, intent(in) :: frac_grid, lslwr, lsswr, use_cice_alb, cplice integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice, con_ttp @@ -181,8 +180,7 @@ subroutine GFS_radiation_surface_run ( & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & - im, nf_albd, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, ialb, & - con_ttp, & ! --- inputs + im, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, ialb, con_ttp, & ! --- inputs sfcalb ) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta index 5e4047071..7e04bc8d2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta @@ -81,13 +81,6 @@ dimensions = () type = integer intent = in -[nf_albd] - standard_name = number_of_components_for_surface_albedo - long_name = number of IR/VIS/UV compinents for surface albedo - units = count - dimensions = () - type = integer - intent = in [frac_grid] standard_name = flag_for_fractional_landmask long_name = flag for fractional grid diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 index 408dd22a2..754fe12bb 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 @@ -33,7 +33,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, idcor_hogan, & idcor_oreopoulos, dcorr_con, julian, yearlen, lndp_var_list, lsswr, & lslwr, ltaerosol, mraerosol, lgfdlmprad, uni_cld, effr_in, do_mynnedmf,& - lmfshal, lcnorm, lmfdeep2, lcrick, fhswr, fhlwr, solhr, sup, con_eps, & + lmfshal, lcnorm, lmfdeep2, lcrick, fhswr, fhlwr, solhr, sup, xr_con, & + xr_exp, con_eps, & epsm1, fvirt, rog, rocp, con_rd, xlat_d, xlat, xlon, coslat, sinlat, & tsfc, slmsk, prsi, prsl, prslk, tgrs, sfc_wts, mg_cld, effrr_in, & pert_clds, sppt_wts, sppt_amp, cnvw_in, cnvc_in, qgrs, aer_nm, dx, & @@ -159,7 +160,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& integer, intent(in) :: spp_rad real(kind_phys), intent(in), optional :: spp_wts_rad(:,:) - real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp, dcorr_con + real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp, dcorr_con, xr_con, xr_exp real(kind=kind_phys), intent(in) :: con_eps, epsm1, fvirt, rog, rocp, con_rd, con_pi, con_g, con_ttp, con_thgni real(kind=kind_phys), dimension(:), intent(in) :: xlat_d, xlat, xlon, & @@ -1051,7 +1052,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& & effrl_inout, effri_inout, effrs_inout, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzb, xlat_d, julian, yearlen, gridkm, top_at_1, si, & - & con_ttp, con_pi, con_g, con_rd, con_thgni, & + & xr_con, xr_exp, con_ttp, con_pi, con_g, con_rd, con_thgni, & & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & ! --- outputs: & cld_rwp, cld_rerain, cld_swp, cld_resnow, & ! --- outputs: & cldsa, mtopa, mbota, de_lgth, alpha & ! --- outputs: diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index 44ea7c39b..697aadfb5 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -750,6 +750,22 @@ type = real kind = kind_phys intent = in +[xr_con] + standard_name = multiplicative_tuning_parameter_for_Xu_Randall_cloud_fraction + long_name = multiplicative tuning parameter for Xu Randall cloud fraction + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in +[xr_exp] + standard_name = exponent_tuning_parameter_for_Xu_Randall_cloud_fraction + long_name = exponent tuning parameter for Xu Randall cloud fraction + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [con_eps] standard_name = ratio_of_dry_air_to_water_vapor_gas_constants long_name = rd/rv diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 index 974e9dc71..37311d958 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 @@ -62,7 +62,7 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc zmtnblck, sppt_wts, skebu_wts, skebv_wts, shum_wts,& diss_est, ugrs, vgrs, tgrs, qgrs_wv, & qgrs_cw, qgrs_rw, qgrs_sw, qgrs_iw, qgrs_gl, & - gu0, gv0, gt0, gq0_wv, dtdtnp, & + gu0, gv0, gt0, gq0_wv, dtdtnp, num_diag_buckets, & gq0_cw, gq0_rw, gq0_sw, gq0_iw, gq0_gl, & rain, rainc, tprcp, totprcp, cnvprcp, & totprcpb, cnvprcpb, cplflx, cpllnd, & @@ -85,6 +85,7 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc logical, intent(in) :: use_zmtnblck logical, intent(in) :: do_shum logical, intent(in) :: do_skeb + integer, intent(in) :: num_diag_buckets real(kind_phys), dimension(:), intent(in) :: zmtnblck ! sppt_wts only allocated if do_sppt == .true. real(kind_phys), dimension(:,:), intent(inout), optional :: sppt_wts @@ -123,8 +124,8 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc real(kind_phys), dimension(:), intent(inout) :: tprcp real(kind_phys), dimension(:), intent(inout) :: totprcp real(kind_phys), dimension(:), intent(inout) :: cnvprcp - real(kind_phys), dimension(:), intent(inout) :: totprcpb - real(kind_phys), dimension(:), intent(inout) :: cnvprcpb + real(kind_phys), dimension(:,:), intent(inout) :: totprcpb + real(kind_phys), dimension(:,:), intent(inout) :: cnvprcpb logical, intent(in) :: cplflx logical, intent(in) :: cpllnd ! rain_cpl only allocated if cplflx == .true. or cplchm == .true. or cpllnd == .true. @@ -140,7 +141,7 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc integer, intent(out) :: errflg !--- local variables - integer :: k, i + integer :: k, i, ib real(kind=kind_phys) :: upert, vpert, tpert, qpert, qnew, sppt_vwt real(kind=kind_phys), dimension(1:im,1:km) :: ca @@ -234,11 +235,13 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc ! instantaneous precip rate going into land model at the next time step tprcp(:) = sppt_wts(:,15)*tprcp(:) totprcp(:) = totprcp(:) + (sppt_wts(:,15) - 1 )*rain(:) - ! acccumulated total and convective preciptiation + ! convective precipitation cnvprcp(:) = cnvprcp(:) + (sppt_wts(:,15) - 1 )*rainc(:) ! bucket precipitation adjustment due to sppt - totprcpb(:) = totprcpb(:) + (sppt_wts(:,15) - 1 )*rain(:) - cnvprcpb(:) = cnvprcpb(:) + (sppt_wts(:,15) - 1 )*rainc(:) + do ib=1,num_diag_buckets + totprcpb(:,ib) = totprcpb(:,ib) + (sppt_wts(:,15) - 1 )*rain(:) + cnvprcpb(:,ib) = cnvprcpb(:,ib) + (sppt_wts(:,15) - 1 )*rainc(:) + enddo if (cplflx .or. cpllnd) then rain_cpl(:) = rain_cpl(:) + (sppt_wts(:,15) - 1.0)*drain_cpl(:) @@ -338,11 +341,13 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc ! instantaneous precip rate going into land model at the next time step tprcp(:) = ca(:,15)*tprcp(:) totprcp(:) = totprcp(:) + (ca(:,15) - 1 )*rain(:) - ! acccumulated total and convective preciptiation - cnvprcp(:) = cnvprcp(:) + (ca(:,15) - 1 )*rainc(:) - ! bucket precipitation adjustment due to sppt - totprcpb(:) = totprcpb(:) + (ca(:,15) - 1 )*rain(:) - cnvprcpb(:) = cnvprcpb(:) + (ca(:,15) - 1 )*rainc(:) + ! convective precipitation + cnvprcp(:) = cnvprcp(:) + (ca(:,15) - 1 )*rainc(:) + ! bucket precipitation adjustment due to sppt + do ib=1,num_diag_buckets + totprcpb(:,ib) = totprcpb(:,ib) + (ca(:,15) - 1 )*rain(:) + cnvprcpb(:,ib) = cnvprcpb(:,ib) + (ca(:,15) - 1 )*rainc(:) + enddo if (cplflx .or. cpllnd) then rain_cpl(:) = rain_cpl(:) + (ca(:,15) - 1.0)*drain_cpl(:) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta index 904030522..19f1911f2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta @@ -83,6 +83,13 @@ dimensions = () type = integer intent = in +[num_diag_buckets] + standard_name = number_of_diagnostic_buckets + long_name = number of diagnostic bucket reset periods + units = count + dimensions = () + type = integer + intent = in [delt] standard_name = timestep_for_physics long_name = physics timestep @@ -406,7 +413,7 @@ standard_name = accumulated_lwe_thickness_of_precipitation_amount_in_bucket long_name = accumulated total precipitation in bucket units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_diagnostic_buckets) type = real kind = kind_phys intent = inout @@ -414,7 +421,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket long_name = cumulative convective precipitation in bucket units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_diagnostic_buckets) type = real kind = kind_phys intent = inout diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 index 5ceeb6ac8..4cb2a017b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 @@ -18,7 +18,7 @@ module GFS_surface_composites_inter !! subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis_lnd, semis_ice, & adjsfcdlw, gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat,& - adjsfcusw, adjsfcdsw, adjsfcnsw, use_lake_model, errmsg, errflg) + adjsfcusw, adjsfcdsw, adjsfcnsw, errmsg, errflg) implicit none @@ -30,7 +30,6 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis adjsfcdlw, adjsfcdsw, adjsfcnsw real(kind=kind_phys), dimension(:), intent(inout) :: gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat real(kind=kind_phys), dimension(:), intent(out) :: adjsfcusw - integer, dimension(:), intent(in) :: use_lake_model ! CCPP error handling character(len=*), intent(out) :: errmsg diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta index ef3005583..d24779ac6 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta @@ -116,13 +116,6 @@ type = real kind = kind_phys intent = in -[use_lake_model] - standard_name = flag_for_using_lake_model - long_name = flag indicating lake points using a lake model - units = flag - dimensions = (horizontal_loop_extent) - type = integer - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 index 74ebcb709..a28a6906e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 @@ -238,13 +238,12 @@ subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k) integer, intent(in) :: im,levs real (kind=kind_phys), intent(in) :: grav real (kind=kind_phys), intent(in),dimension(:,:) :: phil,ref3D,tk - integer :: i,k,ll,ipt,kpt + real (kind=kind_phys), intent(inout),dimension(:) :: refd,refd263k + ! Local + integer :: i,k,ll real :: dbz1avg,zmidp1,zmidloc,refl,fact real, dimension(im,levs) :: z - real, dimension(im) :: zintsfc - real, dimension(:), intent(inout) :: refd,refd263k - REAL :: dbz1(2),dbzk,dbzk1 - logical :: counter + REAL :: dbz1(2) do i=1,im do k=1,levs z(i,k)=phil(i,k)/grav diff --git a/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 b/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 index 7d23ad5d4..43c98026b 100644 --- a/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 +++ b/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 @@ -108,9 +108,7 @@ MODULE MODULE_MP_FER_HIRES ! !----------------------------------------------------------------------------- -#ifdef MPI - USE mpi_f08 -#endif + USE mpi_f08 USE machine !MZ !MZ USE MODULE_CONSTANTS,ONLY : PI, CP, EPSQ, GRAV=>G, RHOL=>RHOWATER, & @@ -2447,9 +2445,7 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & ! !----------------------------------------------------------------------- ! -#ifdef MPI use mpi_f08 -#endif IMPLICIT NONE ! !------------------------------------------------------------------------- @@ -2507,9 +2503,7 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & if (.NOT. ALLOCATED(vsnowi)) ALLOCATE(vsnowi(MDImin:MDImax)) if (.NOT. ALLOCATED(vel_rf)) ALLOCATE(vel_rf(2:9,0:Nrime)) -#ifdef MPI call MPI_BARRIER(MPI_COMM_COMP,ierr) -#endif only_root_reads: if (MPIRANK==MPIROOT) then force_read_ferhires = .true. @@ -2567,7 +2561,6 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & ENDIF endif only_root_reads ! -#ifdef MPI CALL MPI_BCAST(VENTR1,SIZE(VENTR1),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VENTR2,SIZE(VENTR2),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(ACCRR, SIZE(ACCRR), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) @@ -2580,7 +2573,6 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & CALL MPI_BCAST(MASSI, SIZE(MASSI), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VSNOWI,SIZE(VSNOWI),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VEL_RF,SIZE(VEL_RF),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) -#endif ! !--- Calculates coefficients for growth rates of ice nucleated in water diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index 74e6c780f..d8db24d99 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -40,9 +40,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & use module_mp_nssl_2mom, only: nssl_2mom_init, nssl_2mom_init_const -#ifdef MPI use mpi_f08 -#endif implicit none @@ -179,9 +177,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & IF ( .not. missing_vars .and. Any( qr > qmin .and. crw == 0.0 ) ) missing_vars = .true. IF ( .not. missing_vars .and. Any( qh > qmin .and. (chw == 0.0 .or. vh == 0.0) ) ) missing_vars = .true. -#ifdef MPI call MPI_Allreduce(missing_vars, missing_vars_global, 1, MPI_LOGICAL, MPI_LOR, mpicomm, ierr) -#endif is_initialized = .true. return diff --git a/physics/MP/Thompson/module_mp_thompson.F90 b/physics/MP/Thompson/module_mp_thompson.F90 index 358558e33..d78d9689c 100644 --- a/physics/MP/Thompson/module_mp_thompson.F90 +++ b/physics/MP/Thompson/module_mp_thompson.F90 @@ -62,9 +62,7 @@ module module_mp_thompson use machine, only: wp => kind_phys, sp => kind_sngl_prec, dp => kind_dbl_prec use module_mp_radar -#ifdef MPI - use mpi_f08 -#endif + use mpi_f08 implicit none @@ -1905,9 +1903,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qgten1, qiten1, niten1, nrten1, ncten1, qcten1, & pfil1, pfll1) -#ifdef MPI use mpi_f08 -#endif implicit none @@ -4404,9 +4400,7 @@ subroutine qr_acr_qg good = 0 INQUIRE(FILE=qr_acr_qg_file, EXIST=lexist) -#ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) -#endif IF ( lexist ) THEN OPEN(63,file=qr_acr_qg_file,form="unformatted",err=1234) !sms$serial begin @@ -4579,9 +4573,7 @@ subroutine qr_acr_qs good = 0 INQUIRE(FILE=qr_acr_qs_file, EXIST=lexist) -#ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) -#endif IF ( lexist ) THEN !write(0,*) "ThompMP: read "//qr_acr_qs_file//" instead of computing" OPEN(63,file=qr_acr_qs_file,form="unformatted",err=1234) @@ -4840,9 +4832,7 @@ subroutine freezeH2O(threads) good = 0 INQUIRE(FILE=freeze_h2o_file,EXIST=lexist) -#ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) -#endif IF ( lexist ) THEN !write(0,*) "ThompMP: read "//freeze_h2o_file//" instead of computing" OPEN(63,file=freeze_h2o_file,form="unformatted",err=1234) diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.F b/physics/PBL/SATMEDMF/satmedmfvdifq.F index 73991e27d..5ebb947ac 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.F +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.F @@ -3051,16 +3051,18 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ! dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend enddo enddo - do i = 1,im - if(.not. use_oceanuv) then - dusfc(i) = -1.*rho_a(i)*stress(i)*u1(i,1)/spd1(i) - dvsfc(i) = -1.*rho_a(i)*stress(i)*v1(i,1)/spd1(i) - else if (use_oceanuv) then + if (use_oceanuv) then + do i = 1,im spd1_m=sqrt( (u1(i,1)-usfco(i))**2+(v1(i,1)-vsfco(i))**2 ) dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-usfco(i))/spd1_m dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-vsfco(i))/spd1_m - endif - enddo + enddo + else + do i = 1,im + dusfc(i) = -1.*rho_a(i)*stress(i)*u1(i,1)/spd1(i) + dvsfc(i) = -1.*rho_a(i)*stress(i)*v1(i,1)/spd1(i) + enddo + endif ! if(ldiag3d .and. .not. gen_tend) then idtend = dtidx(index_of_x_wind,index_of_process_pbl) diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 index 02757d904..fd28b11b7 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 @@ -12,9 +12,7 @@ module rrtmgp_lw_cloud_optics use rrtmgp_lw_gas_optics, only: lw_gas_props use radiation_tools, only: check_error_msg use netcdf -#ifdef MPI use mpi_f08 -#endif implicit none @@ -88,9 +86,7 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP longwave cloud-optics metadata ... ' ! Open file @@ -116,7 +112,6 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len=npairsLW) -#ifdef MPI endif ! On master processor ! Other processors waiting... @@ -136,14 +131,11 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, call mpi_bcast(nCoeff_ssa_gLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nBoundLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nPairsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! Has the number of ice-roughnesses to use been provided from the namelist? ! If so, override nrghice from cloud-optics file if (nrghice .ne. 0) nrghice_fromfileLW = nrghice -#ifdef MPI call mpi_bcast(nrghice_fromfileLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! ####################################################################################### ! @@ -165,9 +157,7 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif ! Read in fields from file write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) @@ -195,7 +185,6 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, ! Close file status = nf90_close(ncid) -#ifdef MPI endif ! Master process ! Other processors waiting... @@ -238,8 +227,6 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, call mpi_bcast(lut_exticeLW, size(lut_exticeLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(lut_ssaiceLW, size(lut_ssaiceLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(lut_asyiceLW, size(lut_asyiceLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) -#endif - #endif ! ####################################################################################### diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 index 38bb59d8d..f9de18830 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 @@ -11,9 +11,7 @@ module rrtmgp_lw_gas_optics use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg use netcdf -#ifdef MPI use mpi_f08 -#endif implicit none @@ -113,9 +111,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP longwave k-distribution metadata ... ' ! Open file @@ -154,7 +150,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_upperLW) status = nf90_inq_dimid(ncid, 'temperature_Planck', dimid) status = nf90_inquire_dimension(ncid, dimid, len = ninternalSourcetempsLW) -#ifdef MPI endif ! On master processor ! Other processors waiting... @@ -182,7 +177,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, call mpi_bcast(ncontributors_lowerLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(ncontributors_upperLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nfit_coeffsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! Allocate space for arrays if (.not. allocated(gas_namesLW)) & @@ -254,9 +248,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_namesLW) @@ -334,7 +326,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, if (temp4(ii) .eq. 0) scale_by_complement_upperLW(ii) = .false. if (temp4(ii) .eq. 1) scale_by_complement_upperLW(ii) = .true. enddo -#ifdef MPI endif ! Master process ! Other processors waiting... @@ -452,7 +443,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, size(scale_by_complement_upperLW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) call mpi_barrier(mpicomm, mpierr) -#endif ! ####################################################################################### ! diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 index 67c5564f3..402631b88 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 @@ -8,9 +8,7 @@ module rrtmgp_sw_cloud_optics use rrtmgp_sw_gas_optics, only: sw_gas_props use radiation_tools, only: check_error_msg use netcdf -#ifdef MPI use mpi_f08 -#endif implicit none @@ -84,9 +82,7 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP shortwave cloud-optics metadata ... ' ! Open file @@ -111,7 +107,6 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, status = nf90_inquire_dimension(ncid, dimid, len=nBoundSW) status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len=nPairsSW) -#ifdef MPI endif ! On master processor ! Other processors waiting... @@ -131,14 +126,11 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, call mpi_bcast(nCoeff_ssa_gSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nBoundSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nPairsSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! Has the number of ice-roughnes categories been provided from the namelist? ! If so, override nrghice from cloud-optics file if (nrghice .ne. 0) nrghice_fromfileSW = nrghice -#ifdef MPI call mpi_bcast(nrghice_fromfileSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! ####################################################################################### ! @@ -160,9 +152,7 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif + if (mpirank .eq. mpiroot) then write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) status = nf90_get_var(ncid,varID,radliq_lwrSW) @@ -190,7 +180,6 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, ! Close file status = nf90_close(ncid) -#ifdef MPI endif ! Master process ! Other processors waiting... @@ -235,7 +224,6 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, call mpi_bcast(lut_asyiceSW, size(lut_asyiceSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) #endif -#endif ! ####################################################################################### ! ! Initialize RRTMGP DDT's... diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 index 0decbc6e3..d5fb525f2 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 @@ -9,9 +9,7 @@ module rrtmgp_sw_gas_optics use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg use netcdf -#ifdef MPI use mpi_f08 -#endif implicit none real(wp),parameter :: & @@ -124,9 +122,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP shortwave k-distribution metadata ... ' ! Open file @@ -162,7 +158,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upperSW) -#ifdef MPI endif ! On master processor ! Other processors waiting... @@ -188,7 +183,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, call mpi_bcast(ncontributors_lowerSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nminor_absorber_intervals_upperSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nminor_absorber_intervals_lowerSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! ####################################################################################### ! @@ -269,9 +263,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_namesSW) @@ -368,7 +360,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, ! Close status = nf90_close(ncid) -#ifdef MPI endif ! Master process ! Other processors waiting... @@ -500,7 +491,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, size(scale_by_complement_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) call mpi_barrier(mpicomm, mpierr) -#endif ! ####################################################################################### ! diff --git a/physics/Radiation/radiation_aerosols.f b/physics/Radiation/radiation_aerosols.f index d1df168a5..ce5054c99 100644 --- a/physics/Radiation/radiation_aerosols.f +++ b/physics/Radiation/radiation_aerosols.f @@ -1190,6 +1190,15 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) allocate ( ssarhd (NRHLEV,NCM2,NSWLWBD) ) allocate ( asyrhd (NRHLEV,NCM2,NSWLWBD) ) allocate ( extstra( NSWLWBD) ) + extrhi = f_zero + scarhi = f_zero + ssarhi = f_zero + asyrhi = f_zero + extrhd = f_zero + scarhd = f_zero + ssarhd = f_zero + asyrhd = f_zero + extstra = f_zero endif !> - ending wave num for 61 aerosol spectral bands @@ -1285,7 +1294,9 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) endif enddo -!$omp parallel do private(ib,mb,ii,iw1,iw2,iw,sumsol,fac,tmp,ibs,ibe) +! Turn off OpenMP due to b4b differences with Intel LLVM 2025.2+ +! https://github.com/NCAR/ccpp-physics/issues/1170 +!!! !$omp parallel do private(ib,mb,ii,iw1,iw2,iw,sumsol,fac,tmp,ibs,ibe) do ib = 1, NSWBND mb = ib + NSWSTR - 1 ii = 1 @@ -1372,8 +1383,9 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) endif enddo endif - -!$omp parallel do private(ib,ii,iw1,iw2,iw,mb,sumir,fac,tmp,ibs,ibe) +! Turn off OpenMP due to b4b differences with Intel LLVM 2025.2+ +! https://github.com/NCAR/ccpp-physics/issues/1170 +!!! !$omp parallel do private(ib,ii,iw1,iw2,iw,mb,sumir,fac,tmp,ibs,ibe) do ib = 1, NLWBND ii = 1 if ( NLWBND == 1 ) then @@ -2280,33 +2292,11 @@ subroutine setaer & errmsg = '' errflg = 0 - do m = 1, NF_AESW - do j = 1, NBDSW - do k = 1, NLAY - do i = 1, IMAX - aerosw(i,k,j,m) = f_zero - enddo - enddo - enddo - enddo - - do m = 1, NF_AELW - do j = 1, NBDLW - do k = 1, NLAY - do i = 1, IMAX - aerolw(i,k,j,m) = f_zero - enddo - enddo - enddo - enddo - + aerosw = f_zero + aerolw = f_zero ! sumodp = f_zero - do i = 1, IMAX - do k = 1, NSPC1 - aerodp(i,k) = f_zero - enddo - enddo - ext550(:,:) = f_zero + aerodp = f_zero + ext550 = f_zero if ( .not. (lsswr .or. lslwr) ) then return @@ -2409,7 +2399,6 @@ subroutine setaer & endif ! end if_iaerflg_block if(errflg/=0) return - ! --- check print ! do m = 1, NBDSW ! print *,' *** CHECK AEROSOLS PROPERTIES FOR SW BAND =',m, & diff --git a/physics/Radiation/radiation_clouds.f b/physics/Radiation/radiation_clouds.f index 1175353de..d779d56c2 100644 --- a/physics/Radiation/radiation_clouds.f +++ b/physics/Radiation/radiation_clouds.f @@ -357,7 +357,7 @@ subroutine radiation_clouds_prop & & effrl_inout, effri_inout, effrs_inout, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, latdeg, julian, yearlen, gridkm, top_at_1, si, & - & con_ttp, con_pi, con_g, con_rd, con_thgni, & + & xr_con, xr_exp, con_ttp, con_pi, con_g, con_rd, con_thgni, & & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & ! --- outputs: & cld_rwp, cld_rerain, cld_swp, cld_resnow, & & clds, mtop, mbot, de_lgth, alpha & @@ -552,7 +552,7 @@ subroutine radiation_clouds_prop & & delp, dz, effrl, effri, effrr, effrs, dzlay, clouds1 real (kind=kind_phys), intent(in) :: sup, dcorr_con, con_ttp, & - & con_pi, con_g, con_rd, con_thgni + & con_pi, con_g, con_rd, con_thgni, xr_con, xr_exp real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk, si @@ -589,10 +589,6 @@ subroutine radiation_clouds_prop & integer :: i, k, id, nf -! --- constant values -! real (kind=kind_phys), parameter :: xrc3 = 200. - real (kind=kind_phys), parameter :: xrc3 = 100. - ! !===> ... begin here ! @@ -640,7 +636,7 @@ subroutine radiation_clouds_prop & call progcld_zhao_carr (plyr ,plvl, tlyr, tvly, qlyr, & ! --- inputs & qstl, rhly, ccnd(1:IX,1:NLAY,1), xlat, xlon, & & slmsk, dz, delp, IX, NLAY, NLP1, uni_cld, & - & lmfshal, lmfdeep2, & + & lmfshal, lmfdeep2, xr_con, xr_exp, & & cldcov, effrl, effri, effrr, effrs, effr_in, & & dzlay, & & cldtot, cldcnv, lcrick, lcnorm, con_ttp, & ! inout @@ -694,7 +690,7 @@ subroutine radiation_clouds_prop & call progcld_fer_hires (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly, & ! --- inputs & tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & IX,NLAY,NLP1, icloud, uni_cld, & + & IX,NLAY,NLP1, icloud, xr_con, xr_exp, uni_cld,& & lmfshal, lmfdeep2, & & cldcov(:,1:NLAY),effrl_inout(:,:), & & effri_inout(:,:), effrs_inout(:,:), & @@ -733,7 +729,8 @@ subroutine radiation_clouds_prop & & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & - & IX, NLAY, NLP1, uni_cld, lmfshal, lmfdeep2, & + & IX, NLAY, NLP1, xr_con, xr_exp, uni_cld, & + & lmfshal, lmfdeep2, & & cldcov(:,1:NLAY), cnvw, effrl_inout, & & effri_inout, effrs_inout, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & @@ -808,7 +805,8 @@ subroutine radiation_clouds_prop & & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & - & IX, NLAY, NLP1, uni_cld, lmfshal, lmfdeep2, & + & IX, NLAY, NLP1, xr_con, xr_exp, uni_cld, & + & lmfshal, lmfdeep2, & & cldcov(:,1:NLAY), cnvw, effrl, effri, effrs, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, & @@ -887,7 +885,7 @@ end subroutine radiation_clouds_prop subroutine progcld_zhao_carr & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, & - & uni_cld, lmfshal, lmfdeep2, cldcov, & + & uni_cld, lmfshal, lmfdeep2, xr_con, xr_exp, cldcov, & & effrl,effri,effrr,effrs,effr_in, & & dzlay, cldtot, cldcnv, lcrick, lcnorm, con_ttp, & & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs @@ -979,7 +977,7 @@ subroutine progcld_zhao_carr & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk - real (kind=kind_phys), intent(in) :: con_ttp + real (kind=kind_phys), intent(in) :: con_ttp, xr_con, xr_exp ! --- inputs/outputs @@ -996,10 +994,6 @@ subroutine progcld_zhao_carr & integer :: i, k, id, nf -! --- constant values -! real (kind=kind_phys), parameter :: xrc3 = 200. - real (kind=kind_phys), parameter :: xrc3 = 100. - ! !===> ... begin here ! @@ -1094,11 +1088,12 @@ subroutine progcld_zhao_carr & if (.not. lmfshal) then call cloud_fraction_XuRandall & - & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs else call cloud_fraction_mass_flx_1 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, lmfdeep2, xr_con, xr_exp, plyr, clwf, rhly, & + & qstl, & ! --- inputs & cldtot ) endif @@ -1719,7 +1714,7 @@ subroutine progcld_fer_hires & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw, & - & IX, NLAY, NLP1, icloud, & + & IX, NLAY, NLP1, icloud, xr_con, xr_exp, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & & dzlay, cldtot, cldcnv, lcnorm, & @@ -1802,6 +1797,7 @@ subroutine progcld_fer_hires & logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, lcnorm + real (kind=kind_phys), intent(in) :: xr_con, xr_exp real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, cldcov, delp, dz, dzlay @@ -1828,10 +1824,6 @@ subroutine progcld_fer_hires & integer :: i, k, id, nf -! --- constant values -! real (kind=kind_phys), parameter :: xrc3 = 200. - real (kind=kind_phys), parameter :: xrc3 = 100. - ! !===> ... begin here ! @@ -1902,12 +1894,13 @@ subroutine progcld_fer_hires & if (.not. lmfshal) then call cloud_fraction_XuRandall & - & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs else call cloud_fraction_mass_flx_1 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs - & cldtot ) + & ( IX, NLAY, lmfdeep2, xr_con, xr_exp, plyr, clwf, rhly, & + & qstl, & ! --- inputs + & cldtot ) & ! --- outputs endif endif ! if (uni_cld) then @@ -1965,7 +1958,7 @@ subroutine progcld_thompson_wsm6 & & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,con_ttp, & - & xr_cnvcld, IX, NLAY, NLP1, & + & xr_cnvcld, IX, NLAY, NLP1, xr_con, xr_exp, & & uni_cld, lmfshal, lmfdeep2, cldcov, cnvw, & & re_cloud,re_ice,re_snow, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & @@ -2065,7 +2058,7 @@ subroutine progcld_thompson_wsm6 & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk - real (kind=kind_phys), intent(in) :: con_ttp + real (kind=kind_phys), intent(in) :: con_ttp, xr_con, xr_exp ! --- inputs/outputs real (kind=kind_phys), dimension(:,:), intent(inout) :: & @@ -2082,7 +2075,6 @@ subroutine progcld_thompson_wsm6 & integer :: i, k, id, nf ! --- constant values - real (kind=kind_phys), parameter :: xrc3 = 2000. real (kind=kind_phys), parameter :: snow2ice = 0.25 real (kind=kind_phys), parameter :: coef_t = 0.025 ! @@ -2205,11 +2197,12 @@ subroutine progcld_thompson_wsm6 & if (.not. lmfshal) then call cloud_fraction_XuRandall & - & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs else call cloud_fraction_mass_flx_2 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, lmfdeep2, xr_con, xr_exp, plyr, clwf, rhly, & + & qstl, & ! --- inputs & cldtot ) endif @@ -3739,11 +3732,12 @@ END SUBROUTINE adjust_cloudFinal !> This subroutine computes the Xu-Randall cloud fraction scheme. subroutine cloud_fraction_XuRandall & - & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs ! --- inputs: integer, intent(in) :: IX, NLAY + real (kind=kind_phys), intent(in) :: xr_con, xr_exp real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & & rhly, qstl @@ -3768,11 +3762,11 @@ subroutine cloud_fraction_XuRandall & onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) - tem1 = 2000.0 / tem1 + tem1 = min(max((onemrh*qstl(i,k))**xr_exp,0.0001),1.0) + tem1 = xr_con / tem1 value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) + tem2 = sqrt(sqrt(rhly(i,k))) cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) endif @@ -3783,12 +3777,12 @@ end subroutine cloud_fraction_XuRandall !> subroutine cloud_fraction_mass_flx_1 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, lmfdeep2, xrc3, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs ! --- inputs: integer, intent(in) :: IX, NLAY - real (kind=kind_phys), intent(in) :: xrc3 + real (kind=kind_phys), intent(in) :: xrc3, xr_exp real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & & rhly, qstl logical, intent(in) :: lmfdeep2 @@ -3814,7 +3808,7 @@ subroutine cloud_fraction_mass_flx_1 & onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) ! - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan + tem1 = min(max((onemrh*qstl(i,k))**xr_exp,0.0001),1.0) !jhan if (lmfdeep2) then tem1 = xrc3 / tem1 else @@ -3833,12 +3827,12 @@ end subroutine cloud_fraction_mass_flx_1 !> subroutine cloud_fraction_mass_flx_2 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, lmfdeep2, xrc3, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs ! --- inputs: integer, intent(in) :: IX, NLAY - real (kind=kind_phys), intent(in) :: xrc3 + real (kind=kind_phys), intent(in) :: xrc3, xr_exp real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & & rhly, qstl logical, intent(in) :: lmfdeep2 @@ -3866,7 +3860,7 @@ subroutine cloud_fraction_mass_flx_2 & onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) + tem1 = min(max((onemrh*qstl(i,k))**xr_exp,0.0001),1.0) if (lmfdeep2) then tem1 = xrc3 / tem1 else diff --git a/physics/Radiation/radiation_surface.f b/physics/Radiation/radiation_surface.f index 8bbfd6ed5..3f62b66fc 100644 --- a/physics/Radiation/radiation_surface.f +++ b/physics/Radiation/radiation_surface.f @@ -348,7 +348,7 @@ subroutine setalb & & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & - & IMAX, NF_ALBD, albPpert, pertalb, fracl, fraco, fraci, icy,& + & IMAX, albPpert, pertalb, fracl, fraco, fraci, icy, & & ialbflg, con_ttp, & & sfcalb & ! --- outputs: & ) @@ -413,7 +413,7 @@ subroutine setalb & implicit none ! --- inputs - integer, intent(in) :: IMAX, NF_ALBD, ialbflg + integer, intent(in) :: IMAX, ialbflg integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in) :: use_cice_alb, frac_grid @@ -434,8 +434,7 @@ subroutine setalb & & icy ! --- outputs - real (kind=kind_phys), dimension(IMAX,NF_ALBD), intent(out) :: & - & sfcalb + real (kind=kind_phys), dimension(:,:), intent(out) :: sfcalb ! --- locals: real (kind=kind_phys) :: asnvb, asnnb, asnvd, asnnd, asevb & @@ -803,8 +802,6 @@ subroutine setemis & ! ! ! ==================== end of description ===================== ! ! - use set_soilveg_ruc_mod, only: set_soilveg_ruc - use namelist_soilveg_ruc implicit none diff --git a/physics/SFC_Layer/UFS/sfc_diag.f b/physics/SFC_Layer/UFS/sfc_diag.f index e54b29b23..4c019f433 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.f +++ b/physics/SFC_Layer/UFS/sfc_diag.f @@ -89,13 +89,14 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & do i = 1, im f10m(i) = fm10(i) / fm(i) - if (.not. use_oceanuv) then - u10m(i) = f10m(i) * u1(i) - v10m(i) = f10m(i) * v1(i) - else if (use_oceanuv) then + if (use_oceanuv) then u10m(i) = usfco(i)+f10m(i) * (u1(i)-usfco(i)) v10m(i) = vsfco(i)+f10m(i) * (v1(i)-vsfco(i)) + else + u10m(i) = f10m(i) * u1(i) + v10m(i) = f10m(i) * v1(i) endif + have_2m = use_lake_model(i)>0 .and. use_lake2m .and. & & iopt_lake==iopt_lake_clm if(have_2m) then diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index fa4cad0d9..1087fa942 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -358,12 +358,12 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & * virtfac endif - if (.not. use_oceanuv) then - wind10m=sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) - windrel=wind(i) - else if (use_oceanuv) then + if (use_oceanuv) then wind10m=sqrt((u10m(i)-usfco(i))**2+(v10m(i)-vsfco(i))**2) windrel=sqrt((u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2) + else + wind10m=sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) + windrel=wind(i) endif z0 = 0.01_kp * z0rl_wat(i) diff --git a/physics/SFC_Layer/UFS/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 index 798b0ef35..eb84aa352 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.f90 +++ b/physics/SFC_Layer/UFS/sfc_nst.f90 @@ -320,15 +320,15 @@ subroutine sfc_nst_run & ! --- ... rcp = rho cp ch v - if (.not. use_oceanuv) then - rch(i) = rho_a(i) * cp * ch(i) * wind(i) - cmm(i) = cm (i) * wind(i) - chh(i) = rho_a(i) * ch(i) * wind(i) - else if (use_oceanuv) then + if (use_oceanuv) then windrel= sqrt( (u1(i)-usfco(i))**2 + (v1(i)-vsfco(i))**2 ) rch(i) = rho_a(i) * cp * ch(i) * windrel cmm(i) = cm (i) * windrel chh(i) = rho_a(i) * ch(i) * windrel + else + rch(i) = rho_a(i) * cp * ch(i) * wind(i) + cmm(i) = cm (i) * wind(i) + chh(i) = rho_a(i) * ch(i) * wind(i) endif !> - Calculate latent and sensible heat flux over open water with tskin. diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F index 3cc4ef71f..1721f248e 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F @@ -183,14 +183,15 @@ subroutine sfc_ocean_run & q0(i) = max( q1(i), qmin ) rho(i) = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0(i))) - if (.not. use_oceanuv) then - tem = ch(i) * wind(i) - cmm(i) = cm(i) * wind(i) - else if (use_oceanuv) then + if (use_oceanuv) then windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 ) tem = ch(i) * windrel(i) cmm(i) = cm(i) * windrel(i) + else + tem = ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) endif + chh(i) = rho(i) * tem hflx(i) = dtsfc_med(i) @@ -207,16 +208,17 @@ subroutine sfc_ocean_run & ! --- ... rcp = rho cp ch v - if (.not. use_oceanuv) then - rch = rho(i) * cp * ch(i) * wind(i) - tem = ch(i) * wind(i) - cmm(i) = cm(i) * wind(i) - else if (use_oceanuv) then + if (use_oceanuv) then windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 ) rch = rho(i) * cp * ch(i) * windrel(i) tem = ch(i) * windrel(i) cmm(i) = cm(i) * windrel(i) + else + rch = rho(i) * cp * ch(i) * wind(i) + tem = ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) endif + chh(i) = rho(i) * tem !> - Calcualte sensible and latent heat flux over open water