diff --git a/.gitmodules b/.gitmodules index 94e6cca27..cf07e4b50 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,7 +8,5 @@ branch = main [submodule "physics/SFC_Layer/MYNN/MYNN"] path = physics/SFC_Layer/MYNN/MYNN - #url = https://github.com/NCAR/MYNN-SFC - #branch = main - url = https://github.com/grantfirl/MYNN-SFC - branch = feature/tendency_cleanup + url = https://github.com/NCAR/MYNN-SFC + branch = ccpp/dev diff --git a/CMakeLists.txt b/CMakeLists.txt index 5afd86200..c32a12907 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -207,9 +207,13 @@ target_include_directories(ccpp_physics PUBLIC target_link_libraries(ccpp_physics PRIVATE MPI::MPI_Fortran) target_link_libraries(ccpp_physics PUBLIC w3emc::w3emc_d - sp::sp_d NetCDF::NetCDF_Fortran ) +if(ip_FOUND) + target_link_libraries(ccpp_physics PUBLIC ip::ip_d) +else() + target_link_libraries(ccpp_physics PUBLIC sp::sp_d) +endif() #add FMS for FV3 only if(FV3 OR MPAS) target_link_libraries(ccpp_physics PUBLIC fms) diff --git a/CODEOWNERS b/CODEOWNERS index 106deccb5..dc87563c2 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -30,7 +30,7 @@ physics/GWD/drag_suite.* @md physics/GWD/gwdc.* @Songyou184 @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/GWD/gwdps.* @Songyou184 @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/GWD/rayleigh_damp.* @yangfanglin @grantfirl @rhaesung @Qingfu-Liu @dustinswales -physics/GWD/ugwp_driver_v0.F @mdtoyNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/ugwp_driver_v0.F90 @mdtoyNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/GWD/ugwpv1_gsldrag.* @mdtoyNOAA @BoYang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/GWD/ugwpv1_gsldrag_post.* @mdtoyNOAA @BoYang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/GWD/unified_ugwp* @mdtoyNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales @@ -149,7 +149,7 @@ physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.* physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales -physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.* @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales diff --git a/physics/GWD/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 index 323cea9a8..ea56d4e61 100644 --- a/physics/GWD/cires_tauamf_data.F90 +++ b/physics/GWD/cires_tauamf_data.F90 @@ -4,6 +4,7 @@ module cires_tauamf_data use machine, only: kind_phys + use mpi_f08 !........................................................................................... ! tabulated GW-sources: GRACILE/Ern et al., 2018 and/or Resolved GWs from C384-Annual run !........................................................................................... @@ -20,18 +21,20 @@ module cires_tauamf_data contains !> - subroutine read_tau_amf(me, master, errmsg, errflg) + subroutine read_tau_amf(mpicomm, mpirank, mpiroot, errmsg, errflg) - use netcdf - integer, intent(in) :: me, master + use netcdf + use mpiutil, only: ccpp_bcast + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot integer :: ncid, iernc, vid, dimid, status integer :: k character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! - - iernc=NF90_OPEN(trim(ugwp_taufile), nf90_nowrite, ncid) + read_and_broadcast_1: if (mpirank==mpiroot) then + iernc=NF90_OPEN(trim(ugwp_taufile), nf90_nowrite, ncid) if(iernc.ne.0) then write(errmsg,'(*(a))') "read_tau_amf: cannot open file_limb_tab data-file ", & @@ -39,8 +42,7 @@ subroutine read_tau_amf(me, master, errmsg, errflg) print *, 'cannot open ugwp-v1 tau-file=',trim(ugwp_taufile) errflg = 1 return - else - + endif status = nf90_inq_dimid(ncid, "lat", DimID) ! if (status /= nf90_noerr) call handle_err(status) @@ -50,28 +52,36 @@ subroutine read_tau_amf(me, master, errmsg, errflg) status = nf90_inq_dimid(ncid, "days", DimID) status = nf90_inquire_dimension(ncid, DimID, len =ntau_d2t ) - if (me == master) print *, ntau_d1y, ntau_d2t, ' dimd of tau_ngw ugwp-v1 ' - if (ntau_d2t .le. 0 .or. ntau_d1y .le. 0) then - print *, 'ugwp-v1 tau-file=', trim(ugwp_taufile) - print *, ' ugwp-v1: ', 'ntau_d2t=',ntau_d2t, 'ntau_d2t=',ntau_d1y - stop - endif - - if (.not.allocated(ugwp_taulat)) allocate (ugwp_taulat(ntau_d1y )) - if (.not.allocated(days_limb)) allocate (days_limb(ntau_d2t)) - if (.not.allocated(tau_limb)) allocate (tau_limb(ntau_d1y, ntau_d2t )) - - iernc=nf90_inq_varid( ncid, 'DAYS', vid ) - iernc= nf90_get_var( ncid, vid, days_limb) - iernc=nf90_inq_varid( ncid, 'LATS', vid ) - iernc= nf90_get_var( ncid, vid, ugwp_taulat) - iernc=nf90_inq_varid( ncid, 'ABSMF', vid ) - iernc= nf90_get_var( ncid, vid, tau_limb) - - iernc=nf90_close(ncid) - - endif - + print *, ntau_d1y, ntau_d2t, ' dimd of tau_ngw ugwp-v1 ' + if (ntau_d2t .le. 0 .or. ntau_d1y .le. 0) then + print *, 'ugwp-v1 tau-file=', trim(ugwp_taufile) + print *, ' ugwp-v1: ', 'ntau_d2t=',ntau_d2t, 'ntau_d2t=',ntau_d1y + errflg = 1 + return + endif + endif read_and_broadcast_1 + + call ccpp_bcast(ntau_d1y, mpiroot, mpicomm, errflg) + call ccpp_bcast(ntau_d2t, mpiroot, mpicomm, errflg) + + if (.not.allocated(ugwp_taulat)) allocate (ugwp_taulat(ntau_d1y )) + if (.not.allocated(days_limb)) allocate (days_limb(ntau_d2t)) + if (.not.allocated(tau_limb)) allocate (tau_limb(ntau_d1y, ntau_d2t )) + + read_and_broadcast_2: if (mpirank==mpiroot) then + iernc=nf90_inq_varid( ncid, 'DAYS', vid ) + iernc= nf90_get_var( ncid, vid, days_limb) + iernc=nf90_inq_varid( ncid, 'LATS', vid ) + iernc= nf90_get_var( ncid, vid, ugwp_taulat) + iernc=nf90_inq_varid( ncid, 'ABSMF', vid ) + iernc= nf90_get_var( ncid, vid, tau_limb) + iernc=nf90_close(ncid) + endif read_and_broadcast_2 + + call ccpp_bcast(days_limb, mpiroot, mpicomm, errflg) + call ccpp_bcast(tau_limb, mpiroot, mpicomm, errflg) + call ccpp_bcast(ugwp_taulat, mpiroot, mpicomm, errflg) + end subroutine read_tau_amf !> diff --git a/physics/GWD/cires_ugwp.F90 b/physics/GWD/cires_ugwp.F90 index e06f4929a..5d0c6814c 100644 --- a/physics/GWD/cires_ugwp.F90 +++ b/physics/GWD/cires_ugwp.F90 @@ -39,7 +39,7 @@ module cires_ugwp !! \htmlinclude cires_ugwp_init.html !! subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & - fn_nml2, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & + fn_nml2, lonr, levs, ak, bk, dtp, cdmbgwd, cgwf, & pa_rf_in, tau_rf_in, con_p0, gwd_opt,do_ugwp, errmsg, errflg) !---- initialization of cires_ugwp @@ -52,7 +52,6 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & integer, intent (in) :: logunit integer, intent (in) :: lonr integer, intent (in) :: levs - integer, intent (in) :: latr real(kind=kind_phys), intent (in) :: ak(:), bk(:) real(kind=kind_phys), intent (in) :: dtp real(kind=kind_phys), intent (in) :: cdmbgwd(:), cgwf(:) ! "scaling" controls for "old" GFS-GW schemes @@ -64,11 +63,6 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & character(len=*), intent (in) :: fn_nml2 !character(len=*), parameter :: fn_nml='input.nml' - integer :: ios - logical :: exists - real :: dxsg - integer :: k - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -77,19 +71,21 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & errflg = 0 if (is_initialized) return - + ! Consistency checks if (gwd_opt/=1) then write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & & drag is different from cires_ugwp scheme" errflg = 1 return - end if + end if if (do_ugwp .or. cdmbgwd(3) > 0.0) then call cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & - fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & - cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) + fn_nml2, lonr, levs, ak, bk, con_p0, dtp, & + cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in, & + errmsg, errflg) + if (errflg/=0) return else write(errmsg,'(*(a))') "Logic error: cires_ugwp_init called but do_ugwp is false and cdmbgwd(3) <= 0" errflg = 1 @@ -106,7 +102,6 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & end subroutine cires_ugwp_init - ! ----------------------------------------------------------------------- ! finalize of cires_ugwp (_finalize) ! ----------------------------------------------------------------------- @@ -136,7 +131,6 @@ subroutine cires_ugwp_finalize(errmsg, errflg) end subroutine cires_ugwp_finalize - ! ----------------------------------------------------------------------- ! originally from ugwp_driver_v0.f ! driver of cires_ugwp (_driver) @@ -147,45 +141,45 @@ end subroutine cires_ugwp_finalize ! ----------------------------------------------------------------------- !>@brief These subroutines and modules execute the CIRES UGWP Version 0. !> \section gen_cires_ugwp CIRES UGWP V0 Scheme General Algorithm -!! The physics of Non-Orographic Gravity Waves (NGWs) in the UGWP framework -!!(Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, introduced in -!!Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander -!!and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. -!!A major modification of these GW solvers was introduced with the addition of the -!!background dissipation of temperature and winds to the saturation criteria for wave breaking. -!!This feature is important in the mesosphere and thermosphere for WAM applications and it -!!considers appropriate scale-dependent dissipation of waves near the model top lid providing -!!the momentum and energy conservation in the vertical column physics (Shaw and -!!Shepherd (2009) \cite shaw_and_shepherd_2009). In the UGWP-v0 scheme, a modification of the -!!Scinocca (2003) \cite scinocca_2003 algorithm for NGWs with non-hydrostatic and rotational -!!effects for GW propagations and background dissipation is contained in the subroutine -!!fv3_ugwp_solv2_v0. Future development plans for the UGWP scheme include additional GW-solvers -!!to be implemented along with physics-based triggering of waves and stochastic approaches -!!for selection of GW modes characterized by horizontal phase velocities, azimuthal +!! The physics of Non-Orographic Gravity Waves (NGWs) in the UGWP framework +!!(Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, introduced in +!!Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander +!!and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. +!!A major modification of these GW solvers was introduced with the addition of the +!!background dissipation of temperature and winds to the saturation criteria for wave breaking. +!!This feature is important in the mesosphere and thermosphere for WAM applications and it +!!considers appropriate scale-dependent dissipation of waves near the model top lid providing +!!the momentum and energy conservation in the vertical column physics (Shaw and +!!Shepherd (2009) \cite shaw_and_shepherd_2009). In the UGWP-v0 scheme, a modification of the +!!Scinocca (2003) \cite scinocca_2003 algorithm for NGWs with non-hydrostatic and rotational +!!effects for GW propagations and background dissipation is contained in the subroutine +!!fv3_ugwp_solv2_v0. Future development plans for the UGWP scheme include additional GW-solvers +!!to be implemented along with physics-based triggering of waves and stochastic approaches +!!for selection of GW modes characterized by horizontal phase velocities, azimuthal !!directions and magnitude of the vertical momentum flux (VMF). !! -!! In UGWP-v0, the specification for the VMF function is adopted from the -!! GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described in -!! Molod et al. (2015) \cite molod_et_al_2015 and employed in the MERRRA-2 -!! reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). The Fortran -!! subroutine slat_geos5_tamp_v0() describes the latitudinal shape of -!! VMF-function as displayed in Figure 3 of Molod et al. (2015) -!! \cite molod_et_al_2015. It shows that the enhanced values of -!! VMF in the equatorial region gives opportunity to simulate the -!! QBO-like oscillations in the equatorial zonal winds and lead to more -!! realistic simulations of the equatorial dynamics in GEOS-5 operational -!! and MERRA-2 reanalysis products. For the first vertically extended -!! version of FV3GFS in the stratosphere and mesosphere, this simplified -!! function of VMF allows us to tune the model climate and to evaluate -!! multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis -!! products, along with temperature, ozone, and water vapor observations -!! of current satellite missions. After delivery of the UGWP-code, the -!! EMC group developed and tested approach to modulate the zonal mean -!! NGW forcing by 3D-distributions of the total precipitation as a proxy -!! for the excitation of NGWs by convection and the vertically-integrated -!! (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification -!! scores with updated NGW forcing, as reported elsewhere by EMC researchers, -!! display noticeable improvements in the forecast scores produced by +!! In UGWP-v0, the specification for the VMF function is adopted from the +!! GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described in +!! Molod et al. (2015) \cite molod_et_al_2015 and employed in the MERRRA-2 +!! reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). The Fortran +!! subroutine slat_geos5_tamp_v0() describes the latitudinal shape of +!! VMF-function as displayed in Figure 3 of Molod et al. (2015) +!! \cite molod_et_al_2015. It shows that the enhanced values of +!! VMF in the equatorial region gives opportunity to simulate the +!! QBO-like oscillations in the equatorial zonal winds and lead to more +!! realistic simulations of the equatorial dynamics in GEOS-5 operational +!! and MERRA-2 reanalysis products. For the first vertically extended +!! version of FV3GFS in the stratosphere and mesosphere, this simplified +!! function of VMF allows us to tune the model climate and to evaluate +!! multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis +!! products, along with temperature, ozone, and water vapor observations +!! of current satellite missions. After delivery of the UGWP-code, the +!! EMC group developed and tested approach to modulate the zonal mean +!! NGW forcing by 3D-distributions of the total precipitation as a proxy +!! for the excitation of NGWs by convection and the vertically-integrated +!! (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification +!! scores with updated NGW forcing, as reported elsewhere by EMC researchers, +!! display noticeable improvements in the forecast scores produced by !! FV3GFS configuration extended into the mesosphere. !! !> \section arg_table_cires_ugwp_run Argument Table @@ -302,8 +296,9 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr ugrs, vgrs, tgrs, qgrs(:,:,1), kpbl, prsi,del,prsl, prslk, phii, phil, & dtp, kdt, sgh30, hprime, oc, oa4, clx, theta, sigma, gamma, elvmax, & dusfcg, dvsfcg, xlat_d, sinlat, coslat, area, cdmbgwd(1:2), & - me, master, rdxzb, con_g, con_omega, zmtb, zogw, tau_mtb, tau_ogw, & - tau_tofd, dudt_mtb, dudt_ogw, dudt_tms) + me, master, rdxzb, zmtb, zogw, tau_mtb, tau_ogw, & + tau_tofd, dudt_mtb, dudt_ogw, dudt_tms, & + errmsg, errflg) else ! calling old GFS gravity wave drag as is @@ -337,7 +332,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr endif ! do_ugwp - if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) if(idtend>=1) then @@ -352,7 +346,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr dtend(:,:,idtend) = dtend(:,:,idtend) + Pdtdt*dtp endif endif - if (cdmbgwd(3) > 0.0) then diff --git a/physics/GWD/cires_ugwp.meta b/physics/GWD/cires_ugwp.meta index 0ea14b6e4..3b87757d2 100644 --- a/physics/GWD/cires_ugwp.meta +++ b/physics/GWD/cires_ugwp.meta @@ -3,7 +3,7 @@ type = scheme # DH* 20200804 - this is a result of the nasty hack to call gwdps from within ugwp-v0! dependencies=cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 - dependencies=cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,../hooks/machine.F,ugwp_driver_v0.F + dependencies=cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,../hooks/machine.F,ugwp_driver_v0.F90 ######################################################################## [ccpp-arg-table] @@ -60,13 +60,6 @@ dimensions = () type = integer intent = in -[latr] - standard_name = number_of_latitude_points - long_name = number of global points in y-dir (j) along the meridian - units = count - dimensions = () - type = integer - intent = in [levs] standard_name = vertical_layer_dimension long_name = number of vertical levels @@ -798,7 +791,7 @@ type = real kind = kind_phys intent = in -[dqdt_tke] +[dqdt_tke] standard_name = process_split_cumulative_tendency_of_turbulent_kinetic_energy long_name = turbulent kinetic energy tendency due to model physics units = J kg-1 s-1 diff --git a/physics/GWD/cires_ugwp_module.F90 b/physics/GWD/cires_ugwp_module.F90 index a454a5eae..3695487cd 100644 --- a/physics/GWD/cires_ugwp_module.F90 +++ b/physics/GWD/cires_ugwp_module.F90 @@ -19,13 +19,12 @@ module cires_ugwpv0_module real, parameter :: pi2 = 2.*pi real, parameter :: hps = 7000. real, parameter :: hpskm = hps/1000. -! + real :: kxw = 6.28e-3/100. !< single horizontal wavenumber of ugwp schemes real, parameter :: ricrit = 0.25 real, parameter :: frcrit = 0.50 real, parameter :: linsat = 1.00 real, parameter :: linsat2 = linsat*linsat -! integer :: knob_ugwp_solver=1 !< 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) integer, dimension(4) :: knob_ugwp_source !< [1,1,1,0] - (oro, fronts, conv, imbf-owp] @@ -38,7 +37,7 @@ module cires_ugwpv0_module integer :: knob_ugwp_doheat=1 !< 1 -gwheat integer :: knob_ugwp_dokdis=0 !< 1 -gwmixing integer :: knob_ugwp_ndx4lh = 2 !< n-number of "unresolved" "n*dx" for lh_gw -! + integer :: ugwp_azdir integer :: ugwp_stoch @@ -46,7 +45,6 @@ module cires_ugwpv0_module integer :: ugwp_nws real :: ugwp_effac -! data knob_ugwp_source / 1,0, 1, 0 / !< oro-conv-fjet-okw-taub_lat: 1-active 0-off data knob_ugwp_wvspec /1,32,32,32/ !< number of waves for- (oro, fronts, conv, imbf-owp, taulat] data knob_ugwp_azdir /2, 4, 4,4/ !< number of wave azimuths for- (oro, fronts, conv, imbf-okwp] @@ -54,7 +52,7 @@ module cires_ugwpv0_module data knob_ugwp_effac /1.,1.,1.,1./ !< efficiency factors for- (oro, fronts, conv, imbf-owp] integer :: knob_ugwp_version = 0 !< version control had sense under IPD in CCPP=> to SUITES integer :: launch_level = 55 -! + namelist /cires_ugwp_nml/ knob_ugwp_solver, knob_ugwp_source,knob_ugwp_wvspec, knob_ugwp_azdir, & knob_ugwp_stoch, knob_ugwp_effac,knob_ugwp_doaxyz, knob_ugwp_doheat, knob_ugwp_dokdis, & knob_ugwp_ndx4lh, knob_ugwp_version, launch_level @@ -91,7 +89,7 @@ module cires_ugwpv0_module real, parameter :: F_coriol=1 ! Coriolis effects real, parameter :: F_nonhyd=1 ! Nonhydrostatic waves real, parameter :: F_kds =0 ! Eddy mixing due to GW-unstable below - real, parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw + real, parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw real, parameter :: iPr_turb =1./3., iPr_mol =1.95 real, parameter :: rhp1=1./hps, rhp2=0.5*rhp1, rhp4 = rhp2*rhp2 real, parameter :: khp = 0.287*rhp1 ! R/Cp/Hp @@ -104,15 +102,15 @@ module cires_ugwpv0_module ! init of cires_ugwp (_init) called from GFS_driver.F90 ! ! ----------------------------------------------------------------------- -!>This subroutine initializes CIRES UGWP +!>This subroutine initializes CIRES UGWP subroutine cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & - fn_nml, lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, cgwf, & - pa_rf_in, tau_rf_in) + fn_nml, lonr, levs, ak, bk, pref, dtp, cdmvgwd, cgwf, & + pa_rf_in, tau_rf_in, errmsg, errflg) use ugwpv0_oro_init, only : init_oro_gws_v0 use ugwpv0_wmsdis_init, only : initsolv_wmsdis_v0, ilaunch use ugwpv0_lsatdis_init, only : initsolv_lsatdis_v0 - + implicit none integer, intent (in) :: me @@ -123,13 +121,16 @@ subroutine cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & character(len=64), intent (in) :: fn_nml integer, intent (in) :: lonr integer, intent (in) :: levs - integer, intent (in) :: latr real, intent (in) :: ak(levs+1), bk(levs+1), pref real, intent (in) :: dtp real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes real, intent (in) :: pa_rf_in, tau_rf_in + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg + integer :: ios + character(len=256) :: msg logical :: exists real :: dxsg integer :: k @@ -138,21 +139,26 @@ subroutine cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & read (input_nml_file, nml = cires_ugwp_nml) #else if (me == master) print *, trim (fn_nml), ' GW-namelist file ' - + inquire (file =trim (fn_nml) , exist = exists) if (.not. exists) then - if (me == master) & - write (6, *) 'separate ugwp :: namelist file: ', trim (fn_nml), ' does not exist' + write(errmsg,*) 'separate ugwp :: namelist file: ', trim (fn_nml), ' does not exist' + errflg = 1 + return else - open (unit = nlunit, file = trim(fn_nml), action = 'read', status = 'old', iostat = ios) + open (unit = nlunit, file = trim(fn_nml), action = 'read', status = 'old', iostat = ios, iomsg = msg) + if (ios /= 0) then + write(errmsg,*) 'ERROR: cannot open namelist file ', trim(fn_nml), ' iostat=', ios, ' msg="' // trim(msg) // '"' + errflg = 1 + return + endif endif rewind (nlunit) read (nlunit, nml = cires_ugwp_nml) close (nlunit) #endif - -! + ilaunch = launch_level pa_rf = pa_rf_in tau_rf = tau_rf_in @@ -167,9 +173,9 @@ subroutine cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & ! effective kxw - resolution-aware ! dxsg = pi2*arad/float(lonr) * knob_ugwp_ndx4lh -! + allocate( kvg(levs+1), ktg(levs+1) ) - allocate( krad(levs+1), kion(levs+1) ) + allocate( krad(levs+1), kion(levs+1) ) allocate( zkm(levs), pmb(levs) ) allocate( rfdis(levs), rfdist(levs) ) ! @@ -187,8 +193,8 @@ subroutine cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & ! ! Part-2 :init_SOURCES_gws -- only orowaves, but ugwp-v0 is based on gwdps.f of EMC ! - -! + +! ! call init-solver for "stationary" multi-wave spectra and sub-grid oro ! call init_oro_gws_v0( knob_ugwp_wvspec(1), knob_ugwp_azdir(1), & @@ -205,22 +211,21 @@ subroutine cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & ! call init-solvers for "broad" non-stationary multi-wave spectra ! if (knob_ugwp_solver==1) then -! + call initsolv_lsatdis_v0(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw ) endif - if (knob_ugwp_solver==2) then - - call initsolv_wmsdis_v0(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & - knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) - endif + if (knob_ugwp_solver==2) then + call initsolv_wmsdis_v0(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) + endif !====================== module_is_initialized = .true. end subroutine cires_ugwpv0_mod_init -! +! ! ----------------------------------------------------------------------- ! finalize of cires_ugwp (_finalize) ! ----------------------------------------------------------------------- @@ -241,6 +246,4 @@ subroutine cires_ugwpv0_mod_finalize deallocate( rfdis, rfdist) end subroutine cires_ugwpv0_mod_finalize -! - end module cires_ugwpv0_module - +end module cires_ugwpv0_module diff --git a/physics/GWD/cires_ugwpv1_module.F90 b/physics/GWD/cires_ugwpv1_module.F90 index c0e866dc5..534c1cb87 100644 --- a/physics/GWD/cires_ugwpv1_module.F90 +++ b/physics/GWD/cires_ugwpv1_module.F90 @@ -9,12 +9,11 @@ module cires_ugwpv1_module !.................................................................................... ! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re !................................................................................... -! ! use machine, only : kind_phys - use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, rhp4, khp, hpskm - use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar - use ugwp_wmsdis_init, only : tau_min, tamp_mpa + use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, rhp4, khp, hpskm + use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar + use ugwp_wmsdis_init, only : tau_min, tamp_mpa implicit none logical :: module_is_initialized @@ -22,35 +21,33 @@ module cires_ugwpv1_module character(len=8) :: strsolver='pss-1986' logical :: do_physb_gwsrcs = .false. ! control for physics-based GW-sources logical :: do_rfdamp = .false. ! control for Rayleigh friction inside ugwp_driver - integer, parameter :: idebug_gwrms=0 ! control for diag computaions pw wind-temp GW-rms and MF fluxs + integer, parameter :: idebug_gwrms=0 ! control for diag computaions pw wind-temp GW-rms and MF fluxs logical, parameter :: do_adjoro = .false. - + real(kind=kind_phys), parameter :: max_kdis = 450. ! 400 m2/s real(kind=kind_phys), parameter :: max_axyz = 450.e-5 ! 400 m/s/day - real(kind=kind_phys), parameter :: max_eps = max_kdis*4.e-4 ! max_kdis*BN2 + real(kind=kind_phys), parameter :: max_eps = max_kdis*4.e-4 ! max_kdis*BN2 real(kind=kind_phys), parameter :: maxdudt = max_axyz real(kind=kind_phys), parameter :: maxdtdt = max_eps*1.e-3 ! max_kdis*BN2/cp real(kind=kind_phys), parameter :: dked_min = 0.01 - real(kind=kind_phys), parameter :: dked_max = max_kdis -! + real(kind=kind_phys), parameter :: dked_max = max_kdis ! ! Pr = Kv/Kt < 1 for upper layers; Pr_mol = 1./1.95 check it -! - real(kind=kind_phys), parameter :: Pr_kvkt = 1./1. ! kv/kt = 1./3. +! + real(kind=kind_phys), parameter :: Pr_kvkt = 1./1. ! kv/kt = 1./3. real(kind=kind_phys), parameter :: Pr_kdis = Pr_kvkt/(1.+Pr_kvkt) - - real(kind=kind_phys), parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw + + real(kind=kind_phys), parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw real(kind=kind_phys), parameter :: iPr_turb =1./3., iPr_mol =1.95 - - real(kind=kind_phys), parameter :: cd_ulim = 1.0 ! critical level precision or Lz ~ 0 ~dz of model + + real(kind=kind_phys), parameter :: cd_ulim = 1.0 ! critical level precision or Lz ~ 0 ~dz of model real(kind=kind_phys), parameter :: linsat = 1.00 real(kind=kind_phys), parameter :: linsat2 = linsat*linsat - + real(kind=kind_phys), parameter :: ricrit = 0.25 real(kind=kind_phys), parameter :: frcrit = 0.50 - - integer :: knob_ugwp_version = 1 + integer :: knob_ugwp_version = 1 integer :: knob_ugwp_solver=1 ! 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) integer, dimension(4) :: knob_ugwp_source=(/1,0,1,0/) ! [1,0,1,1] - (oro, fronts, conv, imbf-owp] integer, dimension(4) :: knob_ugwp_wvspec=(/1,32,32,32/) ! number of waves for- (oro, fronts, conv, imbf-owp] @@ -62,19 +59,19 @@ module cires_ugwpv1_module integer :: knob_ugwp_doheat=1 ! 1 -gwheat integer :: knob_ugwp_dokdis=0 ! 1 -gwmixing integer :: knob_ugwp_ndx4lh = 2 ! n-number of "unresolved" "n*dx" for lh_gw - integer :: knob_ugwp_nslope = 1 ! spectral"growth" S-slope of GW-energy spectra mkz^S - + integer :: knob_ugwp_nslope = 1 ! spectral"growth" S-slope of GW-energy spectra mkz^S + real(kind=kind_phys) :: knob_ugwp_palaunch = 500.e2 ! fixed pressure layer in Pa for "launch" of NGWs real(kind=kind_phys) :: knob_ugwp_lzmax = 12.5e3 ! 12.5 km max-VERT-WL of GW-spectra - real(kind=kind_phys) :: knob_ugwp_lzstar = 2.0e3 ! UTLS mstar = 6.28/lzstar 2-2.5 km - real(kind=kind_phys) :: knob_ugwp_lzmin = 1.5e3 ! 1.5 km min-VERT-WL of GW-spectra + real(kind=kind_phys) :: knob_ugwp_lzstar = 2.0e3 ! UTLS mstar = 6.28/lzstar 2-2.5 km + real(kind=kind_phys) :: knob_ugwp_lzmin = 1.5e3 ! 1.5 km min-VERT-WL of GW-spectra real(kind=kind_phys) :: knob_ugwp_taumin = 0.25e-3 real(kind=kind_phys) :: knob_ugwp_tauamp = 7.75e-3 ! range from 30.e-3 to 3.e-3 ( space-borne values) real(kind=kind_phys) :: knob_ugwp_lhmet = 200.e3 ! 200 km - - logical :: knob_ugwp_tlimb = .true. - character(len=8) :: knob_ugwp_orosolv='pss-1986' - + + logical :: knob_ugwp_tlimb = .true. + character(len=8) :: knob_ugwp_orosolv='pss-1986' + real(kind=kind_phys) :: kxw = 6.28/200.e3 ! single horizontal wavenumber of ugwp schemes ! integer :: ugwp_azdir @@ -82,7 +79,7 @@ module cires_ugwpv1_module integer :: ugwp_src integer :: ugwp_nws - + real(kind=kind_phys) :: ugwp_effac ! integer :: launch_level = 55 @@ -90,8 +87,8 @@ module cires_ugwpv1_module namelist /cires_ugwp_nml/ knob_ugwp_solver, knob_ugwp_source,knob_ugwp_wvspec, knob_ugwp_azdir, & knob_ugwp_stoch, knob_ugwp_effac,knob_ugwp_doaxyz, knob_ugwp_doheat, knob_ugwp_dokdis, & knob_ugwp_ndx4lh, knob_ugwp_version, knob_ugwp_palaunch, knob_ugwp_nslope, knob_ugwp_lzmax, & - knob_ugwp_lzmin, knob_ugwp_lzstar, knob_ugwp_lhmet, knob_ugwp_tauamp, knob_ugwp_taumin, & - knob_ugwp_tlimb, knob_ugwp_orosolv + knob_ugwp_lzmin, knob_ugwp_lzstar, knob_ugwp_lhmet, knob_ugwp_tauamp, knob_ugwp_taumin, & + knob_ugwp_tlimb, knob_ugwp_orosolv ! ! allocatable arrays, initilized during "cires_ugwp_init" & @@ -102,35 +99,34 @@ module cires_ugwpv1_module real(kind=kind_phys), allocatable :: rfdis(:), rfdist(:) ! ! RF-not active now -! +! integer :: levs_rf real(kind=kind_phys) :: pa_rf, tau_rf ! ! simple modulation of tau_ngw by the total rain/precip strength -! - real(kind=kind_phys), parameter :: rain_max=8.e-5, rain_lat=41.0, rain_lim=1.e-5 +! + real(kind=kind_phys), parameter :: rain_max=8.e-5, rain_lat=41.0, rain_lim=1.e-5 real(kind=kind_phys), parameter :: w_merra = 1.0, w_nomerra = 1.-w_merra, w_rain =1. - real(kind=kind_phys), parameter :: mtau_rain = 1.e-3, ft_min =0.5, ft_max=2 - real(kind=kind_phys), parameter :: tau_ngw_max = 20.e-3 ! 20 mPa - real(kind=kind_phys), parameter :: tau_ngw_min = .20e-3 ! .2 mPa -! -! Bushell et al. (2015) tau = tau_rainum (~3.8 km) x sqrt(Precip/base_rainum) -! + real(kind=kind_phys), parameter :: mtau_rain = 1.e-3, ft_min =0.5, ft_max=2 + real(kind=kind_phys), parameter :: tau_ngw_max = 20.e-3 ! 20 mPa + real(kind=kind_phys), parameter :: tau_ngw_min = .20e-3 ! .2 mPa +! +! Bushell et al. (2015) tau = tau_rainum (~3.8 km) x sqrt(Precip/base_rainum) +! real(kind=kind_phys), parameter :: tau_rainum = 0.7488e-3 ! 0.74 mPa - real(kind=kind_phys), parameter :: base_rainum = 0.1e-5 ! ~0.1 mm/day - real(kind=kind_phys), parameter :: pbase_um =1./sqrt(base_rainum) * tau_rainum ! + real(kind=kind_phys), parameter :: base_rainum = 0.1e-5 ! ~0.1 mm/day + real(kind=kind_phys), parameter :: pbase_um =1./sqrt(base_rainum) * tau_rainum ! integer, parameter :: metoum_rain = 0 !================================================================= ! switches that can ba activated for NGW physics include/omit ! -! rotational, non-hydrostatic and eddy-dissipative +! rotational, non-hydrostatic and eddy-dissipative ! F_coriol F_nonhyd F_kds !=================================================== real(kind=kind_phys), parameter :: F_coriol=1.0 ! Coriolis effects real(kind=kind_phys), parameter :: F_nonhyd=1.0 ! Nonhydrostatic waves real(kind=kind_phys), parameter :: F_kds =0.0 ! Eddy mixing due to GW-unstable below - contains ! !----------------------------------------------------------------------- @@ -138,30 +134,30 @@ module cires_ugwpv1_module ! init of cires_ugwp (_init) called from CCPP cap file ! ! --------------------------------------------------------------------------------- -! non-ccpp .... +! non-ccpp .... ! ! subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & -! lonr, latr, levs, ak, bk, pref, dtp) +! lonr, levs, ak, bk, pref, dtp) !----------------------------------------------------------------------------------- subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & - con_rerth, fn_nml2, input_nml_file, lonr, latr, levs, ak, bk, & + con_rerth, fn_nml2, input_nml_file, lonr, levs, ak, bk, & pref, dtp, errmsg, errflg) ! ! input_nml_file ='input.nml'=fn_nml ..... OLD_namelist and cdmvgwd(4) Corrected Bug Oct 4 ! use netcdf - use ugwp_common, only : init_global_gwdis + use ugwp_common, only : init_global_gwdis use ugwp_oro_init, only : init_oro_gws use ugwp_conv_init, only : init_conv_gws use ugwp_fjet_init, only : init_fjet_gws use ugwp_okw_init, only : init_okw_gws - use ugwp_lsatdis_init, only : initsolv_lsatdis - - use ugwp_wmsdis_init, only : initsolv_wmsdis - use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar - use ugwp_wmsdis_init, only : tau_min, tamp_mpa - + use ugwp_lsatdis_init, only : initsolv_lsatdis + + use ugwp_wmsdis_init, only : initsolv_wmsdis + use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar + use ugwp_wmsdis_init, only : tau_min, tamp_mpa + implicit none integer, intent (in) :: me @@ -170,7 +166,6 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & integer, intent (in) :: logunit integer, intent (in) :: lonr integer, intent (in) :: levs - integer, intent (in) :: latr integer, intent (in) :: jdat_gfs(8) real(kind=kind_phys), intent (in) :: ak(levs+1), bk(levs+1), pref real(kind=kind_phys), intent (in) :: dtp @@ -178,7 +173,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & ! consider to retire them ! real(kind=kind_phys), intent (in) :: con_pi, con_rerth - + character(len=64), intent (in) :: fn_nml2 character(len=*), intent (in) :: input_nml_file(:) @@ -186,13 +181,13 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & integer, intent(out) :: errflg ! character, intent (in) :: input_nml_file -! +! integer :: ios logical :: exists - + integer :: ncid, iernc, vid, dimid, status integer :: k - integer :: ddd_ugwp, curday_ugwp + integer :: ddd_ugwp, curday_ugwp ! integer :: version ! Initialize CCPP error handling variables @@ -217,52 +212,47 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & close (nlunit) #endif - strsolver= knob_ugwp_orosolv - - curday_ugwp = jdat_gfs(1)*10000 + jdat_gfs(2)*100 +jdat_gfs(3) + strsolver= knob_ugwp_orosolv + + curday_ugwp = jdat_gfs(1)*10000 + jdat_gfs(2)*100 +jdat_gfs(3) call calendar_ugwp(jdat_gfs(1), jdat_gfs(2), jdat_gfs(3), ddd_ugwp) - + ! write version number and namelist to log file if (me == master) then write (logunit, *) " ================================================================== " write (logunit, *) "CCPP cires_ugwp_namelist_extended_v1" write (logunit, nml = cires_ugwp_nml) write (logunit, *) " ================================================================== " - + write (6, *) " ================================================================== " write (6, *) "CCPP cires_ugwp_namelist_extended_v1" - write (6, nml = cires_ugwp_nml) - write (6, *) " ================================================================== " + write (6, nml = cires_ugwp_nml) + write (6, *) " ================================================================== " write (6, *) "calendar_ugwp ddd_ugwp=", ddd_ugwp write (6, *) "calendar_ugwp curday_ugwp=", curday_ugwp - write (6, *) " ================================================================== " - write (6, *) ddd_ugwp, ' jdat_gfs ddd of year ' + write (6, *) " ================================================================== " + write (6, *) ddd_ugwp, ' jdat_gfs ddd of year ' endif ! ! effective kxw - resolution-aware ! -! kxw = pi2/knob_ugwp_lhmet ! -! ! init global background dissipation for ugwp -> 4d-variable for fv3wam linked with pbl-vert_diff -! -! -! allocate(fcor(latr), fcor2(latr) ) ! allocate( kvg(levs+1), ktg(levs+1) ) allocate( krad(levs+1), kion(levs+1) ) allocate( zkm(levs), pmb(levs) ) - + ! ! ak -pa bk-dimensionless from surf => tol_lid_pressure =0 ! - + do k=1, levs pmb(k) = ak(k) + pref*bk(k) ! Pa -unit Pref = 1.e5, pmb = Pa zkm(k) = -hpskm*alog(pmb(k)/pref) - enddo - + enddo + ! ! find ilaunch ! @@ -279,17 +269,17 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & launch_level = max(k-1, 5) ! above 5-layers from the surface if (me == master) then print *, 'cires_ugwpv1 klev_ngw =', launch_level, nint(pmb(launch_level)) - endif + endif ! ! Part-1 :init_global_gwdis again "damn"-con_p ! call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) - + ! ! Part-2 :init_SOURCES_gws ! - -! + +! ! call init-solver for "stationary" multi-wave spectra and sub-grid oro ! call init_oro_gws( knob_ugwp_wvspec(1), knob_ugwp_azdir(1), & @@ -329,7 +319,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & endif ENDIF !IF (do_physb_gwsrcs) - + !====================== ! Part-3 :init_SOLVERS ! ===================== @@ -342,26 +332,25 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & call initsolv_lsatdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw ) endif - if (knob_ugwp_solver == 2) then + if (knob_ugwp_solver == 2) then +! +! re-assign from namelists ! -! re-assign from namelists -! - nslope = knob_ugwp_nslope ! the GW sprctral slope at small-m + nslope = knob_ugwp_nslope ! the GW sprctral slope at small-m lzstar = knob_ugwp_lzstar - lzmax = knob_ugwp_lzmax - lzmin = knob_ugwp_lzmin + lzmax = knob_ugwp_lzmax + lzmin = knob_ugwp_lzmin lhmet = knob_ugwp_lhmet tamp_mpa =knob_ugwp_tauamp !amplitude for GEOS-5/MERRA-2 - tau_min =knob_ugwp_taumin ! min of GW MF 0.25 mPa + tau_min =knob_ugwp_taumin ! min of GW MF 0.25 mPa ilaunch = launch_level kxw = pi2/lhmet - + call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw, knob_ugwp_version) - - endif + endif !====================== module_is_initialized = .true. @@ -369,7 +358,6 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & end subroutine cires_ugwpv1_init - !============================================= subroutine cires_ugwp_advance @@ -379,7 +367,7 @@ subroutine cires_ugwp_advance ! compute GW-triggers: reserved option if it will be funded ...... ! ! the day-to-day variable sources/spectra and diagnostics for stochastic "triggers" -! +! ! diagnose GW-source functions * FGF + OKWP + SGO/CONV from IAU-fields ! and use for stochastic GWP-sources "memory" ! @@ -392,18 +380,17 @@ subroutine cires_ugwp_advance ! ! update GW sources and dissipation ! a) physics-based GW triggers eliminated from cires_ugwpv1_triggers.F90 -! b) stochastic-based spectra and amplitudes is not considered -! c) use "memory" on GW-spectra from previous time-step is not considered +! b) stochastic-based spectra and amplitudes is not considered +! c) use "memory" on GW-spectra from previous time-step is not considered ! d) update "background" dissipation of GWs as needed (option for FV3WAM) ! end subroutine cires_ugwp_advance - -! + +! ! ----------------------------------------------------------------------- ! finalize of cires_ugwp_dealloc ! ----------------------------------------------------------------------- - subroutine cires_ugwp_dealloc ! ! deallocate sources/spectra & some diagnostics need to find where "deaalocate them" @@ -416,122 +403,113 @@ subroutine cires_ugwp_dealloc ! if (allocated (kvg)) deallocate (kvg) if (allocated (ktg)) deallocate (ktg) - if (allocated (krad)) deallocate (krad) - if (allocated (kion)) deallocate (kion) - if (allocated (zkm)) deallocate (zkm) - if (allocated (pmb)) deallocate (pmb) -! if (allocated (ugwp_taulat)) deallocate(ugwp_taulat) -! if (allocated (tau_limb)) deallocate (tau_limb) -! if (allocated (days_limb)) deallocate(days_limb) - - - end subroutine cires_ugwp_dealloc + if (allocated (krad)) deallocate (krad) + if (allocated (kion)) deallocate (kion) + if (allocated (zkm)) deallocate (zkm) + if (allocated (pmb)) deallocate (pmb) +! if (allocated (ugwp_taulat)) deallocate(ugwp_taulat) +! if (allocated (tau_limb)) deallocate (tau_limb) +! if (allocated (days_limb)) deallocate(days_limb) + + end subroutine cires_ugwp_dealloc ! -! - subroutine calendar_ugwp(yr, mm, dd, ddd_ugwp) + subroutine calendar_ugwp(yr, mm, dd, ddd_ugwp) ! ! computes day of year to get tau_limb forcing written with 1-day precision -! +! implicit none integer, intent(in) :: yr, mm, dd integer :: ddd_ugwp - + integer :: iw3jdn integer :: jd1, jddd jd1 = iw3jdn(yr,1,1) jddd = iw3jdn(yr,mm,dd) ddd_ugwp = jddd-jd1+1 - - end subroutine calendar_ugwp - - + + end subroutine calendar_ugwp + subroutine ngwflux_update(me, master, im, levs, kdt, ddd, curdate, & - tau_ddd, xlatd, sinlat,coslat, rain, tau_ngw) - - use machine, only: kind_phys + tau_ddd, xlatd, sinlat,coslat, rain, tau_ngw) + + use machine, only: kind_phys implicit none -!input - - integer, intent(in) :: me, master !, jdat(8) - integer, intent(in) :: im, levs, kdt - integer, intent(in) :: ddd, curdate - + + integer, intent(in) :: me, master + integer, intent(in) :: im, levs, kdt + integer, intent(in) :: ddd, curdate + ! integer, intent(in), dimension(im) :: j1_tau, j2_tau -! real(kind=kind_phys), intent(in), dimension(im) :: ddy_j2tau, ddy_j1tau - - real(kind=kind_phys), intent(in), dimension(im) :: xlatd, sinlat,coslat +! real(kind=kind_phys), intent(in), dimension(im) :: ddy_j2tau, ddy_j1tau + + real(kind=kind_phys), intent(in), dimension(im) :: xlatd, sinlat,coslat real(kind=kind_phys), intent(in), dimension(im) :: rain, tau_ddd - - real(kind=kind_phys), intent(inout), dimension(im) :: tau_ngw + + real(kind=kind_phys), intent(inout), dimension(im) :: tau_ngw ! ! locals -! - +! integer :: i, j1, j2, k, it1, it2, iday real(kind=kind_phys) :: tem, tx1, tx2, w1, w2, wlat, rw1, rw2 - real(kind=kind_phys) :: tau_rain, flat_rain, tau_3dt - -! + real(kind=kind_phys) :: tau_rain, flat_rain, tau_3dt -! code below inside cires_tauamf_data.F90 +! code below inside cires_tauamf_data.F90 ! it1 = 2 ! do iday=1, ntau_d2t -! if (float(ddd) .lt. days_limb(iday) ) then -! it2 = iday -! exit -! endif -! enddo -! it2 = min(it2,ntau_d2t) -! it1 = max(it2-1,1) -! if (it2 > ntau_d2t ) then -! print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t -! stop -! endif -! w2 = (float(ddd)-days_limb(it1))/(days_limb(it2)-days_limb(it1)) -! w1 = 1.0-w2 -! do i=1, im -! j1 = j1_tau(i) -! j2 = j2_tau(i) -! tx1 = tau_limb(j1, it1)*ddy_j1tau(i)+tau_limb(j2, it1)*ddy_j2tau(i) -! tx2 = tau_limb(j1, it2)*ddy_j1tau(i)+tau_limb(j2, it2)*ddy_j2tau(i) -! tau_ddd(i) = tx1*w1 + w2*tx2 +! if (float(ddd) .lt. days_limb(iday) ) then +! it2 = iday +! exit +! endif +! enddo +! it2 = min(it2,ntau_d2t) +! it1 = max(it2-1,1) +! if (it2 > ntau_d2t ) then +! print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t +! stop +! endif +! w2 = (float(ddd)-days_limb(it1))/(days_limb(it2)-days_limb(it1)) +! w1 = 1.0-w2 +! do i=1, im +! j1 = j1_tau(i) +! j2 = j2_tau(i) +! tx1 = tau_limb(j1, it1)*ddy_j1tau(i)+tau_limb(j2, it1)*ddy_j2tau(i) +! tx2 = tau_limb(j1, it2)*ddy_j1tau(i)+tau_limb(j2, it2)*ddy_j2tau(i) +! tau_ddd(i) = tx1*w1 + w2*tx2 ! ! add modulattion by the total "rain"-strength Yudin et al.(2020-FV3GFS) and Bushell et al. (2015-UM/METO) ! - do i=1, im - tau_3dt = tau_ngw(i) * w_merra + w_nomerra *tau_ddd(i) - - if (w_rain > 0. .and. rain(i) > 0.) then - + do i=1, im + tau_3dt = tau_ngw(i) * w_merra + w_nomerra *tau_ddd(i) + + if (w_rain > 0. .and. rain(i) > 0.) then + wlat = abs(xlatd(i)) - - if (wlat <= rain_lat .and. rain(i) > rain_lim) then + + if (wlat <= rain_lat .and. rain(i) > rain_lim) then flat_rain = wlat/rain_lat - rw1 = 0.75 * flat_rain ; rw2 = 1.-rw1 - - tau_rain = tau_3dt * rw1 + rw2 * mtau_rain*min(rain_max, rain(i))/rain_lim - tau_rain = tau_3dt*(1.-w_rain) + w_rain* tau_rain + rw1 = 0.75 * flat_rain ; rw2 = 1.-rw1 + + tau_rain = tau_3dt * rw1 + rw2 * mtau_rain*min(rain_max, rain(i))/rain_lim + tau_rain = tau_3dt*(1.-w_rain) + w_rain* tau_rain ! ! restict variations from the "tau_ngw" without precip-impact -! -! real, parameter :: ft_min =0.5*tau_g5 < tau_rain < ft_max =2. *tau_g5 -! - if (tau_rain < ft_min *tau_3dt) tau_rain = ft_min *tau_3dt - if (tau_rain > ft_max *tau_3dt) tau_rain = ft_max *tau_3dt - - tau_3dt = tau_rain - - endif - if (metoum_rain == 1) then - tau_rain = min( sqrt(rain(i))*pbase_um, tau_ngw_max) - tau_3dt = max(tau_ngw_min, tau_rain) - endif - endif - tau_ngw(i) = tau_3dt - enddo - - end subroutine ngwflux_update -! - end module cires_ugwpv1_module +! +! real, parameter :: ft_min =0.5*tau_g5 < tau_rain < ft_max =2. *tau_g5 +! + if (tau_rain < ft_min *tau_3dt) tau_rain = ft_min *tau_3dt + if (tau_rain > ft_max *tau_3dt) tau_rain = ft_max *tau_3dt + + tau_3dt = tau_rain + + endif + if (metoum_rain == 1) then + tau_rain = min( sqrt(rain(i))*pbase_um, tau_ngw_max) + tau_3dt = max(tau_ngw_min, tau_rain) + endif + endif + tau_ngw(i) = tau_3dt + enddo + end subroutine ngwflux_update +end module cires_ugwpv1_module diff --git a/physics/GWD/ugwp_driver_v0.F b/physics/GWD/ugwp_driver_v0.F90 similarity index 82% rename from physics/GWD/ugwp_driver_v0.F rename to physics/GWD/ugwp_driver_v0.F90 index da9fcbe42..77800faf2 100644 --- a/physics/GWD/ugwp_driver_v0.F +++ b/physics/GWD/ugwp_driver_v0.F90 @@ -1,15 +1,10 @@ -!>\file ugwp_driver_v0.F +!>\file ugwp_driver_v0.F90 !> This module contains the UGWP v0 driver module - module ugwp_driver_v0 - use cires_orowam2017 - contains +module ugwp_driver_v0 + use cires_orowam2017 + contains ! -!===================================================================== -! -!ugwp-v0 subroutines: GWDPS_V0 and fv3_ugwp_solv2_v0 -! -!===================================================================== !>\defgroup ugwp_driverv0_mod UGWP V0 Driver Module !! This is the CIRES UGWP V0 driver module !! @@ -30,16 +25,15 @@ module ugwp_driver_v0 !>Modified/revised version of gwdps.f with bug fixes, tofd, appropriate !! computation of reference level for OGW+COORDE diagnostics. - SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, - & Pdvdt, Pdudt, Pdtdt, Pkdis, U1,V1,T1,Q1,KPBL, - & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DTP,KDT, - & sgh30, HPRIME,OC,OA4,CLX4,THETA,vSIGMA,vGAMMA,ELVMAXD, - & DUSFC, DVSFC, xlatd, sinlat, coslat, sparea, - & cdmbgwd, me, master, rdxzb, con_g, con_omega, - & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, - & dudt_mtb, dudt_ogw, dudt_tms) + SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, & + Pdvdt, Pdudt, Pdtdt, Pkdis, U1,V1,T1,Q1,KPBL, & + PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DTP,KDT, & + sgh30, HPRIME,OC,OA4,CLX4,THETA,vSIGMA,vGAMMA,ELVMAXD, & + DUSFC, DVSFC, xlatd, sinlat, coslat, sparea, & + cdmbgwd, me, master, rdxzb, & + zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & + dudt_mtb, dudt_ogw, dudt_tms, errmsg,errflg ) !---------------------------------------- -! ugwp_v0 ! ! modified/revised version of gwdps.f (with bug fixes, tofd, appropriate ! computation of reference level for OGW + COORDE diagnostics @@ -47,41 +41,60 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, !---------------------------------------- USE MACHINE , ONLY : kind_phys - use ugwp_common_v0,only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 - &, pi, rad_to_deg, deg_to_rad, pi2 - &, rdi, gor, grcp, gocp, fv, gr2 - &, bnv2min, dw2min, velmin, arad + use ugwp_common_v0,only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2, & + pi, rad_to_deg, deg_to_rad, pi2, & + rdi, gor, grcp, gocp, fv, gr2, & + bnv2min, dw2min, velmin, arad - use ugwpv0_oro_init, only : rimin, ric, efmin, efmax - &, hpmax, hpmin, sigfaci => sigfac - &, dpmin, minwnd, hminmt, hncrit - &, RLOLEV, GMAX, VELEPS, FACTOP - &, FRC, CE, CEOFRC, frmax, CG - &, FDIR, MDIR, NWDIR - &, cdmb, cleff, fcrit_gfs, fcrit_mtb - &, n_tofd, ze_tofd, ztop_tofd + use ugwpv0_oro_init, only : rimin, ric, efmin, efmax, & + hpmax, hpmin, sigfaci => sigfac, & + dpmin, minwnd, hminmt, hncrit, & + RLOLEV, GMAX, VELEPS, FACTOP, & + FRC, CE, CEOFRC, frmax, CG, & + FDIR, MDIR, NWDIR, & + cdmb, cleff, fcrit_gfs, fcrit_mtb, & + n_tofd, ze_tofd, ztop_tofd use cires_ugwpv0_module, only : kxw, max_kdis, max_axyz !---------------------------------------- implicit none - integer, parameter :: kp = kind_phys +!---------------------------------------- +! internal parameters +!---------------------------------------- character(len=8) :: strsolver='PSS-1986' ! current operational solver or 'WAM-2017' + real(kind=kind_phys), parameter :: sigfac = 3 ! N*hprime height of Subgrid Hill over which SSO-flo + real(kind=kind_phys), parameter :: sigfacs = 0.5 ! M*hprime height is the low boundary of the hill + +!--------------------------------------------------------------------- +! # of permissible sub-grid orography hills for "any" resolution < 25 +! correction for "elliptical" hills based on shilmin-area =sgrid/25 +! 4.*gamma*b_ell*b_ell >= shilmin +! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min +! gamma_min = 1/4*shilmin/sso_min/sso_min +!23.01.2019: cdmb = 4.*192/768_c192=1 x 0.5 +! 192: cdmbgwd = 0.5, 2.5 +! cleff = 2.5*0.5e-5 * sqrt(192./768.) => Lh_eff = 1004. km +! 6*dx = 240 km 8*dx = 320. ~ 3-5 more effective +!--------------------------------------------------------------------- + real(kind=kind_phys) :: gammin = 0.00999999 ! a/b = gammma_min =1% <====> + real(kind=kind_phys), parameter :: nhilmax = 25. ! max number of SSO-hills in grid-box + real(kind=kind_phys), parameter :: sso_min = 3000. ! min-lenghth of the hill, GTOP30 ~dx~1 km + logical, parameter :: do_adjoro = .true. + integer, intent(in) :: im, km, imx, kdt integer, intent(in) :: me, master logical, intent(in) :: do_tofd - real(kind=kind_phys), parameter :: sigfac = 3, sigfacS = 0.5 real(kind=kind_phys) :: ztopH,zlowH,ph_blk, dz_blk integer, intent(in) :: KPBL(IM) ! Index for the PBL top layer! real(kind=kind_phys), intent(in) :: dtp ! time step real(kind=kind_phys), intent(in) :: cdmbgwd(2) - real(kind=kind_phys), intent(in), dimension(im,km) :: - & u1, v1, t1, q1, - & del, prsl, prslk, phil + real(kind=kind_phys), intent(in), dimension(im,km) :: & + u1, v1, t1, q1, del, prsl, prslk, phil + real(kind=kind_phys), intent(in),dimension(im,km+1):: prsi, phii - real(kind=kind_phys), intent(in) :: xlatd(im),sinlat(im), - & coslat(im) + real(kind=kind_phys), intent(in) :: xlatd(im),sinlat(im), coslat(im) real(kind=kind_phys), intent(in) :: sparea(im) real(kind=kind_phys), intent(in) :: OC(IM), OA4(im,4), CLX4(im,4) @@ -90,95 +103,96 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, real(kind=kind_phys), intent(in) :: vSIGMA(IM), vGAMMA(IM) real(kind=kind_phys) :: SIGMA(IM), GAMMA(IM) - real(kind=kind_phys), intent(in) :: con_g, con_omega - +! !output -phys-tend - real(kind=kind_phys),dimension(im,km),intent(out) :: - & Pdvdt, Pdudt, Pkdis, Pdtdt +! + real(kind=kind_phys),dimension(im,km),intent(out) :: & + Pdvdt, Pdudt, Pkdis, Pdtdt ! output - diag-coorde - &, dudt_mtb, dudt_ogw, dudt_tms -! - real(kind=kind_phys),dimension(im) :: RDXZB, zmtb, zogw - &, tau_ogw, tau_mtb, tau_tofd - &, dusfc, dvsfc + real(kind=kind_phys),dimension(im,km),intent(out) :: & + dudt_mtb, dudt_ogw, dudt_tms + + real(kind=kind_phys),dimension(im) :: RDXZB, zmtb, zogw, & + tau_ogw, tau_mtb, tau_tofd, & + dusfc, dvsfc + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! -!--------------------------------------------------------------------- -! # of permissible sub-grid orography hills for "any" resolution < 25 -! correction for "elliptical" hills based on shilmin-area =sgrid/25 -! 4.*gamma*b_ell*b_ell >= shilmin -! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min -! gamma_min = 1/4*shilmin/sso_min/sso_min -!23.01.2019: cdmb = 4.*192/768_c192=1 x 0.5 -! 192: cdmbgwd = 0.5, 2.5 -! cleff = 2.5*0.5e-5 * sqrt(192./768.) => Lh_eff = 1004. km -! 6*dx = 240 km 8*dx = 320. ~ 3-5 more effective -!--------------------------------------------------------------------- - real(kind=kind_phys) :: gammin = 0.00999999_kp - real(kind=kind_phys), parameter :: nhilmax = 25.0_kp - real(kind=kind_phys), parameter :: sso_min = 3000.0_kp - logical, parameter :: do_adjoro = .true. ! +! locals vars for SSO +! + + real(kind=kind_phys), dimension(im) :: oa, clx real(kind=kind_phys) :: shilmin, sgrmax, sgrmin real(kind=kind_phys) :: belpmin, dsmin, dsmax -! real(kind=kind_phys) :: arhills(im) ! not used why do we need? - real(kind=kind_phys) :: xlingfs ! -! locals -! mean flow +! locals mean flow ...etc +! real(kind=kind_phys), dimension(im,km) :: RI_N, BNV2, RO - &, VTK, VTJ, VELCO + real(kind=kind_phys), dimension(im,km) :: VTK, VTJ, VELCO +!================== !mtb - real(kind=kind_phys), dimension(im) :: OA, CLX , elvmax, wk - &, PE, EK, UP - +!================== + real(kind=kind_phys), dimension(im) :: elvmax, wk + real(kind=kind_phys), dimension(im) :: PE, EK, UP real(kind=kind_phys), dimension(im,km) :: DB, ANG, UDS real(kind=kind_phys) :: ZLEN, DBTMP, R, PHIANG, DBIM, ZR real(kind=kind_phys) :: ENG0, ENG1, COSANG2, SINANG2 real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem -! + +!================== ! TOFD ! Some constants now in "use ugwp_oro_init" + "use ugwp_common" ! !================== real(kind=kind_phys) :: unew, vnew, zpbl, sigflt, zsurf real(kind=kind_phys), dimension(km) :: utofd1, vtofd1 - &, epstofd1, krf_tofd1 - &, up1, vp1, zpm + real(kind=kind_phys), dimension(km) :: epstofd1, krf_tofd1 + real(kind=kind_phys), dimension(km) :: up1, vp1, zpm real(kind=kind_phys),dimension(im, km) :: axtms, aytms -! +!================== ! OGW +!================== + real(kind=kind_phys) :: xlingfs + logical :: icrilv(im) ! - LOGICAL ICRILV(IM) -! - real(kind=kind_phys), dimension(im) :: XN, YN, UBAR, VBAR, ULOW, - & ROLL, bnv2bar, SCOR, DTFAC, XLINV, DELKS, DELKS1 + real(kind=kind_phys), dimension(im) :: XN, YN, UBAR, VBAR, ULOW, & + ROLL, bnv2bar, SCOR, DTFAC, XLINV, DELKS, DELKS1 ! real(kind=kind_phys) :: TAUP(IM,km+1), TAUD(IM,km) real(kind=kind_phys) :: taub(im), taulin(im), heff, hsat, hdis - integer, dimension(im) :: kref, idxzb, ipt, kreflm, - & iwklm, iwk, izlow + integer, dimension(im) :: kref, idxzb, ipt, kreflm, iwklm, iwk, izlow ! -!check what we need +! local real scalars ! real(kind=kind_phys) :: bnv, fr, ri_gw - &, brvf, tem, tem1, tem2, temc, temv - &, ti, rdz, dw2, shr2, bvf2 - &, rdelks, efact, coefm, gfobnv - &, scork, rscor, hd, fro, sira - &, dtaux, dtauy, pkp1log, pklog - &, grav2, rcpdt, windik, wdir - &, sigmin, dxres,sigres,hdxres - &, cdmb4, mtbridge - &, kxridge, inv_b2eff, zw1, zw2 - &, belps, aelps, nhills, selps - - integer :: kmm1, kmm2, lcap, lcapp1 - &, npt, kbps, kbpsp1,kbpsm1 - &, kmps, idir, nwd, klcap, kp1, kmpbl, kmll - &, k_mtb, k_zlow, ktrial, klevm1, i, j, k + real(kind=kind_phys) :: brvf, tem, tem1, tem2, temc, temv + real(kind=kind_phys) :: ti, rdz, dw2, shr2, bvf2 + real(kind=kind_phys) :: rdelks, efact, coefm, gfobnv + real(kind=kind_phys) :: scork, rscor, hd, fro, sira + real(kind=kind_phys) :: dtaux, dtauy, pkp1log, pklog + real(kind=kind_phys) :: grav2, rcpdt, windik, wdir + real(kind=kind_phys) :: sigmin, dxres,sigres,hdxres, cdmb4, mtbridge + real(kind=kind_phys) :: kxridge, inv_b2eff, zw1, zw2 + real(kind=kind_phys) :: belps, aelps, nhills, selps + +! +! local integers +! + integer :: kmm1, kmm2, lcap, lcapp1 + integer :: npt, kbps, kbpsp1,kbpsm1 + integer :: kmps, idir, nwd, klcap, kp1, kmpbl, kmll + integer :: k_mtb, k_zlow, ktrial, klevm1 + integer :: i, j, k +! +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!=========================== ! rcpdt = 1.0 / (cpd*dtp) grav2 = grav + grav @@ -189,7 +203,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, dsmax = sqrt(sgrmax) ; dsmin = sqrt(sgrmin) dxres = pi2*arad/float(IMX) - hdxres = 0.5_kp*dxres + hdxres = 0.5*dxres ! shilmin = sgrmin/nhilmax ! not used - Moorthi ! gammin = min(sso_min/dsmax, 1.) ! Moorthi - with this results are not reproducible @@ -198,10 +212,6 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! sigmin = 2.*hpmin/dsmax !dxres ! Moorthi - this will not reproduce sigmin = 2.*hpmin/dxres !dxres - - - kxridge = float(IMX)/arad * cdmbgwd(2) - do i=1,im idxzb(i) = 0 zmtb(i) = 0.0 @@ -212,7 +222,6 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, dusfc(i) = 0.0 dvsfc(i) = 0.0 tau_tofd(i) = 0.0 -! ipt(i) = 0 sigma(i) = max(vsigma(i), sigmin) gamma(i) = max(vgamma(i), gammin) @@ -235,13 +244,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, npt = 0 do i = 1,im if ( elvmaxd(i) >= hminmt .and. hprime(i) >= hpmin ) then - npt = npt + 1 ipt(npt) = i -! arhills(i) = 1.0 -! sigres = max(sigmin, sigma(i)) -! if (sigma(i) < sigmin) sigma(i)= sigmin dxres = sqrt(sparea(i)) if (2.*hprime(i)/sigres > dxres) sigres=2.*hprime(i)/dxres aelps = min(2.*hprime(i)/sigres, 0.5*dxres) @@ -266,12 +271,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, selps = belps*belps*gamma(i)*4. ! ellipse area of the el-c hill nhills = min(nhilmax, sparea(i)/selps) -! arhills(i) = max(nhills, 1.0) +! if (kdt==1 ) write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, belps*1.e-3, sigma(i),gamma(i) !333 format( ' nhil: ', I6, 4(2x, F9.3), 2(2x, E9.3)) -! if (kdt==1 ) -! & write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, -! & belps*1.e-3, sigma(i),gamma(i) endif enddo @@ -297,13 +299,14 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, KMM1 = km - 1 ; KMM2 = km - 2 ; KMLL = kmm1 LCAP = km ; LCAPP1 = LCAP + 1 + cdmb4 = 0.25*cdmb DO I = 1, npt j = ipt(i) ELVMAX(J) = min (ELVMAXd(J)*0. + sigfac * hprime(j), hncrit) izlow(i) = 1 ! surface-level ENDDO -! + DO K = 1, kmm1 DO I = 1, npt j = ipt(i) @@ -311,16 +314,13 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, zlowH = sigfacs* hprime(j) pkp1log = phil(j,k+1) * rgrav pklog = phil(j,k) * rgrav -! if (( ELVMAX(j) <= pkp1log) .and. (ELVMAX(j).ge.pklog) ) -! & iwklm(I) = MAX(iwklm(I), k+1 ) - if (( ztopH <= pkp1log) .and. (zTOPH >= pklog) ) - & iwklm(I) = MAX(iwklm(I), k+1 ) -! - if (zlowH <= pkp1log .and. zlowH >= pklog) - & izlow(I) = MAX(izlow(I),k) +! if (( ELVMAX(j) <= pkp1log) .and. (ELVMAX(j).ge.pklog) ) iwklm(I) = MAX(iwklm(I), k+1 ) + if (( ztopH <= pkp1log) .and. (zTOPH >= pklog) ) iwklm(I) = MAX(iwklm(I), k+1 ) + + if (zlowH <= pkp1log .and. zlowH >= pklog) izlow(I) = MAX(izlow(I),k) ENDDO ENDDO -! + DO K = 1,km DO I =1,npt J = ipt(i) @@ -344,9 +344,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! TI = 2.0 / (T1(J,K)+T1(J,K+1)) ! BVF2 = Grav*(GOCP+RDZ*(VTJ(I,K+1)-VTJ(I,K)))* TI ! RI_N(I,K) = MAX(BVF2/SHR2,RIMIN) ! Richardson number -! - BVF2 = grav2 * RDZ * (VTK(I,K+1)-VTK(I,K)) - & / (VTK(I,K+1)+VTK(I,K)) + + BVF2 = grav2 * RDZ * (VTK(I,K+1)-VTK(I,K)) & + / (VTK(I,K+1)+VTK(I,K)) bnv2(i,k+1) = max( BVF2, bnv2min ) ! https://github.com/NCAR/ccpp-physics/issues/1103 !RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 @@ -361,7 +361,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, bnv2(i,k) = bnv2(i,k+1) ENDDO ! -! level iwklm =>phil(j,k)/g < sigfac * hprime(j) < phil(j,k+1)/g +! level iwklm => phil(j,k)/g < sigfac * hprime(j) < phil(j,k+1)/g ! DO I = 1, npt J = ipt(i) @@ -383,45 +383,40 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, DO K = k_zlow, iwklm(I)-1 ! Kreflm(I)= iwklm(I)-1 J = ipt(i) ! laye-aver Rho, U, V RDELKS = DEL(J,K) * DELKS(I) - UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below - VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below - ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below -! + UBAR(I) = UBAR(I) + RDELKS * U1(J,K) + VBAR(I) = VBAR(I) + RDELKS * V1(J,K) + ROLL(I) = ROLL(I) + RDELKS * RO(I,K) BNV2bar(I) = BNV2bar(I) + .5*(BNV2(I,K)+BNV2(I,K+1))* RDELKS ENDDO ENDDO -! + DO I = 1, npt J = ipt(i) ! ! integrate from Ztoph = sigfac*hprime down to Zblk if exists -! find ph_blk, dz_blk like in LM-97 and IFS +! find ph_blk, dz_blk as introduced in LM-97 and IFS ! ph_blk =0. DO K = iwklm(I), 1, -1 PHIANG = atan2(V1(J,K),U1(J,K))*RAD_TO_DEG - ANG(I,K) = ( THETA(J) - PHIANG ) + ANG(I,K) = THETA(J) - PHIANG if ( ANG(I,K) > 90. ) ANG(I,K) = ANG(I,K) - 180. if ( ANG(I,K) < -90. ) ANG(I,K) = ANG(I,K) + 180. ANG(I,K) = ANG(I,K) * DEG_TO_RAD - UDS(I,K) = - & MAX(SQRT(U1(J,K)*U1(J,K) + V1(J,K)*V1(J,K)), velmin) -! + UDS(I,K) = MAX(SQRT(U1(J,K)*U1(J,K) + V1(J,K)*V1(J,K)), velmin) + IF (IDXZB(I) == 0 ) then dz_blk = ( PHII(J,K+1) - PHII(J,K) ) *rgrav - PE(I) = PE(I) + BNV2(I,K) * - & ( ELVMAX(J) - phil(J,K)*rgrav ) * dz_blk - + PE(I) = PE(I) + BNV2(I,K) * ( ELVMAX(J) - phil(J,K)*rgrav ) * dz_blk UP(I) = max(UDS(I,K) * cos(ANG(I,K)), velmin) EK(I) = 0.5 * UP(I) * UP(I) - ph_blk = ph_blk + dz_blk*sqrt(BNV2(I,K))/UP(I) ! --- Dividing Stream lime is found when PE =exceeds EK. oper-l GFS ! IF ( PE(I) >= EK(I) ) THEN IF ( ph_blk >= fcrit_gfs ) THEN IDXZB(I) = K - zmtb (J) = PHIL(J, K)*rgrav + zmtb (J) = PHIL(J, K) * rgrav RDXZB(J) = real(k, kind=kind_phys) ENDIF @@ -456,10 +451,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! --- The drag for mtn blocked flow ! - cdmb4 = 0.25*cdmb DO I = 1, npt J = ipt(i) -! + IF ( IDXZB(I) > 0 ) then ! (4.16)-IFS gam2 = gamma(j)*gamma(j) @@ -467,42 +461,35 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, CGAM = 0.48*gamma(j) + 0.30*gam2 DO K = IDXZB(I)-1, 1, -1 - ZLEN = SQRT( ( PHIL(J,IDXZB(I)) - PHIL(J,K) ) / - & ( PHIL(J,K ) + Grav * hprime(J) ) ) +! empirical height dep-nt "blocking" length from LM-1997/IFS +! + ZLEN = SQRT( ( PHIL(J,IDXZB(I)) - PHIL(J,K) ) / & + ( PHIL(J,K ) + Grav * hprime(J) ) ) tem = cos(ANG(I,K)) COSANG2 = tem * tem SINANG2 = 1.0 - COSANG2 -! -! cos =1 sin =0 => 1/R= gam ZR = 2.-gam -! cos =0 sin =1 => 1/R= 1/gam ZR = 2.- 1/gam -! rdem = COSANG2 + GAM2 * SINANG2 rnom = COSANG2*GAM2 + SINANG2 ! ! metOffice Dec 2010 ! correction of H. Wells & A. Zadra for the -! aspect ratio of the hill seen by MF +! aspect ratio of the elliptical hill seen by mean flow ! (1/R , R-inverse below: 2-R) rdem = max(rdem, 1.e-6) R = sqrt(rnom/rdem) ZR = MAX( 2. - R, 0. ) - sigres = max(sigmin, sigma(J)) if (hprime(J)/sigres > dxres) sigres = hprime(J)/dxres mtbridge = ZR * sigres*ZLEN / hprime(J) -! (4.15)-IFS -! DBTMP = CDmb4 * mtbridge * -! & MAX(cos(ANG(I,K)), gamma(J)*sin(ANG(I,K))) -! (4.16)-IFS - DBTMP = CDmb4*mtbridge*(bgam* COSANG2 +cgam* SINANG2) +! dbtmp = cdmb4*mtbridge*max(cos(ang(i,k)), gamma(j)*sin(ang(i,k))) ! (4.15)-ifs + dbtmp = cdmb4*mtbridge*(bgam * cosang2 + cgam * sinang2) ! (4.16)-ifs DB(I,K)= DBTMP * UDS(I,K) ENDDO -! + endif ENDDO -! !............................. !............................. ! end mtn blocking section @@ -579,7 +566,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ENDDO ENDDO ! -! orographic asymmetry parameter (OA), and (CLX) +! orographic asymmetry parameters (oa), and (clx) [Kim & Arakawa Kim & Doyle] DO I = 1,npt J = ipt(i) wdir = atan2(UBAR(I),VBAR(I)) + pi @@ -600,8 +587,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, DO K = 1, kmm1 DO I = 1,npt J = ipt(i) - VELCO(I,K) = 0.5 * ((U1(J,K)+U1(J,K+1))*XN(I) - & + (V1(J,K)+V1(J,K+1))*YN(I)) + VELCO(I,K) = 0.5 * ((U1(J,K)+U1(J,K+1))*XN(I) & + + (V1(J,K)+V1(J,K+1))*YN(I)) ENDDO ENDDO ! @@ -648,17 +635,16 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, inv_b2eff = 0.5*sigres/heff kxridge = 1.0 / sqrt(sparea(J)) XLINV(I) = XLINGFS !or max(kxridge, inv_b2eff) ! 6.28/Lx ..0.5*sigma(j)/heff = 1./Lridge - taulin(i) = 0.5*ROLL(I)*XLINV(I)*BNV*ULOW(I)* - & heff*heff + taulin(i) = 0.5*ROLL(I)*XLINV(I)*BNV*ULOW(I)* heff*heff if ( FR > fcrit_gfs ) then - TAUB(I) = XLINV(I) * ROLL(I) * ULOW(I) * ULOW(I) - & * ULOW(I) * GFOBNV * EFACT ! nonlinear FLUX Tau0...XLINV(I) + TAUB(I) = XLINV(I) * ROLL(I) * ULOW(I) * ULOW(I) & + * ULOW(I) * GFOBNV * EFACT ! nonlinear FLUX Tau0...XLINV(I) ! else ! - TAUB(I) = XLINV(I) * ROLL(I) * ULOW(I) * ULOW(I) - & * ULOW(I) * GFOBNV * EFACT + TAUB(I) = XLINV(I) * ROLL(I) * ULOW(I) * ULOW(I) & + * ULOW(I) * GFOBNV * EFACT ! ! TAUB(I) = taulin(i) ! linear flux for FR <= fcrit_gfs ! @@ -697,8 +683,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, DO I = 1, npt ! IF (K >= kref(I)) THEN - ICRILV(I) = ICRILV(I) .OR. ( RI_N(I,K) < RIC) - & .OR. (VELCO(I,K) <= 0.0) + ICRILV(I) = ICRILV(I) .OR. ( RI_N(I,K) < RIC) & + .OR. (VELCO(I,K) <= 0.0) ENDIF ENDDO ! @@ -718,8 +704,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, BRVF = SQRT(BNV2(I,K)) ! Brent-Vaisala Frequency interface ! TEM1 = XLINV(I)*(RO(I,KP1)+RO(I,K))*BRVF*VELCO(I,K)*0.5 - TEM1 = XLINV(I)*(RO(I,KP1)+RO(I,K))*BRVF*0.5 - & * max(VELCO(I,K), velmin) + TEM1 = XLINV(I)*(RO(I,KP1)+RO(I,K))*BRVF*0.5 & + * max(VELCO(I,K), velmin) HD = SQRT(TAUP(I,K) / TEM1) FRO = BRVF * HD * TEMV ! @@ -733,8 +719,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! CHECK STABILITY TO EMPLOY THE 'dynamical SATURATION HYPOTHESIS' ! OF PALMER,Shutts, Swinbank 1986 ! ---------------------- - IF (RI_GW <= RIC .AND. - & (OA(I) <= 0. .OR. kp1 >= kref(i) )) THEN + IF (RI_GW <= RIC .AND. & + (OA(I) <= 0. .OR. kp1 >= kref(i) )) THEN TEMC = 2.0 + 1.0 / TEM2 HD = VELCO(I,K) * (2.*SQRT(TEMC)-TEMC) / BRVF TAUP(I,KP1) = TEM1 * HD * HD @@ -799,10 +785,10 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! XLINV(I) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./Lridge dtfac(:) = 1.0 - call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, - & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, - & del, sigma, hprime, gamma, theta, - & sinlat, xlatd, taup, taud, pkdis) + call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, & + dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, & + del, sigma, hprime, gamma, theta, & + sinlat, xlatd, taup, taud, pkdis) endif ! oro_wam_2017 - LINSATDIS-solver of WAM-2017 ! @@ -828,8 +814,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, vp1(k) = v1(j,k) enddo - call ugwpv0_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, - & up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) + call ugwpv0_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, & + up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) do k=1,km axtms(j,k) = utofd1(k) @@ -912,8 +898,6 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, tau_tofd(J) = -rgrav * tau_tofd(j) ENDDO - RETURN - end subroutine gwdps_v0 @@ -924,11 +908,11 @@ end subroutine gwdps_v0 !> A modification of the Scinocca (2003) \cite scinocca_2003 algorithm for !! NGWs with non-hydrostatic and rotational !!effects for GW propagations and background dissipation - subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, - & tm1 , um1, vm1, qm1, - & prsl, prsi, philg, xlatd, sinlat, coslat, - & pdudt, pdvdt, pdtdt, dked, tau_ngw, - & mpi_id, master, kdt) + subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, & + tm1 , um1, vm1, qm1, & + prsl, prsi, philg, xlatd, sinlat, coslat, & + pdudt, pdvdt, pdtdt, dked, tau_ngw, & + mpi_id, master, kdt) ! @@ -940,19 +924,19 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! use machine, only : kind_phys - use ugwp_common_v0 , only : rgrav, grav, cpd, rd, rv - &, omega2, rcpd2, pi, pi2, fv - &, rad_to_deg, deg_to_rad - &, rdi, gor, grcp, gocp - &, bnv2min, dw2min, velmin, gr2 + use ugwp_common_v0 , only : rgrav, grav, cpd, rd, rv, & + omega2, rcpd2, pi, pi2, fv, & + rad_to_deg, deg_to_rad, & + rdi, gor, grcp, gocp, & + bnv2min, dw2min, velmin, gr2 ! - use ugwpv0_wmsdis_init, only : hpscale, rhp2, bv2min, gssec - &, v_kxw, v_kxw2, tamp_mpa, zfluxglob - &, maxdudt, gw_eff, dked_min - &, nslope, ilaunch, zmsi - &, zci, zdci, zci4, zci3, zci2 - &, zaz_fct, zcosang, zsinang - &, nwav, nazd, zcimin, zcimax + use ugwpv0_wmsdis_init, only : hpscale, rhp2, bv2min, gssec, & + v_kxw, v_kxw2, tamp_mpa, zfluxglob, & + maxdudt, gw_eff, dked_min, & + nslope, ilaunch, zmsi, & + zci, zdci, zci4, zci3, zci2, & + zaz_fct, zcosang, zsinang, & + nwav, nazd, zcimin, zcimax ! implicit none !23456 @@ -1046,9 +1030,9 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! real :: rcpd, grav2cpd - real, parameter :: rcpdl = cpd/grav ! 1/[g/cp] == cp/g - &, grav2cpd = grav/rcpdl ! g*(g/cp)= g^2/cp - &, cpdi = one/cpd + real, parameter :: rcpdl = cpd/grav, & ! 1/[g/cp] == cp/g + grav2cpd = grav/rcpdl, & ! g*(g/cp)= g^2/cp + cpdi = one/cpd real :: expdis, fdis ! real :: fmode, expdis, fdis @@ -1101,12 +1085,12 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zdelp = phil(jl,jk)-phil(jl,jk-1) !>0 ...... dz-meters v_zmet(jl,jk) = zdelp + zdelp delpi(jl,jk) = grav / (prsi(jl,jk-1) - prsi(jl,jk)) - vueff(jl,jk) = - & 2.e-5_kp*exp( (phil(jl,jk)+phil(jl,jk-1))*rhp2)+dked_min + vueff(jl,jk) = & + 2.e-5_kp*exp( (phil(jl,jk)+phil(jl,jk-1))*rhp2)+dked_min ! ! zbn2(jl,jk) = grav2cpd/zthm1(jl,jk) - zbn2(jl,jk) = grav2cpd*zthm1 - & * (one+rcpdl*(tm1(jl,jk)-tm1(jl,jk-1))/zdelp) + zbn2(jl,jk) = grav2cpd*zthm1 & + * (one+rcpdl*(tm1(jl,jk)-tm1(jl,jk-1))/zdelp) zbn2(jl,jk) = max(min(zbn2(jl,jk), gssec), bv2min) zbvfhm1(jl,jk) = sqrt(zbn2(jl,jk)) ! bn = sqrt(bn2) enddo @@ -1134,16 +1118,16 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! ------------------------------------------------------------------------------------------ do iazi=1, nazd do jl=1,klon - zul(jl,iazi) = zcosang(iazi) * zuhm1(jl,ilaunch) - & + zsinang(iazi) * zvhm1(jl,ilaunch) + zul(jl,iazi) = zcosang(iazi) * zuhm1(jl,ilaunch) & + + zsinang(iazi) * zvhm1(jl,ilaunch) enddo enddo ! do jk=ilaunch, klev-1 ! from z-launch up model level from which gw spectrum is launched do iazi=1, nazd do jl=1,klon - zu = zcosang(iazi)*zuhm1(jl,jk) - & + zsinang(iazi)*zvhm1(jl,jk) + zu = zcosang(iazi)*zuhm1(jl,jk) & + + zsinang(iazi)*zvhm1(jl,jk) zui(jl,jk,iazi) = zu - zul(jl,iazi) enddo enddo @@ -1170,8 +1154,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, !n4 zbvfl4 = zbvfl(jl) * zbvfl(jl) zbvfl4 = zbvfl4 * zbvfl4 - zflux(jl,inc,1) = zfct(jl,ilaunch)*zbvfl4*zcin - & / (zbvfl4+zcin4) + zflux(jl,inc,1) = zfct(jl,ilaunch)*zbvfl4*zcin & + / (zbvfl4+zcin4) enddo enddo elseif(nslope == 2) then ! s=2 case @@ -1183,8 +1167,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zbvfl4 = zbvfl(jl) * zbvfl(jl) zbvfl4 = zbvfl4 * zbvfl4 zcpeak = zbvfl(jl) * zmsi - zflux(jl,inc,1) = zfct(jl,ilaunch)* - & zbvfl4*zcin*zcpeak/(zbvfl4*zcpeak+zcin4*zcin) + zflux(jl,inc,1) = zfct(jl,ilaunch)* & + zbvfl4*zcin*zcpeak/(zbvfl4*zcpeak+zcin4*zcin) enddo enddo elseif(nslope == -1) then ! s=-1 case @@ -1194,8 +1178,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zcin2 = zci2(inc) do jl=1,klon zbvfl2 = zbvfl(jl)*zbvfl(jl) - zflux(jl,inc,1) = zfct(jl,ilaunch)*zbvfl2*zcin - & / (zbvfl2+zcin2) + zflux(jl,inc,1) = zfct(jl,ilaunch)*zbvfl2*zcin & + / (zbvfl2+zcin2) enddo enddo elseif(nslope == 0) then ! s=0 case @@ -1206,8 +1190,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zcin3 = zci3(inc) do jl=1,klon zbvfl3 = zbvfl(jl)**3 - zflux(jl,inc,1) = zfct(jl,ilaunch)*zbvfl3*zcin - & / (zbvfl3+zcin3) + zflux(jl,inc,1) = zfct(jl,ilaunch)*zbvfl3*zcin & + / (zbvfl3+zcin3) enddo enddo @@ -1287,8 +1271,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! zatmp = minvel + sign(minvel,zcin-zci_min(jl,iazi)) ! zacc(jl,inc,iazi) = zact(jl,inc,iazi)-zatmp ! zact(jl,inc,iazi) = zatmp - zact(jl,inc,iazi) = minvel - & + sign(minvel,zci(inc)-zci_min(jl,iazi)) + zact(jl,inc,iazi) = minvel & + + sign(minvel,zci(inc)-zci_min(jl,iazi)) enddo enddo ! @@ -1298,8 +1282,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! do inc=1, nwav ! zcinc = zdci(inc) ! do jl=1,klon -! zdfl(jl,jk,iazi) = zdfl(jl,jk,iazi) + -! & zacc(jl,inc,iazi)*zflux(jl,inc,iazi)*zcinc +! zdfl(jl,jk,iazi) = zdfl(jl,jk,iazi) + & +! zacc(jl,inc,iazi)*zflux(jl,inc,iazi)*zcinc ! enddo ! enddo ! -------------------------------------------- @@ -1310,8 +1294,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! if(zdfl(jl,jk,iazi) > epsln ) then ! zatmp = zcrt(jl,jk,iazi) ! do inc=1, nwav -! zatmp = zatmp + zci(inc) * -! & zacc(jl,inc,iazi)*zflux(jl,inc,iazi)*zdci(inc) +! zatmp = zatmp + zci(inc) * & +! zacc(jl,inc,iazi)*zflux(jl,inc,iazi)*zdci(inc) ! enddo ! ! zcrt(jl,jk,iazi) = zatmp / zdfl(jl,jk,iazi) @@ -1403,15 +1387,15 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! later sum over selected azimuths as "non-negative" scalars) !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ if (jk > ilaunch)then -! zdelp = grav/(prsi(jl,jk-1)-prsi(jl,jk))* -! & abs(zcin-zui(jl,jk,iazi)) *zcinc +! zdelp = grav/(prsi(jl,jk-1)-prsi(jl,jk))* & +! abs(zcin-zui(jl,jk,iazi)) *zcinc zdelp = delpi(jl,jk) * abs(zcin-zui(jl,jk,iazi)) *zcinc vm_zflx_mode = zact(jl,inc,iazi)* zflux_z(jl,inc,jk-1) - if (vc_zflx_mode > vm_zflx_mode) - & vc_zflx_mode = vm_zflx_mode ! no-flux increase - zdfdz_v( jl,jk,iazi) = zdfdz_v( jl,jk,iazi) + - & (vm_zflx_mode-vc_zflx_mode)*zdelp ! heating >0 + if (vc_zflx_mode > vm_zflx_mode) & + vc_zflx_mode = vm_zflx_mode ! no-flux increase + zdfdz_v( jl,jk,iazi) = zdfdz_v( jl,jk,iazi) + & + (vm_zflx_mode-vc_zflx_mode)*zdelp ! heating >0 ! ! endif @@ -1488,7 +1472,6 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo ! !--------------------------------------------------------------------------- - return end subroutine fv3_ugwp_solv2_v0 - end module ugwp_driver_v0 +end module ugwp_driver_v0 diff --git a/physics/GWD/ugwpv1_gsldrag.F90 b/physics/GWD/ugwpv1_gsldrag.F90 index 2a5fba5e0..5bdef0e1b 100644 --- a/physics/GWD/ugwpv1_gsldrag.F90 +++ b/physics/GWD/ugwpv1_gsldrag.F90 @@ -1,6 +1,6 @@ !> \file ugwpv1_gsldrag.F90 -!> This module introduces two gravity wave drag schemes: UGWPv1 and orographic drag scheme +!> This module introduces two gravity wave drag schemes: UGWPv1 and orographic drag scheme !! !! 1) The "V1 CIRES UGWP" scheme as tested in the FV3GFSv16-127L atmosphere model and workflow, which includes: !! a) the orograhic gravity wave drag, flow blocking scheme and TOFD (Beljaars et al, 2004). @@ -69,7 +69,7 @@ module ugwpv1_gsldrag !! subroutine ugwpv1_gsldrag_init ( & me, master, nlunit, input_nml_file, logunit, & - fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, & + fn_nml2, jdat, lonr, levs, ak, bk, dtp, & con_pi, con_rerth, con_p0, & con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt, & do_ugwp,do_ugwp_v0, do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, & @@ -90,7 +90,6 @@ subroutine ugwpv1_gsldrag_init ( & integer, intent (in) :: jdat(:) integer, intent (in) :: lonr integer, intent (in) :: levs - integer, intent (in) :: latr real(kind=kind_phys), intent (in) :: ak(:), bk(:) real(kind=kind_phys), intent (in) :: dtp @@ -107,11 +106,6 @@ subroutine ugwpv1_gsldrag_init ( & character(len=*), intent (in) :: fn_nml2 !character(len=*), parameter :: fn_nml='input.nml' - integer :: ios - logical :: exists - real :: dxsg - integer :: k - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -160,7 +154,7 @@ subroutine ugwpv1_gsldrag_init ( & return end if -! + if ( do_ugwp_v0_orog_only .or. do_ugwp_v0) then print *, ' ccpp do_ugwp_v0 active ', do_ugwp_v0 print *, ' ccpp do_ugwp_v1_orog_only active ', do_ugwp_v0_orog_only @@ -169,7 +163,7 @@ subroutine ugwpv1_gsldrag_init ( & errflg = 1 return endif -! + if (do_ugwp_v1_w_gsldrag .and. do_ugwp_v1_orog_only ) then print *, ' do_ugwp_v1_w_gsldrag ', do_ugwp_v1_w_gsldrag @@ -234,7 +228,7 @@ subroutine ugwpv1_gsldrag_init ( & if ( do_ugwp_v1 ) then call cires_ugwpv1_init (me, master, nlunit, logunit, jdat, con_pi, & - con_rerth, fn_nml2, input_nml_file, lonr, latr, & + con_rerth, fn_nml2, input_nml_file, lonr, & levs, ak, bk, con_p0, dtp, errmsg, errflg) if (errflg/=0) return end if @@ -250,14 +244,10 @@ subroutine ugwpv1_gsldrag_init ( & print *, ' ccpp: ugwpv1_gsldrag_init ' endif - - is_initialized = .true. - end subroutine ugwpv1_gsldrag_init - ! ----------------------------------------------------------------------- ! finalize of ugwpv1_gsldrag (_finalize) ! ----------------------------------------------------------------------- @@ -270,7 +260,7 @@ end subroutine ugwpv1_gsldrag_init subroutine ugwpv1_gsldrag_finalize(errmsg, errflg) implicit none -! + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -286,7 +276,6 @@ subroutine ugwpv1_gsldrag_finalize(errmsg, errflg) end subroutine ugwpv1_gsldrag_finalize - ! ----------------------------------------------------------------------- ! originally from ugwp_driver_v0.f ! driver of cires_ugwp (_driver) @@ -333,8 +322,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! c) /FV3/gfsphysics/GFS_layer/GFS_diagnostics.F90 "diag-cs is not tested" !######################################################################## -! - use ugwp_common, only : con_pi => pi, con_g => grav, con_rd => rd, & con_rv => rv, con_cp => cpd, con_fv => fv, & con_rerth => arad, con_omega => omega1, rgrav @@ -350,7 +337,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! ! unified GSL and CIRES diagnostics inside CCPP and GFS_typedefs.F90/GFS_diagnostics.F90 ! -! ! interface variables logical, intent(in) :: ldiag3d, lssav logical, intent(in) :: flag_for_gwd_generic_tend @@ -435,7 +421,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) - integer, intent(in) :: & + integer, intent(in) :: & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd @@ -468,7 +454,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, real(kind=kind_phys), dimension(im, levs) :: zmet ! geopotential height at model Layer centers real(kind=kind_phys), dimension(im, levs+1) :: zmeti ! geopotential height at model layer interfaces - ! ugwp_v1 local variables integer :: y4, month, day, ddd_ugwp, curdate, curday, idtend @@ -478,7 +463,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! in the Middle atmosphere: 20-110 km ( not active in CCPP-style, oct 2020) ! real(kind=kind_phys) :: tauabs(im,levs), wrms(im,levs), trms(im,levs) - ! Initialize CCPP error handling variables errmsg = '' @@ -489,7 +473,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! ! for all oro-suites can uze geo-meters having "hpbl" ! -! ! All GW-schemes operate with Zmet =phil*inv_g, passing Zmet/Zmeti can be more robust ! + rho*dz = =delp * inv_g can be also pre-comp for all "GW-schemes" ! @@ -511,7 +494,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, dusfcg (:) = 0. ; dvsfcg(:) =0. - ! ngw+ogw - diag dudt_gw(:,:)=0. ; dvdt_gw(:,:)=0. ; dtdt_gw(:,:)=0. ; dqdt_gw(:,:,:)=0. ; kdis_gw(:,:)=0. @@ -534,7 +516,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, Pkdis(i,k) = 0.0 enddo enddo -! + ! Run the appropriate large-scale (large-scale GWD + blocking) scheme ! Note: In case of GSL drag_suite, this includes ss and tofd @@ -545,7 +527,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl,dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd ! du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, du_osscol, dv_osscol, du_ofdcol dv_ofdcol ! dusfcg, dvsfcg -! ! if (do_gwd_opt_psl) then call drag_suite_psl(im, levs, Pdvdt, Pdudt, Pdtdt, & @@ -646,7 +627,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! ! orogw_v1: dusfcg = du_ogwcol + du_oblcol + du_ofdcol only 3 terms ! -! ! if (kdt <= 2 .and. me == master) then ! ! print *, ' unified_ugwp orogw_v1 ', kdt, me, nmtvr @@ -657,7 +637,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! print *, ' unified_ugwp orogw_v1 dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 ! endif - end if ! ! for old-fashioned GFS-style diag-cs like dt3dt(:.:, 1:14) collections @@ -699,10 +678,9 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! fhour = (kdt-1)*dtp/3600. ! fhrday = fhour/24. - nint(fhour/24.) - call calendar_ugwp(y4, month, day, ddd_ugwp) curdate = y4*1000 + ddd_ugwp -! + call ngwflux_update(me, master, im, levs, kdt, ddd_ugwp,curdate, & tau_amf, xlat_d, sinlat,coslat, rain, tau_ngw) @@ -736,7 +714,6 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! print *, ' ugwp_v1 dT/dt ', maxval(dtdt_ngw)*86400, minval(dtdt_ngw)*86400 ! endif - end if ! do_ugwp_v1 if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then diff --git a/physics/GWD/ugwpv1_gsldrag.meta b/physics/GWD/ugwpv1_gsldrag.meta index 0d219769e..77883a39c 100644 --- a/physics/GWD/ugwpv1_gsldrag.meta +++ b/physics/GWD/ugwpv1_gsldrag.meta @@ -3,7 +3,7 @@ type = scheme dependencies = ../hooks/machine.F,drag_suite.F90 dependencies = cires_ugwpv1_module.F90,cires_ugwpv1_triggers.F90,cires_ugwpv1_initialize.F90,cires_ugwpv1_solv2.F90,ecmwf_ngw.F90 - dependencies = cires_ugwpv1_sporo.F90,cires_ugwpv1_oro.F90 + dependencies = cires_ugwpv1_sporo.F90,cires_ugwpv1_oro.F90 ######################################################################## [ccpp-arg-table] name = ugwpv1_gsldrag_init @@ -66,13 +66,6 @@ dimensions = () type = integer intent = in -[latr] - standard_name = number_of_latitude_points - long_name = number of global points in y-dir (j) along the meridian - units = count - dimensions = () - type = integer - intent = in [levs] standard_name = vertical_layer_dimension long_name = number of vertical levels @@ -778,7 +771,7 @@ units = mixed dimensions = (horizontal_loop_extent) type = real - kind = kind_phys + kind = kind_phys intent = in [dudt_ogw] standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag @@ -1157,5 +1150,3 @@ dimensions = () type = integer intent = out - - diff --git a/physics/GWD/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 index 3bed8ca32..9950c1d05 100644 --- a/physics/GWD/unified_ugwp.F90 +++ b/physics/GWD/unified_ugwp.F90 @@ -48,7 +48,7 @@ module unified_ugwp public unified_ugwp_init, unified_ugwp_run, unified_ugwp_finalize - logical :: is_initialized = .False. + logical :: is_initialized = .false. contains @@ -63,7 +63,7 @@ module unified_ugwp !! \htmlinclude unified_ugwp_init.html !! subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & - fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & + fn_nml2, jdat, lonr, levs, ak, bk, dtp, cdmbgwd, cgwf, & con_pi, con_rerth, pa_rf_in, tau_rf_in, con_p0, do_ugwp, & do_ugwp_v0, do_ugwp_v0_orog_only, do_ugwp_v0_nst_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, gwd_opt, & @@ -80,7 +80,6 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & integer, intent (in) :: jdat(:) integer, intent (in) :: lonr integer, intent (in) :: levs - integer, intent (in) :: latr real(kind=kind_phys), intent (in) :: ak(:), bk(:) real(kind=kind_phys), intent (in) :: dtp real(kind=kind_phys), intent (in) :: cdmbgwd(:), cgwf(:) ! "scaling" controls for "old" GFS-GW schemes @@ -95,11 +94,6 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & character(len=*), intent (in) :: fn_nml2 !character(len=*), parameter :: fn_nml='input.nml' - integer :: ios - logical :: exists - real :: dxsg - integer :: k - integer, intent(in) :: gwd_opt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -129,16 +123,16 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & end if - if (is_initialized) return - if ( do_ugwp_v0 .or. do_ugwp_v0_nst_only ) then ! if (do_ugwp .or. cdmbgwd(3) > 0.0) then (deactivate effect of do_ugwp) if (cdmbgwd(3) > 0.0) then call cires_ugwpv0_mod_init(me, master, nlunit, input_nml_file, logunit, & - fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & - cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) + fn_nml2, lonr, levs, ak, bk, con_p0, dtp, & + cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in, & + errmsg, errflg) + if (errflg/=0) return else write(errmsg,'(*(a))') "Logic error: cires_ugwp_mod_init called but & &do_ugwp_v0 or do_ugwp_v0_nst_only is true and cdmbgwd(3) <= 0" @@ -147,12 +141,10 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & end if end if - is_initialized = .true. end subroutine unified_ugwp_init - ! ----------------------------------------------------------------------- ! finalize of unified_ugwp (_finalize) ! ----------------------------------------------------------------------- @@ -166,7 +158,7 @@ subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v0_nst_only, & errmsg, errflg) implicit none -! + logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_nst_only character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -183,7 +175,6 @@ subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v0_nst_only, & end subroutine unified_ugwp_finalize - ! ----------------------------------------------------------------------- ! originally from ugwp_driver_v0.f ! driver of cires_ugwp (_driver) @@ -195,49 +186,49 @@ end subroutine unified_ugwp_finalize !> This subroutine executes the CIRES UGWP Version 0. !! !> \section gen_unified_ugwp GFS Unified GWP Scheme General Algorithm -!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 -!! \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced -!! in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, -!! Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, -!! and Scinocca (2003) \cite scinocca_2003. The major modification of -!! these GW solvers is represented by the addition of the background -!! dissipation of temperature and winds to the saturation criteria for -!! wave breaking. This feature is important in the mesosphere and -!! thermosphere for WAM applications and it considers appropriate -!! scale-dependent dissipation of waves near the model top lid providing -!! the momentum and energy conservation in the vertical column physics -!! (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, -!! the modification of Scinocca (2003) \cite scinocca_2003 scheme for +!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 +!! \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced +!! in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, +!! Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, +!! and Scinocca (2003) \cite scinocca_2003. The major modification of +!! these GW solvers is represented by the addition of the background +!! dissipation of temperature and winds to the saturation criteria for +!! wave breaking. This feature is important in the mesosphere and +!! thermosphere for WAM applications and it considers appropriate +!! scale-dependent dissipation of waves near the model top lid providing +!! the momentum and energy conservation in the vertical column physics +!! (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, +!! the modification of Scinocca (2003) \cite scinocca_2003 scheme for !! NGWs with non-hydrostatic and rotational effects for GW propagations -!! and backgroufnd dissipation is represented by the subroutine -!! fv3_ugwp_solv2_v0. In the next release of UGWP, additional -!! GW-solvers will be implemented along with physics-based triggering -!! of waves and stochastic approaches for selection of GW modes -!! characterized by horizontal phase velocities, azimuthal directions +!! and backgroufnd dissipation is represented by the subroutine +!! fv3_ugwp_solv2_v0. In the next release of UGWP, additional +!! GW-solvers will be implemented along with physics-based triggering +!! of waves and stochastic approaches for selection of GW modes +!! characterized by horizontal phase velocities, azimuthal directions !! and magnitude of the vertical momentum flux (VMF). !! -!! In UGWP-v0, the specification for the VMF function is adopted from -!! the GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described -!! in Molod et al. (2015) \cite molod_et_al_2015 and employed in the -!! MERRRA-2 reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). -!! The Fortran subroutine slat_geos5_tamp_v0() describes the latitudinal -!! shape of VMF-function as displayed in Figure 3 of Molod et al. (2015) -!! \cite molod_et_al_2015. It shows that the enhanced values of VMF in -!! the equatorial region gives opportunity to simulate the QBO-like -!! oscillations in the equatorial zonal winds and lead to more realistic -!! simulations of the equatorial dynamics in GEOS-5 operational and -!! MERRA-2 reanalysis products. For the first vertically extended -!! version of FV3GFS in the stratosphere and mesosphere, this simplified -!! function of VMF allows us to tune the model climate and to evaluate -!! multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis -!! products, along with temperature, ozone, and water vapor observations -!! of current satellite missions. After delivery of the UGWP-code, the -!! EMC group developed and tested approach to modulate the zonal mean -!! NGW forcing by 3D-distributions of the total precipitation as a proxy -!! for the excitation of NGWs by convection and the vertically-integrated -!! (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification -!! scores with updated NGW forcing, as reported elsewhere by EMC researchers, -!! display noticeable improvements in the forecast scores produced by FV3GFS +!! In UGWP-v0, the specification for the VMF function is adopted from +!! the GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described +!! in Molod et al. (2015) \cite molod_et_al_2015 and employed in the +!! MERRRA-2 reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). +!! The Fortran subroutine slat_geos5_tamp_v0() describes the latitudinal +!! shape of VMF-function as displayed in Figure 3 of Molod et al. (2015) +!! \cite molod_et_al_2015. It shows that the enhanced values of VMF in +!! the equatorial region gives opportunity to simulate the QBO-like +!! oscillations in the equatorial zonal winds and lead to more realistic +!! simulations of the equatorial dynamics in GEOS-5 operational and +!! MERRA-2 reanalysis products. For the first vertically extended +!! version of FV3GFS in the stratosphere and mesosphere, this simplified +!! function of VMF allows us to tune the model climate and to evaluate +!! multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis +!! products, along with temperature, ozone, and water vapor observations +!! of current satellite missions. After delivery of the UGWP-code, the +!! EMC group developed and tested approach to modulate the zonal mean +!! NGW forcing by 3D-distributions of the total precipitation as a proxy +!! for the excitation of NGWs by convection and the vertically-integrated +!! (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification +!! scores with updated NGW forcing, as reported elsewhere by EMC researchers, +!! display noticeable improvements in the forecast scores produced by FV3GFS !! configuration extended into the mesosphere. !! !> \section arg_table_unified_ugwp_run Argument Table @@ -278,12 +269,12 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, real(kind=kind_phys), intent(in), dimension(:) :: dx !vay-nov 2020 - real(kind=kind_phys), intent(in), dimension(:,:) :: oa4ss,ol4ss - + real(kind=kind_phys), intent(in), dimension(:,:) :: oa4ss,ol4ss + logical, intent(in) :: flag_for_gwd_generic_tend - + ! elvmax is intent(in) for CIRES UGWPv1, but intent(inout) for GFS GWDPS - + real(kind=kind_phys), intent(inout), dimension(:) :: elvmax real(kind=kind_phys), intent(in), dimension(:,:) :: clx, oa4 real(kind=kind_phys), intent(in), dimension(:) :: xlat, xlat_d, sinlat, coslat, area @@ -349,7 +340,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, ! option for psl gwd logical, intent(in) :: do_gwd_opt_psl ! option for psl gravity wave drag - real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor ! + real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -366,7 +357,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, ! ugwp_seq_update == T, otherwise, they retain the values ! passed to the scheme. real(kind=kind_phys), dimension(im, levs) :: uwnd1, vwnd1 - + real(kind=kind_phys), parameter :: tamp_mpa=30.e-3 integer :: nmtvr_temp, idtend @@ -383,7 +374,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, errmsg = '' errflg = 0 - ! Initialize intent(out) variables in case they are not set below dusfcg(:) = 0.0 dvsfcg(:) = 0.0 @@ -396,7 +386,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, gw_kdis(:,:) = 0.0 dudt_mtb(:,:) = 0.0 dudt_tms(:,:) = 0.0 - + ! 1) ORO stationary GWs ! ------------------ @@ -420,7 +410,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, dtauy2d_fd(:,:)= 0.0 end if - ! Prepare to run UGWP_v0 mesoscale GWD + blocking scheme ! These tendency initializations pertain to the non-stationary GWD ! scheme as well @@ -480,7 +469,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 end if - if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then idtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) if(idtend>=1) then @@ -500,13 +488,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, end if - - ! Run the appropriate mesoscale (mesoscale GWD + blocking) scheme ! Note: In case of GSL drag_suite, this includes ss and tofd if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd ) then -! + if (do_gwd_opt_psl) then call drag_suite_psl(im,levs,gw_dvdt,gw_dudt,gw_dtdt,uwnd1, & vwnd1,tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil, & @@ -551,10 +537,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, ! tau_mtb = 0. ; tau_ogw = 0. ; tau_tofd = 0. dudt_mtb = 0. ; dudt_tms = 0. - - end if - + end if !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Begin non-stationary GW schemes @@ -635,13 +619,13 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, enddo endif ! cdmbgwd(3) > 0.0 - + if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then idtend = dtidx(index_of_x_wind,index_of_process_nonorographic_gwd) if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dudt_ngw(:,:)*dtp endif - + idtend = dtidx(index_of_y_wind,index_of_process_nonorographic_gwd) if(idtend>=1) then dtend(:,:,idtend) = dtend(:,:,idtend) + dvdt_ngw(:,:)*dtp @@ -653,8 +637,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, endif endif - end if ! do_ugwp_v0.or.do_ugwp_v0_nst_only - + end if ! do_ugwp_v0.or.do_ugwp_v0_nst_only end subroutine unified_ugwp_run !>@} diff --git a/physics/GWD/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta index 74f137186..5d636384b 100644 --- a/physics/GWD/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -3,7 +3,7 @@ type = scheme dependencies = ../hooks/machine.F dependencies = cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 - dependencies = cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,ugwp_driver_v0.F + dependencies = cires_orowam2017.f,cires_ugwp_module.F90,gwdps.f,ugwp_driver_v0.F90 dependencies = drag_suite.F90 ######################################################################## @@ -68,13 +68,6 @@ dimensions = () type = integer intent = in -[latr] - standard_name = number_of_latitude_points - long_name = number of global points in y-dir (j) along the meridian - units = count - dimensions = () - type = integer - intent = in [levs] standard_name = vertical_layer_dimension long_name = number of vertical levels @@ -691,8 +684,8 @@ [ugwp_seq_update] standard_name = do_ugwp_sequential_update long_name = flag for ugwp sequential update - units = flag - dimensions = () + units = flag + dimensions = () type = logical intent = in [cdmbgwd] @@ -861,7 +854,6 @@ type = real kind = kind_phys intent = out - intent = out [gw_dudt] standard_name = tendency_of_x_wind long_name = tendency of x wind calculated by one physics scheme @@ -1072,7 +1064,7 @@ type = real kind = kind_phys intent = in -[dqdt_tke] +[dqdt_tke] standard_name = process_split_cumulative_tendency_of_turbulent_kinetic_energy long_name = turbulent kinetic energy tendency due to model physics units = J kg-1 s-1 @@ -1211,18 +1203,18 @@ [do_gwd_opt_psl] standard_name = do_gsl_drag_suite_with_psl_gwd_option long_name = flag to activate PSL drag suite - mesoscale GWD and blocking - units = flag - dimensions = () + units = flag + dimensions = () type = logical - intent = in + intent = in [psl_gwd_dx_factor] standard_name = effective_grid_spacing_of_psl_gwd_suite long_name = multiplication of grid spacing units = 1 - dimensions = () - type = real + dimensions = () + type = real kind = kind_phys - intent = in + intent = in [gwd_opt] standard_name = control_for_drag_suite_gravity_wave_drag long_name = flag to choose gwd scheme diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta index 3e2f0b21d..4cfddc90f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta @@ -135,7 +135,7 @@ standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) + dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys intent = in diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index 48a4bc792..e4a98af1a 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -6,6 +6,7 @@ !! aerosol, IN&CCN and surface properties updates. module GFS_phys_time_vary + use mpi_f08 #ifdef _OPENMP use omp_lib #endif @@ -79,7 +80,7 @@ end subroutine copy_error !>\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, levs, & + mpicomm, mpirank, mpiroot, 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, & @@ -100,7 +101,8 @@ subroutine GFS_phys_time_vary_init ( implicit none ! Interface variables - integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny, levs, iaermdl + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot, 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 @@ -230,9 +232,9 @@ subroutine GFS_phys_time_vary_init ( if (iaerclm) then ntrcaer = ntrcaerm if(iaermdl == 1) then - call read_aerdata (me,master,iflip,idate,errmsg,errflg) + call read_aerdata (mpicomm,mpirank,mpiroot,iflip,idate,errmsg,errflg) elseif (iaermdl == 6) then - call read_aerdata_dl(me,master,iflip, & + call read_aerdata_dl(mpicomm, mpirank, mpiroot, iflip, & idate,fhour, errmsg,errflg) end if if(errflg/=0) return @@ -251,19 +253,19 @@ subroutine GFS_phys_time_vary_init ( !> - Call read_cidata() to read IN and CCN data if (iccn == 1) then - call read_cidata (me,master) + call read_cidata (mpicomm, mpirank, mpiroot) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif !> - Call tau_amf dats for ugwp_v1 if (do_ugwp_v1) then - call read_tau_amf(me, master, errmsg, errflg) + call read_tau_amf(mpicomm, mpirank, mpiroot, 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) + call set_soilveg(mpirank, isot, ivegsrc, nlunit, errmsg, errflg) if(errflg/=0) return !> - read in NoahMP table (needed for NoahMP init) @@ -289,8 +291,7 @@ subroutine GFS_phys_time_vary_init ( if (iaerclm) then call setindxaer (im, xlat_d, jindx1_aer, & jindx2_aer, ddy_aer, xlon_d, & - iindx1_aer, iindx2_aer, ddx_aer, & - me, master) + iindx1_aer, iindx2_aer, ddx_aer) iamin = min(minval(iindx1_aer), iamin) iamax = max(maxval(iindx2_aer), iamax) jamin = min(minval(jindx1_aer), jamin) @@ -306,7 +307,7 @@ subroutine GFS_phys_time_vary_init ( !> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that can resolve GWs if (do_ugwp_v1) then - call cires_indx_ugwp (im, me, master, xlat_d, jindx1_tau, jindx2_tau, & + call cires_indx_ugwp (im, mpirank, mpiroot, xlat_d, jindx1_tau, jindx2_tau, & ddy_j1tau, ddy_j2tau) endif @@ -322,7 +323,7 @@ subroutine GFS_phys_time_vary_init ( !--- if sncovr does not exist in the restart, need to create it if (all(sncovr < zero)) then - if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' + if (mpirank == mpiroot ) write(*,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' !--- compute sncovr from existing variables !--- code taken directly from read_fix.f sncovr(:) = zero @@ -343,7 +344,7 @@ subroutine GFS_phys_time_vary_init ( !--- For RUC LSM: create sncovr_ice from sncovr if (lsm == lsm_ruc) then if (all(sncovr_ice < zero)) then - if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: fill sncovr_ice with sncovr for RUC LSM' + if (mpirank == mpiroot ) write(*,'(a)') 'GFS_phys_time_vary_init: fill sncovr_ice with sncovr for RUC LSM' sncovr_ice(:) = sncovr(:) endif endif @@ -353,9 +354,9 @@ subroutine GFS_phys_time_vary_init ( if (iaerclm) then ! This call is outside the OpenMP section, so it should access errmsg & errflg directly. if(iaermdl==1) then - call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg) + call read_aerdataf (mpicomm, mpirank, mpiroot, iflip, idate, fhour, errmsg, errflg) elseif (iaermdl==6) then - call read_aerdataf_dl (me, master, iflip, idate, fhour, errmsg, errflg) + call read_aerdataf_dl (mpicomm, mpirank, mpiroot, iflip, idate, fhour, errmsg, errflg) end if ! If it is moved to an OpenMP section, it must use myerrmsg, myerrflg, and copy_error. if (errflg/=0) return @@ -365,7 +366,7 @@ subroutine GFS_phys_time_vary_init ( !--- land and ice - not for restart runs lsm_init: if (lsm_cold_start) then if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then - if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' + if (mpirank == mpiroot ) write(*,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' do ix=1,im albdvis_lnd(ix) = 0.2_kind_phys albdnir_lnd(ix) = 0.2_kind_phys @@ -705,7 +706,7 @@ end subroutine GFS_phys_time_vary_init !>\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, cplflx, & + mpicomm, mpirank, mpiroot, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, cplflx, & nsswr, fhswr, lsswr, fhour, & imfdeepcnv, cal_pre, random_clds, nscyc, ntoz, h2o_phys, iaerclm, iaermdl, iccn, clstp, & jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & @@ -724,7 +725,8 @@ subroutine GFS_phys_time_vary_timestep_init ( implicit none ! Interface variables - integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & nsswr, imfdeepcnv, iccn, nscyc, ntoz, iflip, iaermdl integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhswr, fhour @@ -794,8 +796,8 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP parallel num_threads(nthrds) default(none) & !$OMP shared(kdt,nsswr,lsswr,clstp,imfdeepcnv,cal_pre,random_clds) & !$OMP shared(fhswr,fhour,seed0,cnx,cny,nrcm,wrk,rannie,rndval, iaermdl) & -!$OMP shared(rann,im,isc,jsc,imap,jmap,ntoz,me,idate,jindx1_o3,jindx2_o3) & -!$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & +!$OMP shared(rann,im,isc,jsc,imap,jmap,ntoz,mpirank,idate,jindx1_o3,jindx2_o3) & +!$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,mpiroot)& !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & !$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,h2ophys,rjday,n1,n2,idat,jdat,rinc) & @@ -884,7 +886,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP section !> - Call ciinterpol() to make IN and CCN data interpolation if (iccn == 1) then - call ciinterpol (me, im, idate, fhour, & + call ciinterpol (mpirank, im, idate, fhour,& jindx1_ci, jindx2_ci, & ddy_ci, iindx1_ci, & iindx2_ci, ddx_ci, & @@ -894,7 +896,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP section !> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that resolve GW-activ if (do_ugwp_v1) then - call tau_amf_interp(me, master, im, idate, fhour, & + call tau_amf_interp(mpirank, mpiroot, im, idate, fhour, & jindx1_tau, jindx2_tau, & ddy_j1tau, ddy_j2tau, tau_amf) endif @@ -907,13 +909,13 @@ subroutine GFS_phys_time_vary_timestep_init ( ! aerinterpol is using threading inside, don't ! move into OpenMP parallel section above if (iaermdl==1) then - call aerinterpol (me, master, nthrds, im, idate, & + call aerinterpol (mpicomm, mpirank, mpiroot, nthrds, im, idate, & 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, & + call aerinterpol_dl (mpicomm, mpirank, mpiroot, nthrds, im, idate, & fhour, iflip, jindx1_aer, jindx2_aer, & ddy_aer, iindx1_aer, & iindx2_aer, ddx_aer, & @@ -925,7 +927,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !> - 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, fn_nml, & + call gcycle (mpirank, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, & 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, & diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index be7960bae..1bad16da8 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -16,14 +16,21 @@ name = GFS_phys_time_vary_init type = scheme -[me] +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] standard_name = mpi_rank long_name = current MPI-rank units = index dimensions = () type = integer intent = in -[master] +[mpiroot] standard_name = mpi_root long_name = master MPI-rank units = index @@ -1096,14 +1103,21 @@ [ccpp-arg-table] name = GFS_phys_time_vary_timestep_init type = scheme -[me] +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] standard_name = mpi_rank long_name = current MPI-rank units = index dimensions = () type = integer intent = in -[master] +[mpiroot] standard_name = mpi_root long_name = master MPI-rank units = index @@ -1310,7 +1324,7 @@ standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys intent = inout diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.neptune.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.neptune.F90 new file mode 100644 index 000000000..9f10f5883 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.neptune.F90 @@ -0,0 +1,1004 @@ +!> \file GFS_phys_time_vary.neptune.F90 +!! Contains code related to GFS physics suite setup (physics part of time_vary_step) + +!>\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 mpi_f08 +#ifdef _OPENMP + use omp_lib +#endif + + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec + + use mersenne_twister, only: random_setseed, random_number + + use module_ozphys, only: ty_ozphys + 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, & + read_aerdata_dl, aerinterpol_dl, read_aerdataf_dl + + use iccn_def, only : ciplin, ccnin, ci_pres + use iccninterp, only : read_cidata, setindxci, ciinterpol + + !use gcycle_mod, only : gcycle + + use cires_tauamf_data, only: cires_indx_ugwp, read_tau_amf, tau_amf_interp + use cires_tauamf_data, only: tau_limb, days_limb, ugwp_taulat + + !--- variables needed for calculating 'sncovr' + use namelist_soilveg, only: salp_data, snupx + use set_soilveg_mod, only: set_soilveg + + ! --- needed for Noah MP init + use noahmp_tables, only: read_mp_table_parameters, & + laim_table,saim_table,sla_table, & + bexp_table,smcmax_table,smcwlt_table, & + 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_finalize + + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + real(kind=kind_phys), parameter :: missing_value = 9.99e20_kind_phys + real(kind=kind_phys), parameter :: drythresh = 1.e-4_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys + + contains + + subroutine copy_error(myerrmsg, myerrflg, errmsg, errflg) + implicit none + character(*), intent(in) :: myerrmsg + integer, intent(in) :: myerrflg + character(*), intent(out) :: errmsg + integer, intent(inout) :: errflg + if(myerrflg /= 0 .and. errflg == 0) then + !$OMP CRITICAL + if(errflg == 0) then + errmsg = myerrmsg + errflg = myerrflg + endif + !$OMP END CRITICAL + endif + end subroutine copy_error + +!> \section arg_table_GFS_phys_time_vary_init Argument Table +!! \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 ( & + mpicomm, mpirank, mpiroot, 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, & + isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_noahmp, lsm_ruc, min_seaice, & + fice, landfrac, vtype, weasd, lsoil, zs, dzs, lsnow_lsm_lbound, lsnow_lsm_ubound, & + tvxy, tgxy, tahxy, canicexy, canliqxy, eahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy,& + qsnowxy, wslakexy, albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, albdvis_ice, & + albdnir_ice, albivis_ice, albinir_ice, emiss_lnd, emiss_ice, taussxy, waxy, wtxy, & + zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & + 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, ozphys, h2ophys, is_initialized, errmsg, & + errflg) + + implicit none + + ! Interface variables + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot + integer, intent(in) :: 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 + real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) + + integer, intent(in) :: lkm + integer, intent(inout) :: use_lake_model(:) + real(kind=kind_phys), intent(in ) :: lakefrac(:), lakedepth(:) + + 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(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(:) + logical, intent(in) :: do_ugwp_v1 + real(kind_phys), intent(inout), optional :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(inout), optional :: jindx1_tau(:), jindx2_tau(:) + + integer, intent(in) :: isot, ivegsrc, nlunit + real(kind_phys), intent(inout) :: sncovr(:), sncovr_ice(:) + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, vtype(:) + real(kind_phys), intent(in) :: min_seaice, fice(:) + real(kind_phys), intent(in) :: landfrac(:) + real(kind_phys), intent(inout) :: weasd(:) + type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys + + ! NoahMP - only allocated when NoahMP is used + integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound + real(kind_phys), intent(in) :: zs(:) + real(kind_phys), intent(in) :: dzs(:) + real(kind_phys), intent(inout), optional :: tvxy(:) + real(kind_phys), intent(inout), optional :: tgxy(:) + real(kind_phys), intent(inout), optional :: tahxy(:) + real(kind_phys), intent(inout), optional :: canicexy(:) + real(kind_phys), intent(inout), optional :: canliqxy(:) + real(kind_phys), intent(inout), optional :: eahxy(:) + real(kind_phys), intent(inout), optional :: cmxy(:) + real(kind_phys), intent(inout), optional :: chxy(:) + 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) :: 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) :: 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) :: slc(:,:) + real(kind_phys), intent(inout) :: smc(:,:) + real(kind_phys), intent(inout) :: stc(:,:) + real(kind_phys), intent(in) :: tsfcl(:) + real(kind_phys), intent(in) :: snowd(:) + 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 + + ! Local variables + integer :: i, j, ix, vegtyp + real(kind_phys) :: rsnow + + !--- Noah MP + integer :: soiltyp, isnow, is, imn + real(kind=kind_phys) :: masslai, masssai, snd + real(kind=kind_phys) :: bexp, ddz, smcmax, smcwlt, dwsat, dksat, psisat + + real(kind=kind_phys), dimension(:), allocatable :: dzsno + real(kind=kind_phys), dimension(:), allocatable :: dzsnso + + integer :: myerrflg + character(len=255) :: myerrmsg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + ! Initialize copy_error variables + myerrflg = 0 + myerrmsg = 'Error in GFS_phys_time_vary' + + if (is_initialized) return + iamin=999 + iamax=-999 + jamin=999 + jamax=-999 + +!> - Call read_aerdata() to read aerosol climatology, Anning added coupled +!> added coupled gocart and radiation option to initializing aer_nm + if (iaerclm) then + ntrcaer = ntrcaerm + if(iaermdl == 1) then + call read_aerdata (mpicomm,mpirank,mpiroot,iflip,idate,errmsg,errflg) + elseif (iaermdl == 6) then + call read_aerdata_dl(mpicomm,mpirank,mpiroot,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 + ntrcaer = 1 + endif + +!> - Call read_cidata() to read IN and CCN data + if (iccn == 1) then + call read_cidata (mpicomm, mpirank, mpiroot) + ! No consistency check needed for in/ccn data, all values are + ! hardcoded in module iccn_def.F and GFS_typedefs.F90 + endif + +!> - Call tau_amf dats for ugwp_v1 + if (do_ugwp_v1) then + call read_tau_amf(mpicomm, mpirank, mpiroot, errmsg, errflg) + if(errflg/=0) return + endif + +!> - Initialize soil vegetation (needed for sncovr calculation further down) + call set_soilveg(mpirank, 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) + if(errflg/=0) return + endif + + +! Need an OpenMP barrier here (implicit in "end sections") + +!> - Setup spatial interpolation indices for ozone physics. + if (ntoz > 0) then + call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) + endif + +!> - Call setindxh2o() to initialize stratospheric water vapor data + if (h2o_phys) then + call h2ophys%setup(xlat_d, jindx1_h, jindx2_h, ddy_h) + endif + +!> - Call setindxaer() to initialize aerosols data + if (iaerclm) then + call setindxaer (im, xlat_d, jindx1_aer, & + jindx2_aer, ddy_aer, xlon_d, & + iindx1_aer, iindx2_aer, ddx_aer) + iamin = min(minval(iindx1_aer), iamin) + iamax = max(maxval(iindx2_aer), iamax) + jamin = min(minval(jindx1_aer), jamin) + jamax = max(maxval(jindx2_aer), jamax) + endif + +!> - Call setindxci() to initialize IN and CCN data + if (iccn == 1) then + call setindxci (im, xlat_d, jindx1_ci, & + jindx2_ci, ddy_ci, xlon_d, & + iindx1_ci, iindx2_ci, ddx_ci) + endif + +!> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that can resolve GWs + if (do_ugwp_v1) then + call cires_indx_ugwp (im, mpirank, mpiroot, xlat_d, jindx1_tau, jindx2_tau, & + ddy_j1tau, ddy_j2tau) + endif + + !--- initial calculation of maps local ix -> global i and j + ix = 0 + do j = 1,ny + do i = 1,nx + ix = ix + 1 + jmap(ix) = j + imap(ix) = i + enddo + enddo + + !--- if sncovr does not exist in the restart, need to create it + if (all(sncovr < zero)) then + if (mpirank==mpiroot) write(*,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' + !--- compute sncovr from existing variables + !--- code taken directly from read_fix.f + sncovr(:) = zero + do ix=1,im + if (landfrac(ix) >= drythresh .or. fice(ix) >= min_seaice) then + vegtyp = vtype(ix) + if (vegtyp == 0) vegtyp = 7 + rsnow = 0.001_kind_phys*weasd(ix)/snupx(vegtyp) + if (0.001_kind_phys*weasd(ix) < snupx(vegtyp)) then + sncovr(ix) = one - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + else + sncovr(ix) = one + endif + endif + enddo + endif + + !--- For RUC LSM: create sncovr_ice from sncovr + if (lsm == lsm_ruc) then + if (all(sncovr_ice < zero)) then + if (mpirank==mpiroot) write(*,'(a)') 'GFS_phys_time_vary_init: fill sncovr_ice with sncovr for RUC LSM' + sncovr_ice(:) = sncovr(:) + endif + endif + + if (errflg/=0) return + + if (iaerclm) then + ! This call is outside the OpenMP section, so it should access errmsg & errflg directly. + if(iaermdl==1) then + call read_aerdataf (mpicomm, mpirank, mpiroot, iflip, idate, fhour, errmsg, errflg) + elseif (iaermdl==6) then + call read_aerdataf_dl (mpicomm, mpirank, mpiroot, iflip, idate, fhour, errmsg, errflg) + end if + ! If it is moved to an OpenMP section, it must use myerrmsg, myerrflg, and copy_error. + if (errflg/=0) return + end if + + !--- For Noah MP or RUC LSMs: initialize four components of albedo for + !--- land and ice - not for restart runs + lsm_init: if (lsm_cold_start) then + if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then + if (mpirank==mpiroot) write(*,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' + do ix=1,im + albdvis_lnd(ix) = 0.2_kind_phys + albdnir_lnd(ix) = 0.2_kind_phys + albivis_lnd(ix) = 0.2_kind_phys + albinir_lnd(ix) = 0.2_kind_phys + emiss_lnd(ix) = 0.95_kind_phys + enddo + endif + if (lsm == lsm_ruc) then + do ix=1,im + albdvis_ice(ix) = 0.6_kind_phys + albdnir_ice(ix) = 0.6_kind_phys + albivis_ice(ix) = 0.6_kind_phys + albinir_ice(ix) = 0.6_kind_phys + emiss_ice(ix) = 0.97_kind_phys + enddo + endif + + noahmp_init: if (lsm == lsm_noahmp) then + allocate(dzsno (lsnow_lsm_lbound:lsnow_lsm_ubound)) + allocate(dzsnso(lsnow_lsm_lbound:lsoil) ) + dzsno(:) = missing_value + dzsnso(:) = missing_value + + tvxy(:) = missing_value + tgxy(:) = missing_value + tahxy(:) = missing_value + canicexy(:) = missing_value + canliqxy(:) = missing_value + eahxy(:) = missing_value + cmxy(:) = missing_value + chxy(:) = missing_value + fwetxy(:) = missing_value + sneqvoxy(:) = missing_value + alboldxy(:) = missing_value + qsnowxy(:) = missing_value + wslakexy(:) = missing_value + taussxy(:) = missing_value + waxy(:) = missing_value + wtxy(:) = missing_value + zwtxy(:) = missing_value + xlaixy(:) = missing_value + xsaixy(:) = missing_value + + lfmassxy(:) = missing_value + stmassxy(:) = missing_value + rtmassxy(:) = missing_value + woodxy(:) = missing_value + stblcpxy(:) = missing_value + fastcpxy(:) = missing_value + smcwtdxy(:) = missing_value + deeprechxy(:) = missing_value + rechxy(:) = missing_value + + snowxy (:) = missing_value + snicexy(:,:) = missing_value + snliqxy(:,:) = missing_value + tsnoxy (:,:) = missing_value + smoiseq(:,:) = missing_value + zsnsoxy(:,:) = missing_value + + imn = idate(2) + +!$OMP parallel do num_threads(nthrds) default(none) & +!$OMP shared(im,lsoil,con_t0c,landfrac,tsfcl,tvxy,tgxy,tahxy) & +!$OMP shared(snowd,canicexy,canliqxy,canopy,eahxy,cmxy,chxy) & +!$OMP shared(fwetxy,sneqvoxy,weasd,alboldxy,qsnowxy,wslakexy) & +!$OMP shared(taussxy) & +!$OMP shared(waxy,wtxy,zwtxy,imn,vtype,xlaixy,xsaixy,lfmassxy) & +!$OMP shared(stmassxy,rtmassxy,woodxy,stblcpxy,fastcpxy) & +!$OMP shared(isbarren_table,isice_table,isurban_table) & +!$omp shared(iswater_table,laim_table,sla_table,bexp_table) & +!$omp shared(stc,smc,slc,tg3,snowxy,tsnoxy,snicexy,snliqxy) & +!$omp shared(zsnsoxy,stype,smcmax_table,smcwlt_table,zs,dzs) & +!$omp shared(dwsat_table,dksat_table,psisat_table,smoiseq) & +!$OMP shared(smcwtdxy,deeprechxy,rechxy,errmsg,errflg) & +!$OMP private(vegtyp,masslai,masssai,snd,dzsno,dzsnso,isnow) & +!$OMP private(soiltyp,bexp,smcmax,smcwlt,dwsat,dksat,psisat) & +!$OMP private(myerrmsg,myerrflg,ddz) + do ix=1,im + if (landfrac(ix) >= drythresh) then + tvxy(ix) = tsfcl(ix) + tgxy(ix) = tsfcl(ix) + tahxy(ix) = tsfcl(ix) + + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) then + tvxy(ix) = con_t0c + tgxy(ix) = con_t0c + tahxy(ix) = con_t0c + end if + + canicexy(ix) = 0.0_kind_phys + canliqxy(ix) = canopy(ix) + + eahxy(ix) = 2000.0_kind_phys + + cmxy(ix) = zero + chxy(ix) = zero + fwetxy(ix) = zero + sneqvoxy(ix) = weasd(ix) ! mm + alboldxy(ix) = 0.65_kind_phys + qsnowxy(ix) = zero + +! if (srflag(ix) > 0.001) qsnowxy(ix) = tprcp(ix)/dtp + ! already set to 0.0 + wslakexy(ix) = zero + taussxy(ix) = zero + + waxy(ix) = 4900.0_kind_phys + wtxy(ix) = waxy(ix) + zwtxy(ix) = (25.0_kind_phys + 2.0_kind_phys) - waxy(ix) / 1000.0_kind_phys / 0.2_kind_phys + + vegtyp = vtype(ix) + if (vegtyp == 0) vegtyp = 7 + + if ((vegtyp == isbarren_table) .or. (vegtyp == isice_table) .or. (vegtyp == isurban_table) .or. (vegtyp == iswater_table)) then + + xlaixy(ix) = zero + xsaixy(ix) = zero + + lfmassxy(ix) = zero + stmassxy(ix) = zero + rtmassxy(ix) = zero + + woodxy (ix) = zero + stblcpxy (ix) = zero + fastcpxy (ix) = zero + + else + + xlaixy(ix) = max(laim_table(vegtyp, imn),0.05_kind_phys) +! xsaixy(ix) = max(saim_table(vegtyp, imn),0.05) + xsaixy(ix) = max(xlaixy(ix)*0.1_kind_phys,0.05_kind_phys) + + masslai = 1000.0_kind_phys / max(sla_table(vegtyp),one) + lfmassxy(ix) = xlaixy(ix)*masslai + masssai = 1000.0_kind_phys / 3.0_kind_phys + stmassxy(ix) = xsaixy(ix)* masssai + + rtmassxy(ix) = 500.0_kind_phys + + woodxy(ix) = 500.0_kind_phys + stblcpxy(ix) = 1000.0_kind_phys + fastcpxy(ix) = 1000.0_kind_phys + + endif ! non urban ... + + if (vegtyp == isice_table) then + do is = 1,lsoil + stc(ix,is) = min(stc(ix,is),min(tg3(ix),263.15_kind_phys)) + smc(ix,is) = one + slc(ix,is) = zero + enddo + endif + + snd = snowd(ix)/1000.0_kind_phys ! go to m from snwdph + + if (weasd(ix) /= zero .and. snd == zero ) then + snd = weasd(ix)/1000.0 + endif + + if (vegtyp == 15) then ! land ice in MODIS/IGBP + 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 + snowxy(ix) = zero + dzsno(-2:0) = zero + elseif (snd >= 0.025_kind_phys .and. snd <= 0.05_kind_phys ) then + snowxy(ix) = -1.0_kind_phys + dzsno(0) = snd + elseif (snd > 0.05_kind_phys .and. snd <= 0.10_kind_phys ) then + snowxy(ix) = -2.0_kind_phys + dzsno(-1) = 0.5_kind_phys*snd + dzsno(0) = 0.5_kind_phys*snd + elseif (snd > 0.10_kind_phys .and. snd <= 0.25_kind_phys ) then + snowxy(ix) = -2.0_kind_phys + dzsno(-1) = 0.05_kind_phys + dzsno(0) = snd - 0.05_kind_phys + elseif (snd > 0.25_kind_phys .and. snd <= 0.45_kind_phys ) then + snowxy(ix) = -3.0_kind_phys + dzsno(-2) = 0.05_kind_phys + dzsno(-1) = 0.5_kind_phys*(snd-0.05_kind_phys) + dzsno(0) = 0.5_kind_phys*(snd-0.05_kind_phys) + elseif (snd > 0.45_kind_phys) then + snowxy(ix) = -3.0_kind_phys + dzsno(-2) = 0.05_kind_phys + dzsno(-1) = 0.20_kind_phys + dzsno(0) = snd - 0.05_kind_phys - 0.20_kind_phys + else + myerrmsg = 'Error in GFS_phys_time_vary.neptune.F90: Problem with the logic assigning snow layers in Noah MP initialization' + myerrflg = 1 + call copy_error(myerrmsg, myerrflg, errmsg, errflg) + endif + +! Now we have the snowxy field +! snice + snliq + tsno allocation and compute them from what we have + + tsnoxy(ix,:) = zero + snicexy(ix,:) = zero + snliqxy(ix,:) = zero + zsnsoxy(ix,:) = zero + + isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 + +! 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)) + snliqxy(ix,is) = zero + snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd + enddo +! +!zsnsoxy, all negative ? +! + do is = isnow,0 + dzsnso(is) = -dzsno(is) + enddo + + do is = 1,4 + dzsnso(is) = -dzs(is) + enddo +! +! Assign to zsnsoxy +! + zsnsoxy(ix,isnow) = dzsnso(isnow) + do is = isnow+1,4 + zsnsoxy(ix,is) = zsnsoxy(ix,is-1) + dzsnso(is) + enddo +! +! smoiseq +! Init water table related quantities here +! + soiltyp = stype(ix) + if (soiltyp /= 0) then + bexp = bexp_table(soiltyp) + smcmax = smcmax_table(soiltyp) + smcwlt = smcwlt_table(soiltyp) + dwsat = dwsat_table(soiltyp) + dksat = dksat_table(soiltyp) + psisat = -psisat_table(soiltyp) + endif + + if (vegtyp == isurban_table) then + smcmax = 0.45_kind_phys + smcwlt = 0.40_kind_phys + endif + + if ((bexp > zero) .and. (smcmax > zero) .and. (-psisat > zero)) then + do is = 1, lsoil + if ( is == 1 )then + ddz = -zs(is+1) * 0.5_kind_phys + elseif ( is < lsoil ) then + ddz = ( zs(is-1) - zs(is+1) ) * 0.5_kind_phys + else + ddz = zs(is-1) - zs(is) + endif + smoiseq(ix,is) = min(max(find_eq_smc(bexp, dwsat, dksat, ddz, smcmax),1.e-4_kind_phys),smcmax*0.99_kind_phys) + enddo + else ! bexp <= 0.0 + smoiseq(ix,1:4) = smcmax + endif ! end the bexp condition + + smcwtdxy(ix) = smcmax + deeprechxy(ix) = zero + rechxy(ix) = zero + + endif + + enddo ! ix +!$OMP end parallel do + + if (errflg/=0) return + + deallocate(dzsno) + deallocate(dzsnso) + + endif noahmp_init + endif lsm_init + +!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 + else + ! Lake model is disabled or settings are invalid. + use_lake_model = 0 + endif + + is_initialized = .true. + + contains + +! +! Use newton-raphson method to find eq soil moisture +! + function find_eq_smc(bexp, dwsat, dksat, ddz, smcmax) result(smc) + implicit none + real(kind=kind_phys), intent(in) :: bexp, dwsat, dksat, ddz, smcmax + real(kind=kind_phys) :: smc + real(kind=kind_phys) :: expon, aa, bb, func, dfunc, dx + integer :: iter + ! + expon = bexp + 1. + aa = dwsat / ddz + bb = dksat / smcmax ** expon + smc = 0.5 * smcmax + ! + do iter = 1,100 + func = (smc - smcmax) * aa + bb * smc ** expon + dfunc = aa + bb * expon * smc ** bexp + dx = func / dfunc + smc = smc - dx + if ( abs (dx) < 1.e-6_kind_phys) return + enddo + 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 (mpicomm, mpirank, mpiroot, & + cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, cplflx, nsswr, fhswr, lsswr, fhour, & + imfdeepcnv, cal_pre, random_clds, nscyc, 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, fn_nml, & + imap, jmap, prsl, seed0, rann, nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, lsoil_lsm,& + kice, ialb, isot, ivegsrc, input_nml_file, use_ufo, nst_anl, frac_grid, fhcyc, phour, & + oceanfrac, lakefrac, min_seaice, min_lakeice, 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,scolor, shdmin, shdmax, snowd, & + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, h2ophys, & + do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, is_initialized, & + errmsg, errflg) + + implicit none + + ! Interface variables + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & + nsswr, imfdeepcnv, iccn, nscyc, ntoz, iflip, iaermdl + integer, intent(in) :: idate(:) + real(kind_phys), intent(in) :: fhswr, fhour + logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm, cplflx + 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(:) + 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(:) + 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(:) + real(kind_phys), intent(inout) :: in_nm(:,:), ccn_nm(:,:) + integer, intent(in) :: imap(:), jmap(:) + real(kind_phys), intent(in) :: prsl(:,:) + integer, intent(in) :: seed0 + 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(:) + real(kind_phys), intent(inout) :: tau_amf(:) + type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys + + ! For gcycle only - not used by NEPTUNE + integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil + integer, intent(in) :: lsoil_lsm, kice, ialb, isot, ivegsrc + character(len=*), intent(in) :: input_nml_file(:) + character(len=*), intent(in) :: fn_nml + logical, intent(in) :: use_ufo, nst_anl, frac_grid + real(kind_phys), intent(in) :: fhcyc, phour, lakefrac(:), min_seaice, min_lakeice, & + xlat_d(:), xlon_d(:), landfrac(:),oceanfrac(:) + real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), tiice(:,:), tg3(:), & + tsfc(:), tsfco(:), tisfc(:), hice(:), fice(:), & + facsf(:), facwf(:), alvsf(:), alvwf(:), alnsf(:), alnwf(:), & + zorli(:), zorll(:), zorlo(:), weasd(:), snoalb(:), & + canopy(:), vfrac(:), shdmin(:), shdmax(:), & + snowd(:), cv(:), cvb(:), cvt(:), oro(:), oro_uf(:), slmsk(:) + real(kind_phys), intent(inout), optional :: smois(:,:), sh2o(:,:), tslb(:,:), tref(:) + integer, intent(inout) :: vtype(:), stype(:),scolor(:), slope(:) + + logical, intent(in) :: is_initialized + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, j, k, iseed, iskip, ix, idat(8), jdat(8), iday, j1, j2, nc, n1, n2, jdow, & + jdoy, jday, w3kindreal, w3kindint + real(kind_phys) :: wrk(1), tem, tx1, tx2, rjday + real(kind_phys) :: rannie(cny) + real(kind_phys) :: rndval(cnx*cny*nrcm) + real(kind_dbl_prec) :: rinc(5) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check initialization status + if (.not.is_initialized) then + write(errmsg,'(*(a))') "Logic error: GFS_phys_time_vary_timestep_init called before GFS_phys_time_vary_init" + errflg = 1 + return + end if + +!$OMP parallel num_threads(nthrds) default(none) & +!$OMP shared(kdt,nsswr,lsswr,clstp,imfdeepcnv,cal_pre,random_clds) & +!$OMP shared(fhswr,fhour,seed0,cnx,cny,nrcm,wrk,rannie,rndval, iaermdl) & +!$OMP shared(rann,im,isc,jsc,imap,jmap,ntoz,mpirank,idate,jindx1_o3,jindx2_o3) & +!$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,mpiroot)& +!$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & +!$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & +!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,h2ophys,rjday,n1,n2,idat,jdat,rinc) & +!$OMP shared(w3kindreal,w3kindint,jdow,jdoy,jday) & +!$OMP private(iseed,iskip,i,j,k) + +!$OMP sections + +!$OMP section + + !--- switch for saving convective clouds - cnvc90.f + !--- aka Ken Campana/Yu-Tai Hou legacy + if ((mod(kdt,nsswr) == 0) .and. (lsswr)) then + !--- initialize,accumulate,convert + clstp = 1100 + min(fhswr/con_hr,fhour,con_99) + elseif (mod(kdt,nsswr) == 0) then + !--- accumulate,convert + clstp = 0100 + min(fhswr/con_hr,fhour,con_99) + elseif (lsswr) then + !--- initialize,accumulate + clstp = 1100 + else + !--- accumulate + clstp = 0100 + endif + +!$OMP section + + !--- random number needed for RAS and old SAS and when cal_pre=.true. + ! imfdeepcnv < 0 when ras = .true. + if ( (imfdeepcnv <= 0 .or. cal_pre) .and. random_clds ) then + + iseed = mod(con_100*sqrt(fhour*con_hr),1.0d9) + seed0 + call random_setseed(iseed) + call random_number(wrk) + do i = 1,cnx*nrcm + iseed = iseed + nint(wrk(1)*1000.0) * i + call random_setseed(iseed) + call random_number(rannie) + rndval(1+(i-1)*cny:i*cny) = rannie(1:cny) + enddo + + do k = 1,nrcm + iskip = (k-1)*cnx*cny + do ix=1,im + j = jmap(ix) + i = imap(ix) + rann(ix,k) = rndval(i+isc-1 + (j+jsc-2)*cnx + iskip) + enddo + enddo + + endif ! imfdeepcnv, cal_re, random_clds + +!$OMP section + !> - Compute temporal interpolation indices for updating gas concentrations. + idat=0 + idat(1)=idate(4) + idat(2)=idate(2) + idat(3)=idate(3) + idat(5)=idate(1) + rinc=0. + rinc(2)=fhour + CALL w3movdat(rinc,idat,jdat) + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + rjday = jdoy + jdat(5) / 24. + if (rjday < ozphys%time(1)) rjday = rjday + 365. + +!> - Update ozone concentration. + if (ntoz > 0) then + 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_photochem_time_index(h2ophys%ntime, h2ophys%time, rjday, n1, n2) + call h2ophys%update(jindx1_h, jindx2_h, ddy_h, rjday, n1, n2, h2opl) + endif + +!$OMP section +!> - Call ciinterpol() to make IN and CCN data interpolation + if (iccn == 1) then + call ciinterpol (mpirank, im, idate, fhour,& + jindx1_ci, jindx2_ci, & + ddy_ci, iindx1_ci, & + iindx2_ci, ddx_ci, & + levs, prsl, in_nm, ccn_nm) + endif + +!$OMP section +!> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that resolve GW-activ + if (do_ugwp_v1) then + call tau_amf_interp(mpirank, mpiroot, im, idate, fhour, & + jindx1_tau, jindx2_tau, & + ddy_j1tau, ddy_j2tau, tau_amf) + endif + +!$OMP end sections +!$OMP end parallel + +!> - Call aerinterpol() to make aerosol interpolation + if (iaerclm) then + ! aerinterpol is using threading inside, don't + ! move into OpenMP parallel section above + if (iaermdl==1) then + call aerinterpol (mpicomm, mpirank, mpiroot, nthrds, im, idate, & + 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 (mpicomm, mpirank, mpiroot, 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 + +!> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs + if (nscyc > 0) then + errmsg = 'Error in GFS_phys_time_vary_timestep_init, nscyc>0 not supported in NEPTUNE' + errflg = 1 + !if (mod(kdt,nscyc) == 1) THEN + ! call gcycle (mpirank, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, & + ! 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, scolor, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf, & + ! cplflx, oceanfrac, & + ! xlat_d, xlon_d, slmsk, imap, jmap, errmsg, errflg) + !endif + endif + + contains + !> Find the time indexes on either side of current time + 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 + !> The indexes of the parameters just before and after the + !! current time + integer, intent(out) :: n1, n2 + !> The times provided in the parameter file + real, intent(in), dimension(ntime+1) :: time + !> The current time of year + real, intent(in) :: rjday + n2 = ntime + 1 + do j=2,ntime + if (rjday < time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + if (n2 > ntime) n2 = n2 - ntime + end subroutine find_photochem_time_index + end subroutine GFS_phys_time_vary_timestep_init +!> @} + +!> \section arg_table_GFS_phys_time_vary_finalize Argument Table +!! \htmlinclude GFS_phys_time_vary_finalize.html +!! + subroutine GFS_phys_time_vary_finalize(is_initialized, errmsg, errflg) + + implicit none + + ! Interface variables + logical, intent(inout) :: is_initialized + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + ! Deallocate aerosol arrays + if (allocated(aerin) ) deallocate(aerin) + if (allocated(aer_pres)) deallocate(aer_pres) + + ! Deallocate IN and CCN arrays + if (allocated(ciplin) ) deallocate(ciplin) + if (allocated(ccnin) ) deallocate(ccnin) + if (allocated(ci_pres) ) deallocate(ci_pres) + + ! Deallocate UGWP-input arrays + if (allocated(ugwp_taulat)) deallocate(ugwp_taulat) + if (allocated(tau_limb )) deallocate(tau_limb) + if (allocated(days_limb )) deallocate(days_limb) + + is_initialized = .false. + + 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.neptune.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.neptune.meta new file mode 100644 index 000000000..1bad16da8 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.neptune.meta @@ -0,0 +1,2129 @@ +[ccpp-table-properties] + name = GFS_phys_time_vary + type = scheme + dependencies_path = ../../ + dependencies = hooks/machine.F + dependencies = Interstitials/UFS_SCM_NEPTUNE/gcycle.F90,Interstitials/UFS_SCM_NEPTUNE/iccn_def.F + dependencies = Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90,Interstitials/UFS_SCM_NEPTUNE/sfcsub.F + dependencies = Radiation/mersenne_twister.f + dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 + dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 + dependencies = photochem/module_ozphys.F90,photochem/module_h2ophys.F90 + dependencies = GWD/cires_tauamf_data.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_phys_time_vary_init + type = scheme + +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[ntoz] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in +[iaerclm] + standard_name = flag_for_aerosol_input_MG_radiation + long_name = flag for using aerosols in Morrison-Gettelman MP_radiation + units = flag + dimensions = () + type = logical + intent = in +[iaermdl] + standard_name = control_for_aerosol_radiation_scheme + long_name = control of aerosol scheme in radiation + units = 1 + dimensions = () + type = integer + intent = in +[iccn] + standard_name = control_for_ice_cloud_condensation_nuclei_forcing + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = none + dimensions = () + type = integer + intent = in +[iflip] + standard_name = control_for_vertical_index_direction + long_name = iflip - is not the same as flipv + units = flag + dimensions = () + type = integer + intent = in +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + 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 + units = count + dimensions = () + type = integer + intent = in +[ny] + standard_name = number_of_points_in_y_direction_for_this_MPI_rank + long_name = number of points in y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[idate] + standard_name = date_and_time_at_model_initialization_in_united_states_order + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[xlon_d] + standard_name = longitude_in_degree + long_name = longitude in degree east + units = degree_east + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[jindx1_o3] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[jindx2_o3] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[ddy_o3] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[jindx1_h] + standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[jindx2_h] + standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[ddy_h] + standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[h2opl] + standard_name = stratospheric_water_vapor_forcing + long_name = water forcing data + units = mixed + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[jindx1_aer] + standard_name = lower_latitude_index_of_aerosol_forcing_for_interpolation + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[jindx2_aer] + standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[ddy_aer] + standard_name = latitude_interpolation_weight_for_aerosol_forcing + long_name = interpolation high index for prescribed aerosols in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[iindx1_aer] + standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[iindx2_aer] + standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[ddx_aer] + standard_name = longitude_interpolation_weight_for_aerosol_forcing + long_name = interpolation high index for prescribed aerosols in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[aer_nm] + standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 + long_name = mass mixing ratio of aerosol from gocart or merra2 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + 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 + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[jindx2_ci] + standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[ddy_ci] + standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[iindx1_ci] + standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation + long_name = interpolation low index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[iindx2_ci] + standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[ddx_ci] + standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout +[do_ugwp_v1] + standard_name = flag_for_ugwp_version_1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in +[jindx1_tau] + standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index1 for weight1 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[jindx2_tau] + standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index2 for weight2 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[ddy_j1tau] + standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight1 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = real + intent = inout + kind = kind_phys + optional = True +[ddy_j2tau] + standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight2 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = real + intent = inout + kind = kind_phys + optional = True +[isot] + standard_name = control_for_soil_type_dataset + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in +[ivegsrc] + standard_name = control_for_vegetation_dataset + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in +[nlunit] + standard_name = iounit_of_namelist + long_name = fortran unit number for file opens + units = none + dimensions = () + type = integer + intent = in +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[lsm] + standard_name = control_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in +[lsm_noahmp] + standard_name = identifier_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in +[lsm_ruc] + standard_name = identifier_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in +[min_seaice] + standard_name = min_sea_ice_area_fraction + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in +[fice] + standard_name = sea_ice_area_fraction_of_sea_area_fraction + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[vtype] + standard_name = vegetation_type_classification + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[weasd] + standard_name = lwe_thickness_of_surface_snow_amount + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[lsoil] + standard_name = vertical_dimension_of_soil + long_name = number of soil layers + units = count + dimensions = () + type = integer + intent = in +[zs] + standard_name = depth_of_soil_layers + long_name = depth of soil levels for land surface model + units = m + dimensions = (vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = in +[dzs] + standard_name = thickness_of_soil_layers_for_land_surface_model + long_name = thickness of soil levels for land surface model + units = m + dimensions = (vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = in +[lsnow_lsm_lbound] + standard_name = lower_bound_of_vertical_dimension_of_surface_snow + long_name = lower bound of of snow-related arrays for land surface model + units = count + dimensions = () + type = integer + intent = in +[lsnow_lsm_ubound] + standard_name = upper_bound_of_vertical_dimension_of_surface_snow + long_name = upper bound of of snow-related arrays for land surface model + units = count + dimensions = () + type = integer + intent = in +[tvxy] + standard_name = canopy_temperature + long_name = vegetation temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[tgxy] + standard_name = ground_temperature + long_name = ground temperature for noahmp + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[tahxy] + standard_name = air_temperature_in_canopy + long_name = canopy air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[canicexy] + standard_name = canopy_intercepted_ice_mass + long_name = canopy intercepted ice mass + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[canliqxy] + standard_name = canopy_intercepted_liquid_water + long_name = canopy intercepted liquid water + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[eahxy] + standard_name = air_vapor_pressure_in_canopy + long_name = canopy air vapor pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[cmxy] + standard_name = surface_drag_coefficient_for_momentum_for_noahmp + long_name = surface drag coefficient for momentum for noahmp + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[chxy] + standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp + long_name = surface exchange coeff heat & moisture for noahmp + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[fwetxy] + standard_name = wet_canopy_area_fraction + long_name = area fraction of canopy that is wetted/snowed + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[sneqvoxy] + standard_name = lwe_thickness_of_snowfall_amount_on_previous_timestep + long_name = snow mass at previous time step + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[alboldxy] + standard_name = surface_albedo_assuming_deep_snow_on_previous_timestep + long_name = snow albedo at previous time step + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[qsnowxy] + standard_name = lwe_snowfall_rate + long_name = snow precipitation rate at surface + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[wslakexy] + standard_name = water_storage_in_lake + long_name = lake water storage + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[taussxy] + standard_name = dimensionless_age_of_surface_snow + long_name = non-dimensional snow age + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[waxy] + standard_name = water_storage_in_aquifer + long_name = water storage in aquifer + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[wtxy] + standard_name = water_storage_in_aquifer_and_saturated_soil + long_name = water storage in aquifer and saturated soil + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[zwtxy] + standard_name = water_table_depth + long_name = water table depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[xlaixy] + standard_name = leaf_area_index + long_name = leaf area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[xsaixy] + standard_name = stem_area_index + long_name = stem area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[lfmassxy] + standard_name = leaf_mass_content + long_name = leaf mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[stmassxy] + standard_name = stem_mass_content + long_name = stem mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[rtmassxy] + standard_name = fine_root_mass_content + long_name = fine root mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[woodxy] + standard_name = wood_mass_content + long_name = wood mass including woody roots + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[stblcpxy] + standard_name = slow_soil_pool_mass_content_of_carbon + long_name = stable carbon in deep soil + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[fastcpxy] + standard_name = fast_soil_pool_mass_content_of_carbon + long_name = short-lived carbon in shallow soil + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[smcwtdxy] + standard_name = volumetric_soil_moisture_between_soil_bottom_and_water_table + long_name = soil water content between the bottom of the soil and the water table + units = m3 m-3 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[deeprechxy] + standard_name = water_table_recharge_assuming_deep + long_name = recharge to or from the water table when deep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[rechxy] + standard_name = water_table_recharge_assuming_shallow + long_name = recharge to or from the water table when shallow + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[emiss_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[emiss_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[snowxy] + standard_name = number_of_snow_layers + long_name = number of snow layers + units = count + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[snicexy] + standard_name = lwe_thickness_of_ice_in_surface_snow + long_name = snow layer ice + units = mm + dimensions = (horizontal_dimension,lower_bound_of_vertical_dimension_of_surface_snow:upper_bound_of_vertical_dimension_of_surface_snow) + type = real + kind = kind_phys + intent = inout + optional = True +[snliqxy] + standard_name = lwe_thickness_of_liquid_water_in_surface_snow + long_name = snow layer liquid water + units = mm + dimensions = (horizontal_dimension,lower_bound_of_vertical_dimension_of_surface_snow:upper_bound_of_vertical_dimension_of_surface_snow) + type = real + kind = kind_phys + intent = inout + optional = True +[tsnoxy] + standard_name = temperature_in_surface_snow + long_name = temperature_in_surface_snow + units = K + dimensions = (horizontal_dimension,lower_bound_of_vertical_dimension_of_surface_snow:upper_bound_of_vertical_dimension_of_surface_snow) + type = real + kind = kind_phys + intent = inout + optional = True +[smoiseq] + standard_name = volumetric_equilibrium_soil_moisture + long_name = equilibrium soil water content + units = m3 m-3 + dimensions = (horizontal_dimension,vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = inout + optional = True +[zsnsoxy] + standard_name = depth_from_snow_surface_at_bottom_interface + long_name = depth from the top of the snow surface at the bottom of the layer + units = m + dimensions = (horizontal_dimension,lower_bound_of_vertical_dimension_of_surface_snow:vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = inout + optional = True +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[smc] + standard_name = volume_fraction_of_condensed_water_in_soil + long_name = total soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[tsfcl] + standard_name = surface_skin_temperature_over_land + long_name = surface skin temperature over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[snowd] + standard_name = lwe_surface_snow + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[canopy] + standard_name = canopy_water_amount + long_name = canopy water amount + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[stype] + standard_name = soil_type_classification + long_name = soil type for lsm + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in +[lsm_cold_start] + standard_name = do_lsm_cold_start + long_name = flag to signify LSM is cold-started + units = flag + dimensions = () + type = logical + intent = in +[nthrds] + standard_name = number_of_openmp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer + intent = in +[lkm] + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst + units = flag + dimensions = () + type = integer + 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_dimension) + type = integer + intent = inout +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[lakedepth] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_flake] + standard_name = flake_model_control_selection_value + long_name = value that indicates flake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[lakefrac_threshold] + standard_name = lakefrac_threshold_for_enabling_lake_model + long_name = fraction of horizontal grid area occupied by lake must be greater than this value to enable a lake model + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in +[lakedepth_threshold] + standard_name = lake_depth_threshold_for_enabling_lake_model + long_name = lake depth must be greater than this value to enable a lake model + units = m + dimensions = () + 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 + 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 + +######################################################################## +[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 + 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 + +######################################################################## +[ccpp-arg-table] + name = GFS_phys_time_vary_timestep_init + type = scheme +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[cnx] + standard_name = number_of_x_points_for_current_cubed_sphere_tile + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in +[cny] + standard_name = number_of_y_points_for_current_cubed_sphere_tile + long_name = number of points in y direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in +[isc] + standard_name = starting_x_index_for_this_MPI_rank + long_name = starting index in the x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[jsc] + standard_name = starting_y_index_for_this_MPI_rank + long_name = starting index in the y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[nrcm] + standard_name = number_of_random_numbers + long_name = second dimension of random number stream for RAS + units = count + dimensions = () + type = integer + intent = in +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[levs] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[idate] + standard_name = date_and_time_at_model_initialization_in_united_states_order + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in +[cplflx] + standard_name = flag_for_surface_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[nsswr] + standard_name = number_of_timesteps_between_shortwave_radiation_calls + long_name = number of timesteps between shortwave radiation calls + units = + dimensions = () + type = integer + intent = in +[fhswr] + standard_name = period_of_shortwave_radiation_calls + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[lsswr] + standard_name = flag_for_calling_shortwave_radiation + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[imfdeepcnv] + standard_name = control_for_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[cal_pre] + standard_name = flag_for_dominant_precipitation_type_partition + long_name = flag controls precip type algorithm + units = flag + dimensions = () + type = logical + intent = in +[random_clds] + standard_name = flag_for_random_clouds_for_RAS + long_name = flag for using random clouds with the RAS scheme + units = flag + dimensions = () + type = logical + intent = in +[nscyc] + standard_name = number_of_timesteps_between_surface_cycling_calls + long_name = number of timesteps between surface cycling calls + units = count + dimensions = () + type = integer + intent = in +[ntoz] + standard_name = index_of_ozone_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in +[iaerclm] + standard_name = flag_for_aerosol_input_MG_radiation + long_name = flag for using aerosols in Morrison-Gettelman MP_radiation + units = flag + dimensions = () + type = logical + intent = in +[iaermdl] + standard_name = control_for_aerosol_radiation_scheme + long_name = control of aerosol scheme in radiation + units = 1 + dimensions = () + type = integer + intent = in +[iccn] + standard_name = control_for_ice_cloud_condensation_nuclei_forcing + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = none + dimensions = () + type = integer + intent = in +[clstp] + standard_name = control_for_convective_cloud_diagnostics + long_name = index used by cnvc90 (for convective clouds) + units = none + dimensions = () + type = real + kind = kind_phys + intent = out +[jindx1_o3] + standard_name = lower_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[jindx2_o3] + standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[ddy_o3] + standard_name = latitude_interpolation_weight_for_ozone_forcing + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = mixed + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = inout +[jindx1_h] + standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[jindx2_h] + standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[ddy_h] + standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[h2opl] + standard_name = stratospheric_water_vapor_forcing + long_name = water forcing data + units = mixed + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = inout +[iflip] + standard_name = control_for_vertical_index_direction + long_name = iflip - is not the same as flipv + units = flag + dimensions = () + type = integer + intent = in +[jindx1_aer] + standard_name = lower_latitude_index_of_aerosol_forcing_for_interpolation + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[jindx2_aer] + standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[ddy_aer] + standard_name = latitude_interpolation_weight_for_aerosol_forcing + long_name = interpolation high index for prescribed aerosols in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[iindx1_aer] + standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[iindx2_aer] + standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[ddx_aer] + standard_name = longitude_interpolation_weight_for_aerosol_forcing + long_name = interpolation high index for prescribed aerosols in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[aer_nm] + standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 + long_name = mass mixing ratio of aerosol from gocart or merra2 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = inout +[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 + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[jindx2_ci] + standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[ddy_ci] + standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[iindx1_ci] + standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation + long_name = interpolation low index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[iindx2_ci] + standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[ddx_ci] + standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[in_nm] + standard_name = ice_nucleation_number_from_climatology + long_name = ice nucleation number in MG MP + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[ccn_nm] + standard_name = tendency_of_activated_cloud_condensation_nuclei_from_climatology + long_name = tendency of ccn activated number + units = kg-1 s-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[fn_nml] + standard_name = filename_of_namelist + long_name = namelist filename + units = none + dimensions = () + type = character + kind = len=* + intent = in +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[seed0] + standard_name = seed_random_numbers_RAS + long_name = random number seed for the RAS scheme + units = none + dimensions = () + type = integer + intent = in +[rann] + standard_name = random_number + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,number_of_random_numbers) + 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 +[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 + units = count + dimensions = () + type = integer + intent = in +[ny] + standard_name = number_of_points_in_y_direction_for_this_MPI_rank + long_name = number of points in y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[nsst] + standard_name = control_for_nsstm + long_name = NSSTM flag: off/uncoupled/coupled=0/1/2 + units = flag + dimensions = () + type = integer + intent = in +[tile_num] + standard_name = index_of_cubed_sphere_tile + long_name = tile number + units = none + dimensions = () + type = integer + intent = in +[nlunit] + standard_name = iounit_of_namelist + long_name = fortran unit number for file opens + units = none + dimensions = () + type = integer + intent = in +[lsoil] + standard_name = vertical_dimension_of_soil + long_name = number of soil layers + units = count + dimensions = () + type = integer + intent = in +[lsoil_lsm] + standard_name = vertical_dimension_of_soil_internal_to_land_surface_scheme + long_name = number of soil layers internal to land surface model + units = count + dimensions = () + type = integer + intent = in +[kice] + standard_name = vertical_dimension_of_sea_ice + long_name = vertical loop extent for ice levels, start at 1 + units = count + dimensions = () + type = integer + intent = in +[ialb] + standard_name = control_for_surface_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in +[isot] + standard_name = control_for_soil_type_dataset + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in +[ivegsrc] + standard_name = control_for_vegetation_dataset + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in +[input_nml_file] + standard_name = filename_of_internal_namelist + long_name = namelist filename for internal file reads + units = none + dimensions = (number_of_lines_in_internal_namelist) + type = character + kind = len=256 + intent = in +[use_ufo] + standard_name = flag_for_gcycle_surface_option + long_name = flag for gcycle surface option + units = flag + dimensions = () + type = logical + intent = in +[nst_anl] + standard_name = flag_for_nsstm_analysis_in_gcycle + long_name = flag for NSSTM analysis in gcycle/sfcsub + units = flag + dimensions = () + type = logical + intent = in +[frac_grid] + standard_name = flag_for_fractional_landmask + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in +[fhcyc] + standard_name = frequency_for_surface_cycling_calls + long_name = frequency for surface cycling calls + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[phour] + standard_name = forecast_time_on_previous_timestep + long_name = forecast time at the previous timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[min_seaice] + standard_name = min_sea_ice_area_fraction + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in +[min_lakeice] + standard_name = min_lake_ice_area_fraction + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in +[smc] + standard_name = volume_fraction_of_condensed_water_in_soil + long_name = total soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[smois] + standard_name = volume_fraction_of_soil_moisture_for_land_surface_model + long_name = volumetric fraction of soil moisture for lsm + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = inout + optional = True +[sh2o] + standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model + long_name = volume fraction of unfrozen soil moisture for lsm + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = inout + optional = True +[tslb] + standard_name = soil_temperature_for_land_surface_model + long_name = soil temperature for land surface model + units = K + dimensions = (horizontal_dimension,vertical_dimension_of_soil_internal_to_land_surface_scheme) + type = real + kind = kind_phys + intent = inout + optional = True +[tiice] + standard_name = temperature_in_ice_layer + long_name = sea ice internal temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension_of_sea_ice) + type = real + kind = kind_phys + intent = inout +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[tref] + standard_name = reference_sea_surface_temperature + long_name = sea surface reference temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[tsfco] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[tisfc] + standard_name = surface_skin_temperature_over_ice + long_name = surface skin temperature over ice + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[hice] + standard_name = sea_ice_thickness + long_name = sea ice thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[fice] + standard_name = sea_ice_area_fraction_of_sea_area_fraction + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[facsf] + standard_name =strong_cosz_area_fraction + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[facwf] + standard_name = weak_cosz_area_fraction + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[alvsf] + standard_name = vis_albedo_strong_cosz + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[alvwf] + standard_name = vis_albedo_weak_cosz + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[alnsf] + standard_name = nir_albedo_strong_cosz + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[alnwf] + standard_name = nir_albedo_weak_cosz + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[zorli] + standard_name = surface_roughness_length_over_ice + long_name = surface roughness length over ice + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[zorll] + standard_name = surface_roughness_length_over_land + long_name = surface roughness length over land + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[zorlo] + standard_name = surface_roughness_length_over_water + long_name = surface roughness length over water + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[weasd] + standard_name = lwe_thickness_of_surface_snow_amount + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[slope] + standard_name = surface_slope_classification + long_name = sfc slope type for lsm + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[snoalb] + standard_name = upper_bound_of_max_albedo_assuming_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[canopy] + standard_name = canopy_water_amount + long_name = canopy water amount + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[vfrac] + standard_name = vegetation_area_fraction + long_name = areal fractional cover of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[vtype] + standard_name = vegetation_type_classification + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[stype] + standard_name = soil_type_classification + long_name = soil type for lsm + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[scolor] + standard_name = soil_color_classification + long_name = soil color for lsm + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout +[shdmin] + standard_name = min_vegetation_area_fraction + long_name = min fractional coverage of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[shdmax] + standard_name = max_vegetation_area_fraction + long_name = max fractional coverage of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[snowd] + standard_name = lwe_surface_snow + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[cv] + standard_name = convective_cloud_area_fraction_between_sw_radiation_calls_from_cnvc90 + long_name = fraction of convective cloud + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[cvb] + standard_name = pressure_at_convective_cloud_base_between_sw_radiation_calls_from_cnvc90 + long_name = convective cloud bottom pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[cvt] + standard_name = pressure_at_convective_cloud_top_between_sw_radiation_calls_from_cnvc90 + long_name = convective cloud top pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[oro] + standard_name = height_above_mean_sea_level + long_name = height_above_mean_sea_level + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[oro_uf] + standard_name = unfiltered_height_above_mean_sea_level + long_name = unfiltered height_above_mean_sea_level + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[xlon_d] + standard_name = longitude_in_degree + long_name = longitude in degree east + units = degree_east + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[slmsk] + standard_name = area_type + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[do_ugwp_v1] + standard_name = flag_for_ugwp_version_1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in +[jindx1_tau] + standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index1 for weight1 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[jindx2_tau] + standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index2 for weight2 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = True +[ddy_j1tau] + standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight1 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys + optional = True +[ddy_j2tau] + standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight2 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys + optional = True +[tau_amf] + standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = ngw_absolute_momentum_flux + units = mixed + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[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 = in +[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_phys_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 index 2af01115c..85fc6fc68 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 @@ -5,7 +5,8 @@ !! 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 mpi_f08 + use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec use mersenne_twister, only: random_setseed, random_number @@ -57,7 +58,7 @@ module GFS_phys_time_vary !>\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, levs, & + mpicomm, mpirank, mpiroot, 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, & @@ -78,7 +79,8 @@ subroutine GFS_phys_time_vary_init ( implicit none ! Interface variables - integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny, levs, iaermdl + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot, 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 @@ -201,9 +203,9 @@ subroutine GFS_phys_time_vary_init ( if (iaerclm) then ntrcaer = ntrcaerm if(iaermdl == 1) then - call read_aerdata (me,master,iflip,idate,errmsg,errflg) + call read_aerdata (mpicomm,mpirank,mpiroot,iflip,idate,errmsg,errflg) elseif (iaermdl == 6) then - call read_aerdata_dl(me,master,iflip, & + call read_aerdata_dl(mpicomm, mpirank, mpiroot, iflip, & idate,fhour, errmsg,errflg) end if if(errflg/=0) return @@ -222,19 +224,19 @@ subroutine GFS_phys_time_vary_init ( !> - Call read_cidata() to read IN and CCN data if (iccn == 1) then - call read_cidata (me,master) + call read_cidata (mpicomm, mpirank, mpiroot) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif !> - Call tau_amf dats for ugwp_v1 if (do_ugwp_v1) then - call read_tau_amf(me, master, errmsg, errflg) + call read_tau_amf(mpicomm, mpirank, mpiroot, 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) + call set_soilveg(mpirank, isot, ivegsrc, nlunit, errmsg, errflg) if(errflg/=0) return !> - read in NoahMP table (needed for NoahMP init) @@ -257,8 +259,7 @@ subroutine GFS_phys_time_vary_init ( if (iaerclm) then call setindxaer (im, xlat_d, jindx1_aer, & jindx2_aer, ddy_aer, xlon_d, & - iindx1_aer, iindx2_aer, ddx_aer, & - me, master) + iindx1_aer, iindx2_aer, ddx_aer) iamin = min(minval(iindx1_aer), iamin) iamax = max(maxval(iindx2_aer), iamax) jamin = min(minval(jindx1_aer), jamin) @@ -274,7 +275,7 @@ subroutine GFS_phys_time_vary_init ( !> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that can resolve GWs if (do_ugwp_v1) then - call cires_indx_ugwp (im, me, master, xlat_d, jindx1_tau, jindx2_tau, & + call cires_indx_ugwp (im, mpirank, mpiroot, xlat_d, jindx1_tau, jindx2_tau, & ddy_j1tau, ddy_j2tau) endif @@ -290,7 +291,7 @@ subroutine GFS_phys_time_vary_init ( !--- if sncovr does not exist in the restart, need to create it if (all(sncovr < zero)) then - if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' + if (mpirank == mpiroot ) write(*,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' !--- compute sncovr from existing variables !--- code taken directly from read_fix.f sncovr(:) = zero @@ -311,7 +312,7 @@ subroutine GFS_phys_time_vary_init ( !--- For RUC LSM: create sncovr_ice from sncovr if (lsm == lsm_ruc) then if (all(sncovr_ice < zero)) then - if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: fill sncovr_ice with sncovr for RUC LSM' + if (mpirank == mpiroot ) write(*,'(a)') 'GFS_phys_time_vary_init: fill sncovr_ice with sncovr for RUC LSM' sncovr_ice(:) = sncovr(:) endif endif @@ -320,9 +321,9 @@ subroutine GFS_phys_time_vary_init ( if (iaerclm) then if (iaermdl==1) then - call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg) + call read_aerdataf (mpicomm, mpirank, mpiroot, iflip, idate, fhour, errmsg, errflg) elseif (iaermdl==6) then - call read_aerdataf_dl (me, master, iflip, idate, fhour, errmsg, errflg) + call read_aerdataf_dl (mpicomm, mpirank, mpiroot, iflip, idate, fhour, errmsg, errflg) end if if (errflg/=0) return end if @@ -331,7 +332,7 @@ subroutine GFS_phys_time_vary_init ( !--- land and ice - not for restart runs lsm_init: if (lsm_cold_start) then if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then - if (me == master ) write(*,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' + if (mpirank == mpiroot ) write(*,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' do ix=1,im albdvis_lnd(ix) = 0.2_kind_phys albdnir_lnd(ix) = 0.2_kind_phys @@ -653,7 +654,7 @@ end subroutine GFS_phys_time_vary_init !>\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, & + mpicomm, mpirank, mpiroot, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & 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, & @@ -664,7 +665,8 @@ subroutine GFS_phys_time_vary_timestep_init ( implicit none ! Interface variables - integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & nsswr, imfdeepcnv, iccn, ntoz, iflip, iaermdl integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhswr, fhour @@ -787,7 +789,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !> - Call ciinterpol() to make IN and CCN data interpolation if (iccn == 1) then - call ciinterpol (me, im, idate, fhour, & + call ciinterpol (mpirank, im, idate, fhour, & jindx1_ci, jindx2_ci, & ddy_ci, iindx1_ci, & iindx2_ci, ddx_ci, & @@ -796,7 +798,7 @@ subroutine GFS_phys_time_vary_timestep_init ( !> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that resolve GW-activ if (do_ugwp_v1) then - call tau_amf_interp(me, master, im, idate, fhour, & + call tau_amf_interp(mpirank, mpiroot, im, idate, fhour, & jindx1_tau, jindx2_tau, & ddy_j1tau, ddy_j2tau, tau_amf) endif @@ -806,13 +808,13 @@ subroutine GFS_phys_time_vary_timestep_init ( ! aerinterpol is using threading inside, don't ! move into OpenMP parallel section above if (iaermdl==1) then - call aerinterpol (me, master, nthrds, im, idate, & + call aerinterpol (mpicomm, mpirank, mpiroot, nthrds, im, idate, & 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, & + call aerinterpol_dl (mpicomm, mpirank, mpiroot, nthrds, im, idate, & fhour, iflip, jindx1_aer, jindx2_aer, & ddy_aer, iindx1_aer, & iindx2_aer, ddx_aer, & 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 e86858a3f..98a60e3b4 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 @@ -15,14 +15,21 @@ name = GFS_phys_time_vary_init type = scheme -[me] +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] standard_name = mpi_rank long_name = current MPI-rank units = index dimensions = () type = integer intent = in -[master] +[mpiroot] standard_name = mpi_root long_name = master MPI-rank units = index @@ -1095,14 +1102,21 @@ [ccpp-arg-table] name = GFS_phys_time_vary_timestep_init type = scheme -[me] +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] standard_name = mpi_rank long_name = current MPI-rank units = index dimensions = () type = integer intent = in -[master] +[mpiroot] standard_name = mpi_root long_name = master MPI-rank units = index @@ -1295,7 +1309,7 @@ standard_name = ozone_forcing long_name = ozone forcing data units = mixed - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys intent = inout diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.neptune.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.neptune.F90 new file mode 100644 index 000000000..3eaec5e6b --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.neptune.F90 @@ -0,0 +1,100 @@ +!>\file GFS_rad_time_vary.neptune.F90 +!! Contains code related to GFS radiation suite setup (radiation part of time_vary_step) + module GFS_rad_time_vary + + implicit none + + private + + public GFS_rad_time_vary_timestep_init + + contains + +!> This module contains code related to GFS radiation setup. + +!> \section arg_table_GFS_rad_time_vary_timestep_init Argument Table +!! \htmlinclude GFS_rad_time_vary_timestep_init.html +!! + subroutine GFS_rad_time_vary_timestep_init (lrseeds, rseeds, & + lslwr, lsswr, isubc_lw, isubc_sw, icsdsw, icsdlw, cnx, cny, isc, jsc, & + imap, jmap, sec, kdt, imp_physics, imp_physics_zhao_carr, ipsd0, ipsdlim,& + ps_2delt, ps_1delt, t_2delt, t_1delt, qv_2delt, qv_1delt, t, qv, ps, & + errmsg, errflg) + + use mersenne_twister, only: random_setseed, random_index, random_stat + use machine, only: kind_phys + use radcons, only: qmin, con_100 + + implicit none + + ! Interface variables + logical, intent(in) :: lrseeds + integer, intent(in), optional :: rseeds(:,:) + integer, intent(in) :: isubc_lw, isubc_sw, cnx, cny, isc, jsc, kdt + integer, intent(in) :: imp_physics, imp_physics_zhao_carr, ipsd0, ipsdlim + logical, intent(in) :: lslwr, lsswr + integer, intent(inout), optional :: icsdsw(:), icsdlw(:) + integer, intent(in) :: imap(:), jmap(:) + real(kind_phys), intent(in) :: sec + real(kind_phys), intent(inout), optional :: ps_2delt(:) + real(kind_phys), intent(inout), optional :: ps_1delt(:) + real(kind_phys), intent(inout), optional :: t_2delt(:,:) + real(kind_phys), intent(inout), optional :: t_1delt(:,:) + real(kind_phys), intent(inout), optional :: qv_2delt(:,:) + real(kind_phys), intent(inout), optional:: qv_1delt(:,:) + real(kind_phys), intent(in) :: t(:,:), qv(:,:), ps(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + type (random_stat) :: stat + integer :: ix, j, i, ipseed + integer :: numrdm(cnx*cny*2) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lsswr .or. lslwr) then + + !--- call to GFS_radupdate_timestep_init is now in GFS_rrtmg_setup_timestep_init + + !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) + if ((isubc_lw==2) .or. (isubc_sw==2)) then + !NRL If random seeds supplied by NEPTUNE + if(lrseeds) then + do ix=1,size(jmap) + icsdsw(ix) = rseeds(ix,1) + icsdlw(ix) = rseeds(ix,2) + enddo + else + ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 + call random_setseed (ipseed, stat) + call random_index (ipsdlim, numrdm, stat) + + do ix=1,size(jmap) + j = jmap(ix) + i = imap(ix) + !--- for testing purposes, replace numrdm with '100' + icsdsw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx) + icsdlw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx + cnx*cny) + enddo + end if !lrseeds + endif ! isubc_lw and isubc_sw + + if (imp_physics == imp_physics_zhao_carr) then + if (kdt == 1) then + t_2delt = t + t_1delt = t + qv_2delt = qv + qv_1delt = qv + ps_2delt = ps + ps_1delt = ps + endif + endif + + endif + + end subroutine GFS_rad_time_vary_timestep_init + + end module GFS_rad_time_vary diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.neptune.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.neptune.meta new file mode 100644 index 000000000..a7ac1381c --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.neptune.meta @@ -0,0 +1,248 @@ +[ccpp-table-properties] + name = GFS_rad_time_vary + type = scheme + dependencies_path = ../../ + dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 + +######################################################################## +[ccpp-arg-table] + name = GFS_rad_time_vary_timestep_init + type = scheme +[lrseeds] + standard_name = do_host_provided_random_seeds + long_name = flag to use host-provided random seeds + units = flag + dimensions = () + type = logical + intent = in +[rseeds] + standard_name = random_number_seeds_from_host + long_name = random number seeds from host + units = none + dimensions = (horizontal_dimension, number_of_host_provided_random_number_streams) + type = integer + intent = in + optional = True +[lslwr] + standard_name = flag_for_calling_longwave_radiation + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in +[lsswr] + standard_name = flag_for_calling_shortwave_radiation + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in +[isubc_lw] + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in +[isubc_sw] + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in +[icsdsw] + standard_name = random_number_seed_for_mcica_shortwave + long_name = random seeds for sub-column cloud generators sw + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[icsdlw] + standard_name = random_number_seed_for_mcica_longwave + long_name = random seeds for sub-column cloud generators lw + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[cnx] + standard_name = number_of_x_points_for_current_cubed_sphere_tile + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in +[cny] + standard_name = number_of_y_points_for_current_cubed_sphere_tile + long_name = number of points in y direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in +[isc] + standard_name = starting_x_index_for_this_MPI_rank + long_name = starting index in the x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[jsc] + standard_name = starting_y_index_for_this_MPI_rank + long_name = starting index in the y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in +[sec] + standard_name = forecast_time_in_seconds + long_name = seconds elapsed since model initialization + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[imp_physics] + standard_name = control_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_zhao_carr] + standard_name = identifier_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[ipsd0] + standard_name = initial_seed_for_mcica + long_name = initial permutation seed for mcica radiation + units = 1 + dimensions = () + type = integer + intent = in +[ipsdlim] + standard_name = limit_for_initial_seed_for_mcica + long_name = limit for initial permutation seed for mcica radiation + units = 1 + dimensions = () + type = integer + intent = in +[ps_2delt] + standard_name = surface_air_pressure_two_timesteps_back + long_name = surface air pressure two timesteps back + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[ps_1delt] + standard_name = surface_air_pressure_on_previous_timestep + long_name = surface air pressure at previous timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[t_2delt] + standard_name = air_temperature_two_timesteps_back + long_name = air temperature two timesteps back + units = K + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[t_1delt] + standard_name = air_temperature_on_previous_timestep_in_xyz_dimensioned_restart_array + long_name = air temperature at previous timestep + units = K + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[qv_2delt] + standard_name = specific_humidity_two_timesteps_back + long_name = water vapor specific humidity two timesteps back + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[qv_1delt] + standard_name = specific_humidity_on_previous_timestep_in_xyz_dimensioned_restart_array + long_name = water vapor specific humidity at previous timestep + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[t] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[qv] + standard_name = specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ps] + standard_name = air_pressure_at_lowest_model_interface + long_name = air pressure at lowest model interface + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[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_surface.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 index 9c0caa104..ef4783f5b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 @@ -6,6 +6,7 @@ module GFS_radiation_surface use machine, only: kind_phys + use mpi_f08 contains @@ -16,13 +17,16 @@ module GFS_radiation_surface !> \section arg_table_GFS_radiation_surface_init Argument Table !! \htmlinclude GFS_radiation_surface_init.html !! - subroutine GFS_radiation_surface_init (me, ialb, iems, semis_file, con_pi, errmsg, errflg) + subroutine GFS_radiation_surface_init (mpicomm, mpirank, mpiroot, & + ialb, iems, semis_file, con_pi, errmsg, errflg) use module_radiation_surface, only: sfc_init implicit none - integer, intent(in) :: me, ialb, iems + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot + integer, intent(in) :: ialb, iems character(len=26), intent(in) :: semis_file real(kind_phys), intent(in) :: con_pi character(len=*), intent(out) :: errmsg @@ -32,13 +36,14 @@ subroutine GFS_radiation_surface_init (me, ialb, iems, semis_file, con_pi, errms errmsg = '' errflg = 0 - if ( me == 0 ) then + if ( mpirank==mpiroot ) then print *,'In GFS_radiation_surface_init, before calling sfc_init' print *,'ialb=',ialb,' iems=',iems end if ! Call surface initialization routine - call sfc_init ( me, ialb, iems, semis_file, con_pi, errmsg, errflg ) + call sfc_init ( mpicomm, mpirank, mpiroot, & + ialb, iems, semis_file, con_pi, errmsg, errflg ) end subroutine GFS_radiation_surface_init diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta index 7e04bc8d2..0192b0547 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta @@ -10,13 +10,27 @@ [ccpp-arg-table] name = GFS_radiation_surface_init type = scheme -[me] +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] standard_name = mpi_rank long_name = current MPI-rank units = index dimensions = () type = integer intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in [ialb] standard_name = control_for_surface_albedo long_name = flag for using climatology alb, based on sfc type diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 index 4d1391e20..baa660dbc 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 @@ -8,6 +8,7 @@ module GFS_rrtmg_setup use machine, only: kind_phys use module_ozphys, only: ty_ozphys + use mpi_f08 implicit none public GFS_rrtmg_setup_init, GFS_rrtmg_setup_timestep_init, GFS_rrtmg_setup_finalize @@ -40,7 +41,8 @@ module GFS_rrtmg_setup subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & iaer, ntcw, num_p3d, npdf3d, ntoz, iovr, iovr_rand, iovr_maxrand, & iovr_max, iovr_dcorr, iovr_exp, iovr_exprand, icliq_sw, lcrick, & - lcnorm, imp_physics, lnoprec, idate, iflip, do_RRTMGP, me, lalw1bd, & + lcnorm, imp_physics, lnoprec, idate, iflip, do_RRTMGP, & + mpicomm, mpirank, mpiroot, lalw1bd, & iaermdl, iaerflg, aeros_file, con_pi, con_t0c, con_c, con_boltz, & con_plnk, con_solr_2008, con_solr_2002, con_g, con_rd, co2usr_file, & co2cyc_file, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, isubclw,& @@ -155,10 +157,13 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & integer, intent(in) :: levr, ictm, isol, ico2, iaer, ntcw, num_p3d, & ltp, npdf3d, ntoz, iovr, iovr_rand, iovr_maxrand, iovr_max, & iovr_dcorr, iovr_exp, iovr_exprand, icliq_sw, imp_physics, & - iflip, me, rad_hr_units, icliq_lw, isubcsw, isubclw, iswmode + iflip, rad_hr_units, icliq_lw, isubcsw, isubclw, iswmode integer, intent(in) :: idate(:) logical, intent(in) :: lcrick, lcnorm, lnoprec, do_RRTMGP, lalw1bd, & inc_minor_gas, lextop + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank + integer, intent(in) :: mpiroot character(len=26),intent(in) :: aeros_file, solar_file, co2usr_file,& co2cyc_file real(kind_phys), intent(in) :: con_pi, con_t0c, con_c, con_boltz, & @@ -191,7 +196,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & ipsd0 = 17*idate(1)+43*idate(2)+37*idate(3)+23*idate(4) endif - if ( me == 0 ) then + if ( mpirank == mpiroot ) then print *,' In rad_initialize (GFS_rrtmg_setup_init), before calling RRTMG initialization' print *,' si =',si print *,' levr=',levr,' ictm=',ictm,' isol=',isol,' ico2=',ico2,& @@ -199,7 +204,7 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & print *,' np3d=',num_p3d,' ntoz=',ntoz, & ' iovr=',iovr,' isubcsw=',isubcsw, & ' isubclw=',isubclw,' icliq_sw=',icliq_sw, & - ' iflip=',iflip,' me=',me + ' iflip=',iflip,' mpirank=',mpirank print *,' lcrick=',lcrick, & ' lcnorm=',lcnorm,' lnoprec=',lnoprec print *, 'lextop=',lextop, ' ltp=',ltp @@ -208,29 +213,31 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & if (is_initialized) return ! Call initialization routines - call sol_init ( me, isol, solar_file, con_solr_2008,con_solr_2002,& - con_pi ) - call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, & + call sol_init ( mpicomm, mpirank, mpiroot, & + isol, solar_file, con_solr_2008,con_solr_2002, con_pi ) + call aer_init ( levr, mpicomm, mpirank, mpiroot, & + iaermdl, iaerflg, lalw1bd, aeros_file, & con_pi, con_t0c, con_c, con_boltz, con_plnk, errflg, errmsg) if(errflg/=0) return - call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) + call gas_init ( mpicomm, mpirank, mpiroot, & + co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) if(errflg/=0) return - call cld_init ( si, levr, imp_physics, me, con_g, con_rd, errflg, errmsg) + call cld_init ( si, levr, imp_physics, mpirank, con_g, con_rd, errflg, errmsg) if(errflg/=0) return - call rlwinit ( me, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, & + call rlwinit ( mpirank, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, & iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & iovr_exp, iovr_exprand, errflg, errmsg ) if(errflg/=0) return - call rswinit ( me, rad_hr_units, inc_minor_gas, icliq_sw, isubclw, & + call rswinit ( mpirank, rad_hr_units, inc_minor_gas, icliq_sw, isubclw, & iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & iovr_exp, iovr_exprand,iswmode, errflg, errmsg ) if(errflg/=0) return - if ( me == 0 ) then + if ( mpirank == mpiroot ) then print *,' Radiation sub-cloud initial seed =',ipsd0, & & ' IC-idate =',idate print *,' return from rad_initialize (GFS_rrtmg_setup_init) - after calling RRTMG initialization' @@ -244,7 +251,8 @@ end subroutine GFS_rrtmg_setup_init !! \htmlinclude GFS_rrtmg_setup_timestep_init.html !! subroutine GFS_rrtmg_setup_timestep_init (idate, jdate, deltsw, deltim, & - lsswr, me, iaermdl, iaerflg, isol, aeros_file, slag, sdec, cdec, & + lsswr, mpicomm, mpirank, mpiroot, & + iaermdl, iaerflg, isol, aeros_file, slag, sdec, cdec, & solcon, con_pi, co2dat_file, co2gbl_file, ictm, ico2, ntoz, ozphys,& errmsg, errflg) @@ -257,7 +265,9 @@ subroutine GFS_rrtmg_setup_timestep_init (idate, jdate, deltsw, deltim, & real(kind=kind_phys), intent(in) :: deltim real(kind=kind_phys), intent(in) :: con_pi logical, intent(in) :: lsswr - integer, intent(in) :: me + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank + integer, intent(in) :: mpiroot integer, intent(in) :: iaermdl, iaerflg, isol, ictm, ico2, ntoz type(ty_ozphys), intent(inout) :: ozphys character(len=26), intent(in) :: aeros_file, co2dat_file, co2gbl_file @@ -279,7 +289,8 @@ subroutine GFS_rrtmg_setup_timestep_init (idate, jdate, deltsw, deltim, & errmsg = '' errflg = 0 - call radupdate(idate,jdate,deltsw,deltim,lsswr,me,iaermdl, iaerflg,isol,aeros_file,& + call radupdate(idate,jdate,deltsw,deltim,lsswr,& + mpicomm,mpirank,mpiroot,iaermdl, iaerflg,isol,aeros_file,& slag,sdec,cdec,solcon,con_pi,co2dat_file,co2gbl_file,ictm,ico2,ntoz,ozphys,errflg,errmsg) end subroutine GFS_rrtmg_setup_timestep_init @@ -326,7 +337,8 @@ end subroutine GFS_rrtmg_setup_finalize !! \param solcon solar constant adjusted by sun-earth distance \f$(W/m^2)\f$ !> \section gen_radupdate General Algorithm !----------------------------------- - subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& + subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, & + mpicomm,mpirank,mpiroot, iaermdl, & iaerflg, isol, aeros_file, slag,sdec,cdec,solcon, con_pi, & co2dat_file,co2gbl_file, ictm, ico2, ntoz, ozphys, errflg, errmsg) !................................... @@ -371,7 +383,10 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& implicit none ! --- inputs: - integer, intent(in) :: idate(:), jdate(:), me, iaermdl, iaerflg, isol, ictm, ntoz, ico2 + integer, intent(in) :: idate(:), jdate(:) + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot + integer, intent(in) :: iaermdl, iaerflg, isol, ictm, ntoz, ico2 type(ty_ozphys),intent(inout) :: ozphys logical, intent(in) :: lsswr character(len=26),intent(in) :: aeros_file,co2dat_file,co2gbl_file @@ -443,7 +458,8 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& call sol_update & ! --- inputs: - & ( jdate,kyear,deltsw,deltim,lsol_chg, me, & + & ( jdate,kyear,deltsw,deltim,lsol_chg, & + & mpicomm,mpirank,mpiroot, & ! --- outputs: & slag,sdec,cdec,solcon,con_pi,errmsg,errflg & & ) @@ -454,7 +470,8 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& !> -# Call module_radiation_aerosols::aer_update(), monthly update, no !! time interpolation if ( lmon_chg ) then - call aer_update ( iyear, imon, me, iaermdl, aeros_file, errflg, errmsg ) + call aer_update ( iyear, imon, mpicomm,mpirank,mpiroot, & + iaermdl, aeros_file, errflg, errmsg ) if(errflg/=0) return endif @@ -467,7 +484,8 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& lco2_chg = .false. endif - call gas_update ( kyear,kmon,kday,khour,lco2_chg, me, co2dat_file, & + call gas_update ( kyear,kmon,kday,khour,lco2_chg, & + mpicomm,mpirank,mpiroot, co2dat_file, & co2gbl_file, ictm, ico2, errflg, errmsg ) if(errflg/=0) return diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta index a8030d969..5bd5971a8 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta @@ -2,6 +2,7 @@ name = GFS_rrtmg_setup type = scheme dependencies_path = ../../ + dependencies = tools/mpiutil.F90 dependencies = hooks/machine.F dependencies = Radiation/radiation_aerosols.f dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f @@ -233,13 +234,27 @@ dimensions = () type = logical intent = in -[me] +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] standard_name = mpi_rank long_name = current MPI-rank units = index dimensions = () type = integer intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in [aeros_file] standard_name = aerosol_data_file long_name = aerosol data file @@ -440,13 +455,27 @@ dimensions = () type = logical intent = in -[me] +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] standard_name = mpi_rank long_name = current MPI-rank units = index dimensions = () type = integer intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in [iaermdl] standard_name = control_for_aerosol_radiation_scheme long_name = control of aerosol scheme in radiation diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 index 2ba1029f3..0ef685cc2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 @@ -2,6 +2,7 @@ !! This file initializes the RRTMGP radiation scheme module GFS_rrtmgp_setup + use mpi_f08 use machine, only : kind_phys use module_radiation_astronomy, only : sol_init, sol_update use module_radiation_aerosols, only : aer_init, aer_update @@ -38,9 +39,9 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & ntcw, ntoz, iovr, isubc_sw, isubc_lw, lalw1bd, idate, & - me, aeros_file, iaermdl, iaerflg, con_pi, con_t0c, con_c, con_boltz, con_plnk, & - solar_file, con_solr_2008, con_solr_2002, co2usr_file, co2cyc_file, ipsd0, & - errmsg, errflg) + mpicomm, mpirank, mpiroot, aeros_file, iaermdl, iaerflg, con_pi, con_t0c, & + con_c, con_boltz, con_plnk, solar_file, con_solr_2008, con_solr_2002, co2usr_file,& + co2cyc_file, ipsd0, errmsg, errflg) ! Inputs logical, intent(in) :: do_RRTMGP @@ -55,7 +56,8 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, con_pi, con_t0c, con_c, con_boltz, con_plnk, con_solr_2008, con_solr_2002 real(kind_phys), dimension(:), intent(in) :: & si - integer, intent(in) :: levr, ictm, isol, ico2, iaer, ntcw, ntoz, iovr, isubc_sw, isubc_lw, me + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: levr, ictm, isol, ico2, iaer, ntcw, ntoz, iovr, isubc_sw, isubc_lw, mpirank, mpiroot logical, intent(in) :: & lalw1bd integer, intent(in), dimension(:) :: & @@ -92,7 +94,7 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, ipsd0 = 17*idate(1)+43*idate(2)+37*idate(3)+23*idate(4) endif - if ( me == 0 ) then + if ( mpirank == mpiroot ) then print *,' In rad_initialize (GFS_rrtmgp_setup_init), before calling radinit' print *,' si = ',si print *,' levr = ',levr, & @@ -107,7 +109,7 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, ' isubc_sw = ',isubc_sw, & ' isubc_lw = ',isubc_lw, & ' ipsd0 = ',ipsd0, & - ' me = ',me + ' mpirank = ',mpirank endif loz1st = (ntoz == 0) ! first-time clim ozone data read flag @@ -118,14 +120,14 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, if (is_initialized) return ! Call initialization routines.. - call sol_init ( me, isol, solar_file, con_solr_2008, con_solr_2002, con_pi ) - call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, con_pi, con_t0c, & - con_c, con_boltz, con_plnk, errflg, errmsg) + call sol_init ( mpicomm, mpirank, mpiroot, isol, solar_file, con_solr_2008, con_solr_2002, con_pi ) + call aer_init ( levr, mpicomm, mpirank, mpiroot, iaermdl, iaerflg, lalw1bd, aeros_file, con_pi, & + con_t0c, con_c, con_boltz, con_plnk, errflg, errmsg) if(errflg/=0) return - call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) + call gas_init ( mpicomm, mpirank, mpiroot, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) if(errflg/=0) return - if ( me == 0 ) then + if ( mpirank == mpiroot ) then print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' endif @@ -136,9 +138,9 @@ end subroutine GFS_rrtmgp_setup_init !> \section arg_table_GFS_rrtmgp_setup_timestep_init Argument Table !! \htmlinclude GFS_rrtmgp_setup_timestep_init.html !! - subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad, me, & - iaermdl, aeros_file, isol, slag, sdec, cdec, solcon, con_pi, co2dat_file, & - co2gbl_file, ictm, ico2, ntoz, ozphys, errmsg, errflg) + subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad, & + mpicomm, mpirank, mpiroot, iaermdl, aeros_file, isol, slag, sdec, cdec, solcon, & + con_pi, co2dat_file, co2gbl_file, ictm, ico2, ntoz, ozphys, errmsg, errflg) ! Inputs integer, intent(in) :: idate(:) @@ -147,7 +149,8 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad real(kind_phys), intent(in) :: deltim logical, intent(in) :: doSWrad real(kind_phys), intent(in) :: con_pi - integer, intent(in) :: me + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot integer, intent(in) :: iaermdl,isol,ictm,ico2,ntoz character(len=26), intent(in) :: aeros_file,co2dat_file,co2gbl_file type(ty_ozphys),intent(inout) :: ozphys @@ -215,13 +218,14 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad lsol_chg = ( isol==4 .and. lmon_chg ) endif iyear0 = iyear - call sol_update(jdate, kyear, deltsw, deltim, lsol_chg, me, slag, sdec, cdec, solcon, con_pi, errmsg, errflg) + call sol_update(jdate, kyear, deltsw, deltim, lsol_chg, mpicomm, mpirank, mpiroot, & + slag, sdec, cdec, solcon, con_pi, errmsg, errflg) if(errflg/=0) return endif ! Update aerosols... if ( lmon_chg ) then - call aer_update ( iyear, imon, me, iaermdl, aeros_file, errflg, errmsg) + call aer_update ( iyear, imon, mpicomm, mpirank, mpiroot, iaermdl, aeros_file, errflg, errmsg) if(errflg/=0) return endif @@ -232,7 +236,7 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad else lco2_chg = .false. endif - call gas_update (kyear, kmon, kday, khour, lco2_chg, me, co2dat_file, co2gbl_file, ictm,& + call gas_update (kyear, kmon, kday, khour, lco2_chg, mpicomm, mpirank, mpiroot, co2dat_file, co2gbl_file, ictm,& ico2, errflg, errmsg ) if(errflg/=0) return if (ntoz == 0) then diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta index d9fe8359e..b69d66dc4 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta @@ -176,13 +176,27 @@ dimensions = (4) type = integer intent = in -[me] +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] standard_name = mpi_rank long_name = current MPI-rank units = index dimensions = () type = integer intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in [aeros_file] standard_name = aerosol_data_file long_name = aerosol data file @@ -325,13 +339,27 @@ dimensions = () type = logical intent = in -[me] +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] standard_name = mpi_rank long_name = current MPI-rank units = index dimensions = () type = integer intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in [aeros_file] standard_name = aerosol_data_file long_name = aerosol data file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 index 5ec068aaa..025e0f7d8 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 @@ -113,7 +113,8 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, ! Check initialization status if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_timestep_init called before GFS_time_vary_pre_init" + write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_timestep_init called & + &before GFS_time_vary_pre_init" errflg = 1 return end if @@ -133,11 +134,12 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, call w3difdat(jdat,idat,4,rinc8) sec = rinc8(4) else - write(errmsg,'(*(a))') "FATAL ERROR: Invalid w3kindreal or w3kindint:", w3kindreal, w3kindint + write(errmsg,'(a,2i4)') "FATAL ERROR: Invalid w3kindreal or w3kindint:", w3kindreal, w3kindint errflg = 1 return end if phour = sec/con_hr + !--- set current bucket hour zhour = phour fhour = (sec + dtp)/con_hr diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.F90 new file mode 100644 index 000000000..52ee21c68 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.F90 @@ -0,0 +1,207 @@ +!> \file GFS_time_vary_pre.neptune.F90 +!! Contains code related to GFS physics suite setup (generic part of time_vary_step) + + module GFS_time_vary_pre + + use funcphys, only: gfuncphys + + implicit none + + private + + public GFS_time_vary_pre_init, GFS_time_vary_pre_timestep_init, GFS_time_vary_pre_finalize + + logical :: is_initialized = .false. + + contains + +!>\defgroup gfs_time_vary_pre_mod GFS Time Vary Pre Module +!! This module contains code related to GFS physics suite setup. +!> @{ +!> \section arg_table_GFS_time_vary_pre_init Argument Table +!! \htmlinclude GFS_time_vary_pre_init.html +!! + subroutine GFS_time_vary_pre_init (errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + !--- Call gfuncphys (funcphys.f) to compute all physics function tables. + call gfuncphys () + + is_initialized = .true. + + end subroutine GFS_time_vary_pre_init + + +!> \section arg_table_GFS_time_vary_pre_finalize Argument Table +!! \htmlinclude GFS_time_vary_pre_finalize.html +!! + subroutine GFS_time_vary_pre_finalize(errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. is_initialized) return + + ! DH* this is the place to deallocate whatever is allocated by gfuncphys() in GFS_time_vary_pre_init + + is_initialized = .false. + + end subroutine GFS_time_vary_pre_finalize + + +!> \section arg_table_GFS_time_vary_pre_timestep_init Argument Table +!! \htmlinclude GFS_time_vary_pre_timestep_init.html +!! + subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & + nslwr, nhfrad, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, & + kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) + + use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec + + implicit none + + integer, intent(in) :: idate(:) + integer, intent(in) :: jdat(:), idat(:) + integer, intent(in) :: nsswr, nslwr, me, & + master, nscyc, nhfrad + logical, intent(in) :: debug + real(kind=kind_phys), intent(in) :: dtp + + integer, intent(out) :: kdt, yearlen, ipt + logical, intent(out) :: lprnt, lssav, lsswr, & + lslwr + real(kind=kind_phys), intent(out) :: sec, phour, zhour, & + fhour, julian, solhr + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_dbl_prec) :: rinc8(5) + + integer :: w3kindreal, w3kindint + integer :: iw3jdn + integer :: jd0, jd1 + real :: fjd + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check initialization status + if (.not.is_initialized) then + write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_timestep_init called & + &before GFS_time_vary_pre_init" + errflg = 1 + return + end if + + !--- jdat is being updated by the host model + !--- update calendars and triggers + call w3kind(w3kindreal, w3kindint) + !--- CCPP uses w3emc_d, therefore expecting the following values + if (w3kindreal == 8 .and. w3kindint==4) then + rinc8(1:5) = 0 + call w3difdat(jdat,idat,4,rinc8) + sec = rinc8(4) + else + write(errmsg,'(a,2i4)') "FATAL ERROR: Invalid w3kindreal or w3kindint:", w3kindreal, w3kindint + errflg = 1 + return + end if + phour = sec/con_hr + + !--- set current bucket hour + zhour = phour + fhour = (sec + dtp)/con_hr + kdt = nint((sec + dtp)/dtp) + + !GJF* These calculations were originally in GFS_physics_driver.F90 for + ! NoahMP. They were moved to this routine since they only depend + ! on time (not space). Note that this code is included as-is from + ! GFS_physics_driver.F90, but it may be simplified by using more + ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day + ! of year and W3DIFDAT to determine the integer number of days in + ! a given year). *GJF + ! Julian day calculation (fcst day of the year) + ! we need yearln and julian to + ! pass to noah mp sflx, idate is init, jdat is fcst;idate = jdat when kdt=1 + ! jdat is changing + ! + + jd1 = iw3jdn(jdat(1),jdat(2),jdat(3)) + jd0 = iw3jdn(jdat(1),1,1) + fjd = float(jdat(5))/24.0 + float(jdat(6))/1440.0 + + julian = float(jd1-jd0) + fjd + + ! + ! Year length + ! + ! what if the integration goes from one year to another? + ! iyr or jyr ? from 365 to 366 or from 366 to 365 + ! + ! is this against model's noleap yr assumption? + if (mod(jdat(1),4) == 0) then + yearlen = 366 + if (mod(jdat(1),100) == 0) then + yearlen = 365 + if (mod(jdat(1),400) == 0) then + yearlen = 366 + endif + endif + endif + + ipt = 1 + lprnt = .false. + lssav = .true. + + !--- radiation triggers + lsswr = (mod(kdt, nsswr) == 1) + lslwr = (mod(kdt, nslwr) == 1) + !--- allow for radiation to be called on every physics time step, if needed + if (nsswr == 1) lsswr = .true. + if (nslwr == 1) lslwr = .true. + !--- allow for radiation to be called on every physics time step + ! for the first nhfrad timesteps (for spinup, coldstarts only) + if (kdt <= nhfrad) then + lsswr = .true. + lslwr = .true. + end if + + !--- set the solar hour based on a combination of phour and time initial hour + solhr = mod(phour+idate(1),con_24) + + if ((debug) .and. (me == master)) then + print *,' sec ', sec + print *,' kdt ', kdt + print *,' nsswr ', nsswr + print *,' nslwr ', nslwr + print *,' nscyc ', nscyc + print *,' lsswr ', lsswr + print *,' lslwr ', lslwr + print *,' fhour ', fhour + print *,' phour ', phour + print *,' solhr ', solhr + endif + + end subroutine GFS_time_vary_pre_timestep_init +!> @} + end module GFS_time_vary_pre diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.meta new file mode 100644 index 000000000..bdf4ec8d5 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.neptune.meta @@ -0,0 +1,240 @@ +[ccpp-table-properties] + name = GFS_time_vary_pre + type = scheme + dependencies_path = ../../ + dependencies = tools/funcphys.f90,hooks/machine.F + +######################################################################## +[ccpp-arg-table] + name = GFS_time_vary_pre_init + 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 + +######################################################################## +[ccpp-arg-table] + name = GFS_time_vary_pre_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 + +######################################################################## +[ccpp-arg-table] + name = GFS_time_vary_pre_timestep_init + type = scheme +[jdat] + standard_name = date_and_time_of_forecast_in_united_states_order + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in +[idat] + standard_name = date_and_time_at_model_initialization_in_iso_order + long_name = initialization date and time + units = none + dimensions = (8) + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[nsswr] + standard_name = number_of_timesteps_between_shortwave_radiation_calls + long_name = number of timesteps between shortwave radiation calls + units = + dimensions = () + type = integer + intent = in +[nslwr] + standard_name = number_of_timesteps_between_longwave_radiation_calls + long_name = number of timesteps between longwave radiation calls + units = + dimensions = () + type = integer + intent = in +[nhfrad] + standard_name = number_of_timesteps_for_concurrent_radiation_and_remainder_physics_calls_after_model_initialization + long_name = number of timesteps for radiation calls on physics timestep (coldstarts only) + units = count + dimensions = () + type = integer + intent = in +[idate] + standard_name = date_and_time_at_model_initialization_in_united_states_order + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in +[debug] + standard_name = flag_for_debug_output + long_name = control flag for debug + units = flag + dimensions = () + type = logical + intent = in +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[nscyc] + standard_name = number_of_timesteps_between_surface_cycling_calls + long_name = number of timesteps between surface cycling calls + units = count + dimensions = () + type = integer + intent = in +[sec] + standard_name = forecast_time_in_seconds + long_name = seconds elapsed since model initialization + units = s + dimensions = () + type = real + kind = kind_phys + intent = out +[phour] + standard_name = forecast_time_on_previous_timestep + long_name = forecast time at the previous timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = out +[zhour] + standard_name = time_elapsed_since_diagnostics_reset + long_name = time since diagnostics variables have been zeroed + units = h + dimensions = () + type = real + kind = kind_phys + intent = out +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = out +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = out +[julian] + standard_name = forecast_julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = out +[yearlen] + standard_name = number_of_days_in_current_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = out +[ipt] + standard_name = index_of_horizontal_gridpoint_for_debug_output + long_name = horizontal index for point used for diagnostic printout + units = index + dimensions = () + type = integer + intent = out +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = out +[lssav] + standard_name = flag_for_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = out +[lsswr] + standard_name = flag_for_calling_shortwave_radiation + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = out +[lslwr] + standard_name = flag_for_calling_longwave_radiation + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = out +[solhr] + standard_name = forecast_utc_hour + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = out +[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_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 index c61f5836d..8e622e3a4 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 @@ -73,14 +73,14 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec implicit none - + integer, intent(in) :: idate(:) integer, intent(in) :: jdat(:), idat(:) integer, intent(in) :: nsswr, nslwr, me, & master, nscyc logical, intent(in) :: debug real(kind=kind_phys), intent(in) :: dtp - + integer, intent(out) :: kdt, yearlen, ipt logical, intent(out) :: lprnt, lssav, lsswr, & lslwr @@ -132,22 +132,23 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & call w3difdat(jdat,idat,4,rinc8) sec = rinc8(4) else - write(errmsg,'(*(a))') "FATAL ERROR: Invalid w3kindreal or w3kindint:", w3kindreal, w3kindint + write(errmsg,'(a,2i4)') "FATAL ERROR: Invalid w3kindreal or w3kindint:", w3kindreal, w3kindint errflg = 1 return end if phour = sec/con_hr + !--- set current bucket hour zhour = phour fhour = (sec + dtp)/con_hr kdt = nint((sec + dtp)/dtp) - - !GJF* These calculations were originally in GFS_physics_driver.F90 for - ! NoahMP. They were moved to this routine since they only depends - ! on time (not space). Note that this code is included as-is from - ! GFS_physics_driver.F90, but it may be simplified by using more - ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day - ! of year and W3DIFDAT to determine the integer number of days in + + !GJF* These calculations were originally in GFS_physics_driver.F90 for + ! NoahMP. They were moved to this routine since they only depend + ! on time (not space). Note that this code is included as-is from + ! GFS_physics_driver.F90, but it may be simplified by using more + ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day + ! of year and W3DIFDAT to determine the integer number of days in ! a given year). *GJF ! Julian day calculation (fcst day of the year) ! we need yearln and julian to @@ -160,7 +161,7 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & fjd = float(jdat(5))/24.0 + float(jdat(6))/1440.0 julian = float(jd1-jd0) + fjd - + ! ! Year length ! diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f index 01bef7dd3..05c6dc475 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.f @@ -1,7 +1,6 @@ !>\file cnvc90.f -!! This file contains the calculation of fraction of convective cloud, -!! pressure at bottom of convective cloud and at top of convective -!! cloud. +!! This module computes the convective cloud fraction, as well as +!! the pressure at the base and top of the convective cloud. module cnvc90 contains @@ -11,9 +10,6 @@ end subroutine cnvc90_init !>\defgroup GFS_cnvc90 GFS Convective Cloud Diagnostics Module !> @{ -!! This module contains the calculation of fraction of convective cloud, -!! pressure at bottom of convective cloud and at top of convective -!! cloud. !> \section arg_table_cnvc90_run Argument Table !! \htmlinclude cnvc90_run.html !! @@ -43,23 +39,23 @@ SUBROUTINE cnvc90_run(CLSTP,IM,RN,KBOT,KTOP,KM,PRSI, & ! Local variables integer :: i,ibot,itop,lc,lz,n,ncc - real(kind=kind_phys) :: ah,cc1,cc2,cvb0,p1,p2,rkbot,rktop,val + real(kind=kind_phys) :: ah,cc1,cc2,cvb0,p1,p2 integer :: NMD(IM) real(kind=kind_phys) :: PMD(IM) -! + real (kind=kind_phys), parameter :: cons_100=100.0 real(kind=kind_phys) :: R_KBOT_I, R_KTOP_I -! + PARAMETER(NCC=9) real(kind=kind_phys) :: CC(NCC),P(NCC) DATA CC/0.,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8/ DATA P/.14,.31,.70,1.6,3.4,7.7,17.,38.,85./ DATA CVB0/100./ -! + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 -! + LZ=0 LC=0 IF(CLSTP.GE.1000.) LZ=1 @@ -123,9 +119,6 @@ SUBROUTINE cnvc90_run(CLSTP,IM,RN,KBOT,KTOP,KM,PRSI, & ENDIF ENDDO ENDIF - RETURN END SUBROUTINE cnvc90_run !> @} - end module cnvc90 - diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta index bbf161eb5..56a8fb855 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.meta @@ -122,4 +122,3 @@ dimensions = () type = integer intent = out - diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 index b90b6fca7..6ede27fcd 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 @@ -7,6 +7,7 @@ !! IN and CCN data. module iccninterp + use mpi_f08 implicit none private @@ -16,51 +17,60 @@ module iccninterp contains !> - SUBROUTINE read_cidata (me, master) + SUBROUTINE read_cidata (mpicomm, mpirank, mpiroot) use machine, only: kind_phys + use mpiutil, only: ccpp_bcast use iccn_def use netcdf !--- in/out - integer, intent(in) :: me - integer, intent(in) :: master + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot !--- locals integer :: ncerr integer :: i, n, k, ncid, varid,j,it real(kind=kind_phys), allocatable, dimension(:) :: hyam,hybm real(kind=4), allocatable, dimension(:,:,:) :: ci_ps + integer :: ierr - allocate (hyam(kcipl), hybm(kcipl), ci_ps(lonscip,latscip,timeci)) allocate (ciplin(lonscip,latscip,kcipl,timeci)) allocate (ccnin(lonscip,latscip,kcipl,timeci)) allocate (ci_pres(lonscip,latscip,kcipl,timeci)) - ncerr = nf90_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid) - ncerr = nf90_inq_varid(ncid, "lat", varid) - ncerr = nf90_get_var(ncid, varid, ci_lat) - ncerr = nf90_inq_varid(ncid, "lon", varid) - ncerr = nf90_get_var(ncid, varid, ci_lon) - ncerr = nf90_inq_varid(ncid, "PS", varid) - ncerr = nf90_get_var(ncid, varid, ci_ps) - ncerr = nf90_inq_varid(ncid, "hyam", varid) - ncerr = nf90_get_var(ncid, varid, hyam) - ncerr = nf90_inq_varid(ncid, "hybm", varid) - ncerr = nf90_get_var(ncid, varid, hybm) - ncerr = nf90_inq_varid(ncid, "NAAI", varid) - ncerr = nf90_get_var(ncid, varid, ciplin) - do it = 1,timeci - do k=1, kcipl - ci_pres(:,:,k,it)=hyam(k)*1.e5+hybm(k)*ci_ps(:,:,it) + + read_and_broadcast: if (mpirank==mpiroot) then + allocate (hyam(kcipl), hybm(kcipl), ci_ps(lonscip,latscip,timeci)) + ncerr = nf90_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid) + ncerr = nf90_inq_varid(ncid, "lat", varid) + ncerr = nf90_get_var(ncid, varid, ci_lat) + ncerr = nf90_inq_varid(ncid, "lon", varid) + ncerr = nf90_get_var(ncid, varid, ci_lon) + ncerr = nf90_inq_varid(ncid, "PS", varid) + ncerr = nf90_get_var(ncid, varid, ci_ps) + ncerr = nf90_inq_varid(ncid, "hyam", varid) + ncerr = nf90_get_var(ncid, varid, hyam) + ncerr = nf90_inq_varid(ncid, "hybm", varid) + ncerr = nf90_get_var(ncid, varid, hybm) + ncerr = nf90_inq_varid(ncid, "NAAI", varid) + ncerr = nf90_get_var(ncid, varid, ciplin) + do it = 1,timeci + do k=1, kcipl + ci_pres(:,:,k,it)=hyam(k)*1.e5+hybm(k)*ci_ps(:,:,it) + end do end do - end do - ncerr = nf90_close(ncid) - ncerr = nf90_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) - ncerr = nf90_inq_varid(ncid, "NPCCN", varid) - ncerr = nf90_get_var(ncid, varid, ccnin) - ncerr = nf90_close(ncid) + ncerr = nf90_close(ncid) + ncerr = nf90_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) + ncerr = nf90_inq_varid(ncid, "NPCCN", varid) + ncerr = nf90_get_var(ncid, varid, ccnin) + ncerr = nf90_close(ncid) !--- - deallocate (hyam, hybm, ci_ps) - if (me == master) then + deallocate (hyam, hybm, ci_ps) write(*,*) 'Reading in ICCN data',ci_time - endif + endif read_and_broadcast + + call ccpp_bcast(ci_lat, mpiroot, mpicomm, ierr) + call ccpp_bcast(ci_lon, mpiroot, mpicomm, ierr) + call ccpp_bcast(ci_pres, mpiroot, mpicomm, ierr) + call ccpp_bcast(ciplin, mpiroot, mpicomm, ierr) + call ccpp_bcast(ccnin, mpiroot, mpicomm, ierr) END SUBROUTINE read_cidata ! diff --git a/physics/MP/Morrison_Gettelman/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 index 15963db7d..627931605 100644 --- a/physics/MP/Morrison_Gettelman/aerinterp.F90 +++ b/physics/MP/Morrison_Gettelman/aerinterp.F90 @@ -7,6 +7,7 @@ !! aerosol data for MG microphysics. module aerinterp + use mpi_f08 implicit none private read_netfaer, read_netfaer_dl, fdnx_fname @@ -36,13 +37,15 @@ logical function netcdf_check(status, errmsg, errflg, why) END function netcdf_check !!!!!!! - SUBROUTINE read_aerdata_dl (me, master, iflip, idate, FHOUR, errmsg, errflg) - use machine, only: kind_phys, kind_io4, kind_dbl_prec + SUBROUTINE read_aerdata_dl (mpicomm, mpirank, mpiroot, iflip, idate, fhour, errmsg, errflg) + use machine, only: kind_phys, kind_dbl_prec + use mpiutil, only: ccpp_bcast use aerclm_def use netcdf !--- in/out - integer, intent(in) :: me, master, iflip, idate(4) + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot, iflip, idate(4) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg real(kind=kind_phys), intent(in) :: fhour @@ -51,6 +54,7 @@ SUBROUTINE read_aerdata_dl (me, master, iflip, idate, FHOUR, errmsg, errflg) integer :: i, j, k, n, ii, imon, klev character :: fname*50, mn*2, vname*10, dy*2, myr*4 logical :: file_exist + integer :: ierr integer :: dimids(NF90_MAX_VAR_DIMS) integer :: dimlen(NF90_MAX_VAR_DIMS) integer IDAT(8),JDAT(8) @@ -63,13 +67,13 @@ SUBROUTINE read_aerdata_dl (me, master, iflip, idate, FHOUR, errmsg, errflg) ! !! =================================================================== - if (me == master) then + read_and_broadcast_1: if (mpirank==mpiroot) then if ( iflip == 0 ) then ! data from toa to sfc print *, "GFS is top-down" else print *, "GFS is bottom-up" endif - endif + !! found first day needed to interpolated IDAT = 0 IDAT(1) = IDATE(4) @@ -133,9 +137,13 @@ SUBROUTINE read_aerdata_dl (me, master, iflip, idate, FHOUR, errmsg, errflg) levsw = dimlen(3) tsaer = dimlen(4) - if(me==master) then - print *, 'MERRA2 dim: ',dimlen(1:ndims) - endif + print *, 'MERRA2 dim: ',dimlen(1:ndims) + endif read_and_broadcast_1 + + call ccpp_bcast(lonsaer, mpiroot, mpicomm, ierr) + call ccpp_bcast(latsaer, mpiroot, mpicomm, ierr) + call ccpp_bcast(levsw, mpiroot, mpicomm, ierr) + call ccpp_bcast(tsaer, mpiroot, mpicomm, ierr) ! allocate arrays @@ -146,6 +154,7 @@ SUBROUTINE read_aerdata_dl (me, master, iflip, idate, FHOUR, errmsg, errflg) endif ! construct lat/lon array + read_and_broadcast_2: if (mpirank==mpiroot) then varid = -1 if(.not.netcdf_check(nf90_inq_varid(ncid, 'lat', varid), & errmsg, errflg, 'find id of lat var')) then @@ -179,15 +188,21 @@ SUBROUTINE read_aerdata_dl (me, master, iflip, idate, FHOUR, errmsg, errflg) if(.not.netcdf_check(nf90_close(ncid), errmsg, errflg, 'close '//trim(fname))) then return endif + endif read_and_broadcast_2 + + call ccpp_bcast(aer_lat, mpiroot, mpicomm, ierr) + call ccpp_bcast(aer_lon, mpiroot, mpicomm, ierr) + call ccpp_bcast(aer_t, mpiroot, mpicomm, ierr) END SUBROUTINE read_aerdata_dl ! !********************************************************************** - SUBROUTINE read_aerdataf_dl ( me, master, iflip, idate, FHOUR, errmsg, errflg) + SUBROUTINE read_aerdataf_dl (mpicomm, mpirank, mpiroot, iflip, idate, fhour, errmsg, errflg) use machine, only: kind_phys, kind_dbl_prec use aerclm_def !--- in/out - integer, intent(in) :: me, master, iflip, idate(4) + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot, iflip, idate(4) character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg real(kind=kind_phys), intent(in) :: fhour @@ -242,20 +257,20 @@ SUBROUTINE read_aerdataf_dl ( me, master, iflip, idate, FHOUR, errmsg, errflg) enddo if(fd_upb) then t1sv = aer_t(j-1) - call read_netfaer_dl(fname_dl, j-1, iflip, 1, errmsg, errflg) - call read_netfaer_dl(fname_dl, n2sv, iflip, 2, errmsg, errflg) + call read_netfaer_dl(mpicomm, mpirank, mpiroot, fname_dl, j-1, iflip, 1, errmsg, errflg) + call read_netfaer_dl(mpicomm, mpirank, mpiroot, fname_dl, n2sv, iflip, 2, errmsg, errflg) else t1sv = aer_t(tsaer) - call read_netfaer_dl(fname_dl, tsaer, iflip, 1, errmsg, errflg) + call read_netfaer_dl(mpicomm, mpirank, mpiroot, fname_dl, tsaer, iflip, 1, errmsg, errflg) n2sv=1 t2sv=1440. call fdnx_fname (jdat(1), jdat(2),jdat(3),fname_dl) - call read_netfaer_dl(fname_dl, n2sv, iflip, 2, errmsg, errflg) + call read_netfaer_dl(mpicomm, mpirank, mpiroot, fname_dl, n2sv, iflip, 2, errmsg, errflg) end if END SUBROUTINE read_aerdataf_dl !********************************************************************** ! - SUBROUTINE aerinterpol_dl( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, & + SUBROUTINE aerinterpol_dl(mpicomm, mpirank, mpiroot,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, & ddy,iindx1,iindx2,ddx,lev,prsl,aerout, errmsg,errflg) ! use machine, only: kind_phys, kind_dbl_prec @@ -272,7 +287,9 @@ SUBROUTINE aerinterpol_dl( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx ! integer JINDX1(npts), JINDX2(npts), iINDX1(npts), iINDX2(npts) - integer me,idate(4), master, nthrds + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot + integer idate(4), nthrds integer IDAT(8),JDAT(8) ! real(kind=kind_phys) DDY(npts), ddx(npts),ttt @@ -302,7 +319,7 @@ SUBROUTINE aerinterpol_dl( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx ! rjday is the minutes in a day rjday = jdat(5)*60+jdat(6)+jdat(7)/60. if(rjday >= t2sv .or. jdat(3).ne.n1sv) then !!need to either to read in a record or open a new file - call read_netfaer_dl(fname_dl,n2sv, iflip, 1, errmsg, errflg) + call read_netfaer_dl(mpicomm, mpirank, mpiroot, fname_dl,n2sv, iflip, 1, errmsg, errflg) end if !! =================================================================== if(jdat(3).ne.n1sv) then ! a new day is produced from n2sv=1440 @@ -314,7 +331,7 @@ SUBROUTINE aerinterpol_dl( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx write(mn,'(i2.2)') jdat(2) write(dy,'(i2.2)') jdat(3) fname_dl="merra2_"//myr//mn//dy//".nc" - call read_netfaer_dl(fname_dl,n2sv, iflip, 2, errmsg, errflg) + call read_netfaer_dl(mpicomm, mpirank, mpiroot, fname_dl,n2sv, iflip, 2, errmsg, errflg) else if (rjday >= t2sv) then if(t2sv < aer_t(tsaer)) then n1sv=jdat(3) @@ -325,14 +342,14 @@ SUBROUTINE aerinterpol_dl( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx write(mn,'(i2.2)') jdat(2) write(dy,'(i2.2)') jdat(3) fname_dl="merra2_"//myr//mn//dy//".nc" - call read_netfaer_dl(fname_dl,n2sv, iflip, 2, errmsg, errflg) + call read_netfaer_dl(mpicomm, mpirank, mpiroot, fname_dl,n2sv, iflip, 2, errmsg, errflg) else !! need to read a new file n1sv=jdat(3) t1sv=aer_t(tsaer) n2sv=1 t2sv=1440. call fdnx_fname (jdat(1), jdat(2),jdat(3),fname_dl) - call read_netfaer_dl(fname_dl, n2sv, iflip, 2, errmsg, errflg) + call read_netfaer_dl(mpicomm, mpirank, mpiroot, fname_dl, n2sv, iflip, 2, errmsg, errflg) end if end if ! @@ -422,13 +439,15 @@ SUBROUTINE aerinterpol_dl( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx RETURN END SUBROUTINE aerinterpol_dl - SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) - use machine, only: kind_phys, kind_io4 + SUBROUTINE read_aerdata (mpicomm, mpirank, mpiroot, iflip, idate, errmsg, errflg) + use machine, only: kind_phys + use mpiutil, only: ccpp_bcast use aerclm_def use netcdf !--- in/out - integer, intent(in) :: me, master, iflip, idate(4) + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot, iflip, idate(4) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -437,6 +456,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) integer :: i, j, k, n, ii, imon, klev character :: fname*50, myr*4, mn*2, dy*2,vname*10 logical :: file_exist + integer :: ierr integer :: dimids(NF90_MAX_VAR_DIMS) integer :: dimlen(NF90_MAX_VAR_DIMS) @@ -445,13 +465,12 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) ! !! =================================================================== - if (me == master) then + read_and_broadcast_1: if (mpirank==mpiroot) then if ( iflip == 0 ) then ! data from toa to sfc print *, "GFS is top-down" else print *, "GFS is bottom-up" endif - endif ! !! =================================================================== !! check if one file exist @@ -500,9 +519,12 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) latsaer = dimlen(2) levsw = dimlen(3) - if(me==master) then - print *, 'MERRA2 dim: ',dimlen(1:ndims) - endif + print *, 'MERRA2 dim: ',dimlen(1:ndims) + endif read_and_broadcast_1 + + call ccpp_bcast(lonsaer, mpiroot, mpicomm, ierr) + call ccpp_bcast(latsaer, mpiroot, mpicomm, ierr) + call ccpp_bcast(levsw, mpiroot, mpicomm, ierr) ! allocate arrays @@ -512,6 +534,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) endif ! construct lat/lon array + read_and_broadcast_2: if (mpirank==mpiroot) then varid = -1 if(.not.netcdf_check(nf90_inq_varid(ncid, 'lat', varid), & errmsg, errflg, 'find id of lat var')) then @@ -535,15 +558,20 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) if(.not.netcdf_check(nf90_close(ncid), errmsg, errflg, 'close '//trim(fname))) then return endif + endif read_and_broadcast_2 + + call ccpp_bcast(aer_lat, mpiroot, mpicomm, ierr) + call ccpp_bcast(aer_lon, mpiroot, mpicomm, ierr) END SUBROUTINE read_aerdata ! !********************************************************************** - SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) + SUBROUTINE read_aerdataf (mpicomm, mpirank, mpiroot, iflip, idate, FHOUR, errmsg, errflg) use machine, only: kind_phys, kind_dbl_prec use aerclm_def !--- in/out - integer, intent(in) :: me, master, iflip, idate(4) + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot, iflip, idate(4) character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg real(kind=kind_phys), intent(in) :: fhour @@ -590,9 +618,9 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) n1 = n2 - 1 if (n2 > 12) n2 = n2 -12 !! =================================================================== - call read_netfaer(n1, iflip, 1, errmsg, errflg) + call read_netfaer(mpicomm, mpirank, mpiroot, n1, iflip, 1, errmsg, errflg) if(errflg/=0) return - call read_netfaer(n2, iflip, 2, errmsg, errflg) + call read_netfaer(mpicomm, mpirank, mpiroot, n2, iflip, 2, errmsg, errflg) if(errflg/=0) return !! =================================================================== n1sv=n1 @@ -601,7 +629,7 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) END SUBROUTINE read_aerdataf ! SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & - iindx1,iindx2,ddx,me,master) + iindx1,iindx2,ddx) ! USE MACHINE, ONLY: kind_phys use aerclm_def, only: aer_lat, jaero=>latsaer, & @@ -609,7 +637,6 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & ! implicit none ! - integer me, master integer npts, JINDX1(npts),JINDX2(npts),IINDX1(npts),IINDX2(npts) real(kind=kind_phys) dlat(npts),DDY(npts),dlon(npts),DDX(npts) ! @@ -658,7 +685,8 @@ END SUBROUTINE setindxaer !********************************************************************** !********************************************************************** ! - SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, & + SUBROUTINE aerinterpol(mpicomm,mpirank,mpiroot,nthrds,npts, & + IDATE,FHOUR,iflip, jindx1,jindx2, & ddy,iindx1,iindx2,ddx,lev,prsl,aerout, errmsg,errflg) ! use machine, only: kind_phys, kind_dbl_prec @@ -675,7 +703,9 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, ! integer JINDX1(npts), JINDX2(npts), iINDX1(npts), iINDX2(npts) - integer me,idate(4), master, nthrds + type(MPI_Comm), intent(in) :: mpicomm + integer mpirank, mpiroot + integer idate(4), nthrds integer IDAT(8),JDAT(8) ! real(kind=kind_phys) DDY(npts), ddx(npts),ttt @@ -716,12 +746,12 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, ! need to read a new month if (n1.ne.n1sv) then #ifdef DEBUG - if (me == master) write(*,*)"read in a new month MERRA2", n2 + if (mpirank==mpiroot) write(*,*)"read in a new month MERRA2", n2 #endif !! =================================================================== - call read_netfaer(n1, iflip, 1, errmsg, errflg) + call read_netfaer(mpicomm, mpirank, mpiroot, n1, iflip, 1, errmsg, errflg) if(errflg/=0) return - call read_netfaer(n2, iflip, 2, errmsg, errflg) + call read_netfaer(mpicomm, mpirank, mpiroot, n2, iflip, 2, errmsg, errflg) if(errflg/=0) return !! =================================================================== n1sv=n1 @@ -853,11 +883,13 @@ subroutine fdnx_fname(lyear, lmn, ldy, fname) RETURN END SUBROUTINE fdnx_fname -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine read_netfaer_dl(fname, nf, iflip,nt, errmsg,errflg) + subroutine read_netfaer_dl(mpicomm, mpirank, mpiroot, fname, nf, iflip, nt, errmsg, errflg) use machine, only: kind_phys, kind_io4 + use mpiutil, only: ccpp_bcast use aerclm_def use netcdf + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot integer, intent(in) :: iflip, nf, nt character,intent(in) :: fname*50 integer, intent(out) :: errflg @@ -868,6 +900,7 @@ subroutine read_netfaer_dl(fname, nf, iflip,nt, errmsg,errflg) real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp integer lstart(4), lcount(4) + integer ierr !! =================================================================== allocate (buff(lonsaer, latsaer, levsw)) @@ -958,14 +991,19 @@ subroutine read_netfaer_dl(fname, nf, iflip,nt, errmsg,errflg) if(.not.netcdf_check(nf90_close(ncid), errmsg, errflg, 'close '//trim(fname))) then return endif + deallocate (buff, pres_tmp) deallocate (buffx) + END SUBROUTINE read_netfaer_dl !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine read_netfaer(nf, iflip,nt, errmsg,errflg) + subroutine read_netfaer(mpicomm, mpirank, mpiroot, nf, iflip, nt, errmsg, errflg) use machine, only: kind_phys, kind_io4 + use mpiutil, only: ccpp_bcast use aerclm_def use netcdf + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot integer, intent(in) :: iflip, nf, nt integer, intent(out) :: errflg character(*), intent(out) :: errmsg @@ -974,6 +1012,7 @@ subroutine read_netfaer(nf, iflip,nt, errmsg,errflg) real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp + integer :: ierr !! =================================================================== allocate (buff(lonsaer, latsaer, levsw)) @@ -1067,6 +1106,7 @@ subroutine read_netfaer(nf, iflip,nt, errmsg,errflg) endif deallocate (buff, pres_tmp) deallocate (buffx) + END SUBROUTINE read_netfaer end module aerinterp diff --git a/physics/MP/TEMPO/mp_tempo.meta b/physics/MP/TEMPO/mp_tempo.meta index 4750d5ef7..c4e192cc6 100644 --- a/physics/MP/TEMPO/mp_tempo.meta +++ b/physics/MP/TEMPO/mp_tempo.meta @@ -91,7 +91,7 @@ kind = kind_phys intent = in [con_avgd] - standard_name = avogadro_consant + standard_name = avogadro_constant long_name = Avogadro constant units = mol-1 dimensions = () diff --git a/physics/MP/Thompson/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta index 1a2dde8f1..a45db00c4 100644 --- a/physics/MP/Thompson/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -88,7 +88,7 @@ kind = kind_phys intent = in [con_avgd] - standard_name = avogadro_consant + standard_name = avogadro_constant long_name = Avogadro constant units = mol-1 dimensions = () diff --git a/physics/Radiation/RRTMG/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 index 57bebd88f..1b309a530 100644 --- a/physics/Radiation/RRTMG/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -7751,6 +7751,6 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & end subroutine cldprmc !> @} -!........................................!$ - end module rrtmg_lw !$ -!========================================!$ +!........................................! + end module rrtmg_lw ! +!========================================! diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 index ea4d28d0e..950dfaee4 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 @@ -48,7 +48,7 @@ module rrtmgp_lw_cloud_optics ! ###################################################################################### !> subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, & - nrghice, mpicomm, mpirank, mpiroot1, errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, is_initialized, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -61,13 +61,14 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm !< MPI communicator integer, intent(in) :: & mpirank, & !< Current MPI rank - mpiroot1 !< Master MPI rank - integer :: mpiroot + mpiroot !< Master MPI rank ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_initialized !< Initialization flag + character(len=*), intent( out) :: & errmsg !< Error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< Error code ! Local variables @@ -78,7 +79,8 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, errmsg = '' errflg = 0 - mpiroot = 0 + if (is_initialized) return + ! Filenames are set in the physics_nml lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) @@ -242,6 +244,8 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, lut_exticeLW, lut_ssaiceLW, lut_asyiceLW)) call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) - + + is_initialized = .true. + end subroutine rrtmgp_lw_cloud_optics_init end module rrtmgp_lw_cloud_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 index f8cbc5d5e..511d4116f 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 @@ -72,7 +72,7 @@ module rrtmgp_lw_gas_optics !> subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, & - active_gases_array, mpicomm, mpirank, mpiroot1, errmsg, errflg) + active_gases_array, mpicomm, mpirank, mpiroot, is_initialized, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -84,13 +84,14 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm !< MPI communicator integer,intent(in) :: & mpirank, & !< Current MPI rank - mpiroot1 !< Master MPI rank - integer :: mpiroot + mpiroot !< Master MPI rank ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_initialized !< Initialization flag. + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Local variables @@ -103,7 +104,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, errmsg = '' errflg = 0 - mpiroot = 0 + if (is_initialized) return + ! Filenames are set in the physics_nml lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) @@ -461,7 +463,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, scaling_gas_lowerLW, scaling_gas_upperLW, scale_by_complement_lowerLW, & scale_by_complement_upperLW, kminor_start_lowerLW, kminor_start_upperLW, totplnkLW,& planck_fracLW, rayl_lowerLW, rayl_upperLW, optimal_angle_fitLW)) - + + is_initialized = .true. + end subroutine rrtmgp_lw_gas_optics_init end module rrtmgp_lw_gas_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 index 7f86c6ca3..ee295535d 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 @@ -31,7 +31,7 @@ module rrtmgp_lw_main !! subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_file_clouds,& active_gases_array, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & - errmsg, errflg) + is_init_gas_optics, is_init_cloud_optics, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -53,9 +53,12 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi nLay ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_init_gas_optics, & !< Initialization flag + is_init_cloud_optics !< Initialization flag + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Initialize CCPP error handling variables @@ -64,11 +67,11 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi ! RRTMGP longwave gas-optics (k-distribution) initialization call rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, & - active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) + active_gases_array, mpicomm, mpirank, mpiroot, is_init_gas_optics, errmsg, errflg) ! RRTMGP longwave cloud-optics initialization call rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, & - nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, is_init_cloud_optics, errmsg, errflg) end subroutine rrtmgp_lw_main_init diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta index 9c7807c59..26f2ca833 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta @@ -88,6 +88,20 @@ type = character kind = len=* intent = in +[is_init_gas_optics] + standard_name = flag_for_rrmtgp_lw_gas_optics_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout +[is_init_cloud_optics] + standard_name = flag_for_rrmtgp_lw_cloud_optics_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 index 122478831..56c599f9c 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 @@ -45,7 +45,7 @@ module rrtmgp_sw_cloud_optics ! ###################################################################################### !> subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, & - nrghice, mpicomm, mpirank, mpiroot1, errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, is_initialized, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -57,13 +57,14 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm !< MPI communicator integer, intent(in) :: & mpirank, & !< Current MPI rank - mpiroot1 !< Master MPI rank - integer :: mpiroot + mpiroot !< Master MPI rank ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_initialized !< Initialization flag + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Local variables @@ -74,7 +75,8 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, errmsg = '' errflg = 0 - mpiroot = 0 + if (is_initialized) return + ! Filenames are set in the physics_nml sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) @@ -253,5 +255,7 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) + is_initialized = .true. + end subroutine rrtmgp_sw_cloud_optics_init end module rrtmgp_sw_cloud_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 index 2d2e3a124..fb1787241 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 @@ -83,7 +83,7 @@ module rrtmgp_sw_gas_optics !! the full k-distribution data is read in, reduced by the "active gases" provided, and !! loaded into the RRTMGP DDT, ty_gas_optics_rrtmgp. subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, & - active_gases_array, mpicomm, mpirank, mpiroot1, errmsg, errflg) + active_gases_array, mpicomm, mpirank, mpiroot, is_initialized, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -95,13 +95,14 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpicomm !< MPI communicator integer,intent(in) :: & mpirank, & !< Current MPI rank - mpiroot1 !< Master MPI rank - integer :: mpiroot + mpiroot !< Master MPI rank ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_initialized !< Initialization flag. + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Local variables @@ -114,7 +115,8 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, errmsg = '' errflg = 0 - mpiroot = 0 + if (is_initialized) return + ! Filenames are set in the gfphysics_nml sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas) @@ -511,6 +513,8 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, solar_quietSW, solar_facularSW, solar_sunspotSW, tsi_defaultSW, mg_defaultSW, & sb_defaultSW, rayl_lowerSW, rayl_upperSW)) + is_initialized = .true. + end subroutine rrtmgp_sw_gas_optics_init end module rrtmgp_sw_gas_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 index 4ce051fe1..b083546f3 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 @@ -31,7 +31,7 @@ module rrtmgp_sw_main !! subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_file_clouds,& active_gases_array, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & - errmsg, errflg) + is_init_gas_optics, is_init_cloud_optics, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -50,9 +50,12 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi rrtmgp_phys_blksz, & !< Number of horizontal points to process at once. nLay ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_init_gas_optics, & !< Initialization flag + is_init_cloud_optics !< Initialization flag + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Initialize CCPP error handling variables @@ -61,11 +64,11 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi ! RRTMGP shortwave gas-optics (k-distribution) initialization call rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, active_gases_array,& - mpicomm, mpirank, mpiroot, errmsg, errflg) + mpicomm, mpirank, mpiroot, is_init_gas_optics, errmsg, errflg) ! RRTMGP shortwave cloud-optics initialization call rrtmgp_sw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_clouds, & - nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, is_init_cloud_optics, errmsg, errflg) end subroutine rrtmgp_sw_main_init diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta index a0935d84c..8c382cb1e 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta @@ -87,6 +87,20 @@ type = character kind = len=* intent = in +[is_init_gas_optics] + standard_name = flag_for_rrmtgp_sw_gas_optics_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout +[is_init_cloud_optics] + standard_name = flag_for_rrmtgp_sw_cloud_optics_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/radiation_aerosols.f b/physics/Radiation/radiation_aerosols.f index ce5054c99..7448a1933 100644 --- a/physics/Radiation/radiation_aerosols.f +++ b/physics/Radiation/radiation_aerosols.f @@ -126,6 +126,8 @@ !! radiation computations. module module_radiation_aerosols ! + use mpi_f08 + use mpiutil, only: ccpp_bcast use machine, only : kind_phys, kind_io4, kind_io8 use module_iounitdef, only : NIAERCM use module_radsw_parameters, only : NBDSW, wvnsw1=>wvnum1, & @@ -493,7 +495,8 @@ module module_radiation_aerosols !>\section gen_al General Algorithm !----------------------------------- subroutine aer_init & - & ( NLAY, me, iaermdl, iaerflg, lalw1bd, aeros_file, con_pi, & + & ( NLAY, mpicomm, mpirank, mpiroot, & + & iaermdl, iaerflg, lalw1bd, aeros_file, con_pi, & & con_t0c, con_c, con_boltz, con_plnk, errflg, errmsg) ! ================================================================== ! @@ -538,7 +541,9 @@ subroutine aer_init & ! ================================================================== ! ! --- inputs: - integer, intent(in) :: NLAY, me, iaermdl, iaerflg + integer, intent(in) :: NLAY, mpirank, mpiroot + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: iaermdl, iaerflg logical, intent(in) :: lalw1bd character(len=26),intent(in) :: aeros_file real(kind_phys), intent(in) :: con_pi,con_t0c, con_c, con_boltz, & @@ -569,7 +574,7 @@ subroutine aer_init & !> -# Call wrt_aerlog to write aerosol parameter configuration to output logs. - if ( me == 0 ) then + if ( mpirank == mpiroot ) then call wrt_aerlog(iaermdl, iaerflg, lalw1bd, errflg, errmsg) ! write aerosol param info to log file ! --- inputs: (in scope variables) @@ -635,7 +640,7 @@ subroutine aer_init & if ( iaermdl==0 .or. iaermdl==5 ) then ! opac-climatology scheme call clim_aerinit & ! --- inputs: - & ( solfwv, eirfwv, me, aeros_file, & + & ( solfwv, eirfwv, mpicomm, mpirank, mpiroot, aeros_file, & ! --- outputs: & errflg, errmsg) if(errflg/=0) return @@ -644,13 +649,13 @@ subroutine aer_init & call gocart_aerinit & ! --- inputs: - & ( solfwv, eirfwv, me, & + & ( solfwv, eirfwv, mpirank, & ! --- outputs: & errflg, errmsg) if(errflg/=0) return else - if ( me == 0 ) then + if ( mpirank == mpiroot ) then print *,' !!! ERROR in aerosol model scheme selection', & & ' iaermdl =',iaermdl errflg = 1 @@ -959,7 +964,7 @@ end subroutine aer_init !! !!\section gen_clim_aerinit General Algorithm subroutine clim_aerinit & - & ( solfwv, eirfwv, me, aeros_file, & ! --- inputs + & ( solfwv, eirfwv, mpicomm, mpirank, mpiroot, aeros_file, & ! --- inputs & errflg, errmsg) ! --- outputs ! ================================================================== ! @@ -1002,7 +1007,8 @@ subroutine clim_aerinit & ! --- inputs: real (kind=kind_phys), dimension(:) :: solfwv ! one wvn sol flux real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux - integer, intent(in) :: me + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot character(len=26), intent(in) :: aeros_file ! --- output: (CCPP error handling) integer, intent(out) :: errflg @@ -1032,7 +1038,8 @@ subroutine clim_aerinit & ! --- ... invoke tropospheric aerosol initialization !> - call set_aercoef() to invoke tropospheric aerosol initialization. - call set_aercoef(aeros_file, errflg, errmsg) + call set_aercoef(mpicomm, mpirank, mpiroot, & + & aeros_file, errflg, errmsg) ! --- inputs: (in-scope variables, module constants) ! --- outputs: (module variables) @@ -1046,7 +1053,8 @@ subroutine clim_aerinit & !! corresponding SW radiation spectral bands. !!\section det_set_aercoef General Algorithm !-------------------------------- - subroutine set_aercoef(aeros_file,errflg, errmsg) + subroutine set_aercoef(mpicomm, mpirank, mpiroot, & + & aeros_file,errflg, errmsg) !................................ ! --- inputs: (in-scope variables, module constants) ! --- outputs: (CCPP error handling) @@ -1125,7 +1133,8 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) ! ! ! ================================================================== ! ! -! --- inputs: ( none ) + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot character(len=26),intent(in) :: aeros_file ! --- output: (CCPP error handling) integer, intent(out) :: errflg @@ -1140,6 +1149,7 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) logical :: file_exist character :: cline*80 + integer :: ierr ! !===> ... begin here ! @@ -1151,32 +1161,37 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) !> -# Reading climatological aerosols optical data from aeros_file, !! including: - inquire (file=aeros_file, exist=file_exist) + if (mpirank==mpiroot) then + inquire (file=aeros_file, exist=file_exist) - if ( file_exist ) then - close (NIAERCM) - open (unit=NIAERCM,file=aeros_file,status='OLD', & - & action='read',form='FORMATTED') - rewind (NIAERCM) - else - errflg = 1 - errmsg = 'ERROR(set_aercoef): Requested aerosol data file '// & - & aeros_file//' not found' - return - endif ! end if_file_exist_block + if ( file_exist ) then + close (NIAERCM) + open (unit=NIAERCM,file=aeros_file,status='OLD', & + & action='read',form='FORMATTED') + rewind (NIAERCM) + else + print *,' Requested aerosol data file "',aeros_file, & + & '" not found!' + print *,' *** Stopped in subroutine aero_init !!' + errflg = 1 + errmsg = 'ERROR(set_aercoef): Requested aerosol data file '// & + & aeros_file//' not found' + return + endif ! end if_file_exist_block ! --- ... skip monthly global distribution - do m = 1, 12 - read (NIAERCM,12) cline - 12 format(a80/) - - do j = 1, JMXAE - do i = 1, IMXAE - read(NIAERCM,*) id + do m = 1, 12 + read (NIAERCM,12) cline + 12 format(a80/) + + do j = 1, JMXAE + do i = 1, IMXAE + read(NIAERCM,*) id + enddo enddo - enddo - enddo ! end do_m_block + enddo ! end do_m_block + endif ! --- ... aloocate and input aerosol optical data @@ -1201,60 +1216,76 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) extstra = f_zero endif + if (mpirank==mpiroot) then !> - ending wave num for 61 aerosol spectral bands - read(NIAERCM,21) cline - 21 format(a80) - read(NIAERCM,22) iendwv(:) - 22 format(13i6) + read(NIAERCM,21) cline + 21 format(a80) + read(NIAERCM,22) iendwv(:) + 22 format(13i6) !> - atmos scale height for 5 domains, 7 profs - read(NIAERCM,21) cline - read(NIAERCM,24) haer(:,:) - 24 format(20f4.1) + read(NIAERCM,21) cline + read(NIAERCM,24) haer(:,:) + 24 format(20f4.1) !> - reference pressure for 5 domains, 7 profs - read(NIAERCM,21) cline - read(NIAERCM,26) prsref(:,:) - 26 format(10f7.2) + read(NIAERCM,21) cline + read(NIAERCM,26) prsref(:,:) + 26 format(10f7.2) !> - rh independent ext coef for 61 bands, 6 species - read(NIAERCM,21) cline - read(NIAERCM,28) rhidext0(:,:) - 28 format(8e10.3) + read(NIAERCM,21) cline + read(NIAERCM,28) rhidext0(:,:) + 28 format(8e10.3) !> - rh independent sca coef for 61 bands, 6 species - read(NIAERCM,21) cline - read(NIAERCM,28) rhidsca0(:,:) + read(NIAERCM,21) cline + read(NIAERCM,28) rhidsca0(:,:) !> - rh independent ssa coef for 61 bands, 6 species - read(NIAERCM,21) cline - read(NIAERCM,28) rhidssa0(:,:) + read(NIAERCM,21) cline + read(NIAERCM,28) rhidssa0(:,:) !> - rh independent asy coef for 61 bands, 6 species - read(NIAERCM,21) cline - read(NIAERCM,28) rhidasy0(:,:) + read(NIAERCM,21) cline + read(NIAERCM,28) rhidasy0(:,:) !> - rh dependent ext coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline - read(NIAERCM,28) rhdpext0(:,:,:) + read(NIAERCM,21) cline + read(NIAERCM,28) rhdpext0(:,:,:) !> - rh dependent sca coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline - read(NIAERCM,28) rhdpsca0(:,:,:) + read(NIAERCM,21) cline + read(NIAERCM,28) rhdpsca0(:,:,:) !> - rh dependent ssa coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline - read(NIAERCM,28) rhdpssa0(:,:,:) + read(NIAERCM,21) cline + read(NIAERCM,28) rhdpssa0(:,:,:) !> - rh dependent asy coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline - read(NIAERCM,28) rhdpasy0(:,:,:) + read(NIAERCM,21) cline + read(NIAERCM,28) rhdpasy0(:,:,:) !> - stratospheric background aeros for 61 bands - read(NIAERCM,21) cline - read(NIAERCM,28) straext0(:) + read(NIAERCM,21) cline + read(NIAERCM,28) straext0(:) - close (NIAERCM) + close (NIAERCM) + endif + + ! Broadcast data + call ccpp_bcast(iendwv, mpiroot, mpicomm, ierr) + call ccpp_bcast(haer, mpiroot, mpicomm, ierr) + call ccpp_bcast(prsref, mpiroot, mpicomm, ierr) + call ccpp_bcast(rhidext0, mpiroot, mpicomm, ierr) + call ccpp_bcast(rhidsca0, mpiroot, mpicomm, ierr) + call ccpp_bcast(rhidssa0, mpiroot, mpicomm, ierr) + call ccpp_bcast(rhidasy0, mpiroot, mpicomm, ierr) + call ccpp_bcast(rhdpext0, mpiroot, mpicomm, ierr) + call ccpp_bcast(rhdpsca0, mpiroot, mpicomm, ierr) + call ccpp_bcast(rhdpssa0, mpiroot, mpicomm, ierr) + call ccpp_bcast(rhdpasy0, mpiroot, mpicomm, ierr) + call ccpp_bcast(straext0, mpiroot, mpicomm, ierr) !> -# Convert pressure reference level (in mb) to sigma reference level !! assume an 1000mb reference surface pressure. @@ -1773,7 +1804,8 @@ end subroutine clim_aerinit !>\section gen_aer_upd General Algorithm !----------------------------------- subroutine aer_update & - & ( iyear, imon, me, iaermdl, aeros_file, errflg, errmsg ) + & ( iyear, imon, mpicomm, mpirank, mpiroot, & + & iaermdl, aeros_file, errflg, errmsg ) ! ================================================================== ! ! ! @@ -1803,7 +1835,9 @@ subroutine aer_update & ! ================================================================== ! ! --- inputs: - integer, intent(in) :: iyear, imon, me, iaermdl + integer, intent(in) :: iyear, imon, mpirank, mpiroot + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: iaermdl character(len=26),intent(in) :: aeros_file ! --- output: (CCPP error-handling) integer, intent(out) :: errflg @@ -1829,15 +1863,16 @@ subroutine aer_update & if ( lalwflg .or. laswflg ) then if ( iaermdl == 0 .or. iaermdl==5 ) then ! opac-climatology scheme - call trop_update(aeros_file, errflg, errmsg) - if(errflg/=0) return + call trop_update(mpicomm, mpirank, mpiroot, aeros_file, & + & errflg, errmsg) + if(errflg/=0) return endif endif !> -# Call volc_update() to update yearly stratospheric volcanic aerosol data. if ( lavoflg ) then - call volc_update(errflg, errmsg) + call volc_update(mpicomm, mpirank, mpiroot, errflg, errmsg) endif @@ -1848,7 +1883,8 @@ subroutine aer_update & !> This subroutine updates the monthly global distribution of aerosol !! profiles in five degree horizontal resolution. !-------------------------------- - subroutine trop_update(aeros_file, errflg, errmsg) + subroutine trop_update(mpicomm, mpirank, mpiroot, aeros_file, & + & errflg, errmsg) ! ================================================================== ! ! ! @@ -1885,6 +1921,8 @@ subroutine trop_update(aeros_file, errflg, errmsg) ! ! ! ================================================================== ! + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot ! --- inputs: (CCPP Interstitials) character(len=26),intent(in) :: aeros_file ! --- output: (CCPP error handling) @@ -1900,6 +1938,7 @@ subroutine trop_update(aeros_file, errflg, errmsg) logical :: file_exist character :: cline*80, ctyp*3 + integer :: ierr ! !===> ... begin here ! @@ -1910,23 +1949,26 @@ subroutine trop_update(aeros_file, errflg, errmsg) ! --- ... reading climatological aerosols data - inquire (file=aeros_file, exist=file_exist) - - if ( file_exist ) then - close(NIAERCM) - open (unit=NIAERCM,file=aeros_file,status='OLD', & + if ( mpirank==mpiroot ) then + inquire (file=aeros_file, exist=file_exist) + + if ( file_exist ) then + close(NIAERCM) + open (unit=NIAERCM,file=aeros_file,status='OLD', & & action='read',form='FORMATTED') - rewind (NIAERCM) + rewind (NIAERCM) - if ( me == 0 ) then print *,' Opened aerosol data file: ',aeros_file - endif - else - errflg = 1 - errmsg = 'ERROR(trop_update):Requested aerosol data file '// & - & aeros_file // ' not found.' - return - endif ! end if_file_exist_block + else + print *,' Requested aerosol data file "',aeros_file, & + & '" not found!' + print *,' *** Stopped in subroutine trop_update !!' + errflg = 1 + errmsg = 'ERROR(trop_update):Requested aerosol data file '// & + & aeros_file // ' not found.' + return + endif ! end if_file_exist_block + endif !$omp parallel do private(i,j,m) do j = 1, JMXAE @@ -1946,54 +1988,61 @@ subroutine trop_update(aeros_file, errflg, errmsg) enddo enddo + read_and_broadcast: if (mpirank==mpiroot) then ! --- ... loop over 12 month global distribution - Lab_do_12mon : do m = 1, 12 + Lab_do_12mon : do m = 1, 12 - read(NIAERCM,12) cline - 12 format(a80/) + read(NIAERCM,12) cline + 12 format(a80/) - if ( m /= imon ) then -! if ( me == 0 ) print *,' *** Skipped ',cline + if ( m /= imon ) then +! if ( me == 0 ) print *,' *** Skipped ',cline - do j = 1, JMXAE - do i = 1, IMXAE - read(NIAERCM,*) id + do j = 1, JMXAE + do i = 1, IMXAE + read(NIAERCM,*) id + enddo enddo - enddo - else - if ( me == 0 ) print *,' --- Reading ',cline - - do j = 1, JMXAE - do i = 1, IMXAE - read(NIAERCM,14) (idxc(k),cmix(k),k=1,NXC),kprf,denn,nc, & - & ctyp - 14 format(5(i2,e11.4),i2,f8.2,i3,1x,a3) - - kprfg(i,j) = kprf - denng(1,i,j) = denn ! num density of 1st layer - if ( kprf >= 6 ) then - denng(2,i,j) = cmix(NXC) ! num density of 2dn layer - else - denng(2,i,j) = f_zero - endif + else + if ( mpirank==mpiroot ) print *,' --- Reading ',cline + + do j = 1, JMXAE + do i = 1, IMXAE + read(NIAERCM,14) (idxc(k),cmix(k),k=1,NXC),kprf,denn,nc,& + & ctyp + 14 format(5(i2,e11.4),i2,f8.2,i3,1x,a3) + + kprfg(i,j) = kprf + denng(1,i,j) = denn ! num density of 1st layer + if ( kprf >= 6 ) then + denng(2,i,j) = cmix(NXC) ! num density of 2dn layer + else + denng(2,i,j) = f_zero + endif - tem = f_one - do k = 1, NXC-1 - idxcg(k,i,j) = idxc(k) ! component index - cmixg(k,i,j) = cmix(k) ! component mixing ratio - tem = tem - cmix(k) + tem = f_one + do k = 1, NXC-1 + idxcg(k,i,j) = idxc(k) ! component index + cmixg(k,i,j) = cmix(k) ! component mixing ratio + tem = tem - cmix(k) + enddo + idxcg(NXC,i,j) = idxc(NXC) + cmixg(NXC,i,j) = tem ! to make sure all add to 1. enddo - idxcg(NXC,i,j) = idxc(NXC) - cmixg(NXC,i,j) = tem ! to make sure all add to 1. enddo - enddo - close (NIAERCM) - exit Lab_do_12mon - endif ! end if_m_block + close (NIAERCM) + exit Lab_do_12mon + endif ! end if_m_block + + enddo Lab_do_12mon + endif read_and_broadcast - enddo Lab_do_12mon + call ccpp_bcast(kprfg, mpiroot, mpicomm, ierr) + call ccpp_bcast(denng, mpiroot, mpicomm, ierr) + call ccpp_bcast(idxcg, mpiroot, mpicomm, ierr) + call ccpp_bcast(cmixg, mpiroot, mpicomm, ierr) ! -- check print @@ -2016,7 +2065,7 @@ end subroutine trop_update !> This subroutine searches historical volcanic data sets to find and !! read in monthly 45-degree lat-zone band of optical depth. !-------------------------------- - subroutine volc_update(errflg, errmsg) + subroutine volc_update(mpicomm, mpirank, mpiroot, errflg, errmsg) !................................ ! --- inputs: (in scope variables, module variables) ! --- outputs: (CCPP error handling) @@ -2055,6 +2104,8 @@ subroutine volc_update(errflg, errmsg) ! --- inputs: (in-scope variables, module constants) ! integer :: iyear, imon, me, NIAERCM + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot ! --- output: (module variables) ! integer :: ivolae(:,:,:), kyrstr, kyrend, kyrsav, kmonsav @@ -2068,6 +2119,7 @@ subroutine volc_update(errflg, errmsg) character :: cline*80, volcano_file*32 data volcano_file / 'volcanic_aerosols_1850-1859.txt ' / + integer :: ierr ! !===> ... begin here ! @@ -2095,49 +2147,54 @@ subroutine volc_update(errflg, errmsg) ! allocate ( ivolae(12,4,10) ) ! for 12-mon,4-lat_zone,10-year ! endif ivolae(:,:,:) = 1 ! set as lowest value - if ( me == 0 ) then + if ( mpirank==mpiroot ) then print *,' Request volcanic date out of range,', & & ' optical depth set to lowest value' endif else write(volcano_file(19:27),60) kyrstr,kyrend 60 format(i4.4,'-',i4.4) + read_and_broadcast: if (mpirank==mpiroot) then + inquire (file=volcano_file, exist=file_exist) + if ( file_exist ) then + close(NIAERCM) + open (unit=NIAERCM,file=volcano_file,status='OLD', & + & action='read',form='FORMATTED') - inquire (file=volcano_file, exist=file_exist) - if ( file_exist ) then - close(NIAERCM) - open (unit=NIAERCM,file=volcano_file,status='OLD', & - & action='read',form='FORMATTED') - - read(NIAERCM,62) cline - 62 format(a80) + read(NIAERCM,62) cline + 62 format(a80) ! --- check print - if ( me == 0 ) then print *,' Opened volcanic data file: ',volcano_file print *, cline - endif - do k = 1, 10 - do j = 1, 4 - read(NIAERCM,64) (ivolae(i,j,k),i=1,12) - 64 format(12i5) + do k = 1, 10 + do j = 1, 4 + read(NIAERCM,64) (ivolae(i,j,k),i=1,12) + 64 format(12i5) + enddo enddo - enddo - - close (NIAERCM) - else - errflg = 1 - errmsg = 'ERROR(volc_update): Requested volcanic data '// & - & 'file '//volcano_file//' not found!' - return - endif ! end if_file_exist_block + close (NIAERCM) + else + print *,' Requested volcanic data file "', & + & volcano_file,'" not found!' + print *,' *** Stopped in subroutine VOLC_AERINIT !!' + errflg = 1 + errmsg = 'ERROR(volc_update): Requested volcanic data '// & + & 'file '//volcano_file//' not found!' + return + endif ! end if_file_exist_block + endif read_and_broadcast + ! Prevent warnings for potentially unused variables + file_exist = .true. + cline = '' + call ccpp_bcast(ivolae, mpiroot, mpicomm, ierr) endif ! end if_iyear_block endif ! end if_kyrstr_block ! --- check print - if ( me == 0 ) then + if ( mpirank==mpiroot ) then k = mod(kyrsav,10) + 1 print *,' CHECK: Sample Volcanic data used for month, year:', & & imon, iyear @@ -3592,6 +3649,10 @@ subroutine gocart_aerinit & ! ! --- ... invoke gocart aerosol initialization + ! DH* This will need to be implemented by a host model + ! that actually uses this data + print *, 'NOTE: gocart aerosol initialization is reading input ', & + & 'data with all MPI ranks' if (KCM /= ntrcaerm ) then print *, 'ERROR in # of gocart aer species',KCM diff --git a/physics/Radiation/radiation_astronomy.f b/physics/Radiation/radiation_astronomy.f index 90ed7cd45..73b775898 100644 --- a/physics/Radiation/radiation_astronomy.f +++ b/physics/Radiation/radiation_astronomy.f @@ -88,6 +88,8 @@ !> This module sets up astronomy quantities for solar radiation calculations. module module_radiation_astronomy ! + use mpi_f08 + use mpiutil, only : ccpp_bcast use machine, only : kind_phys use module_iounitdef, only : NIRADSF ! @@ -145,7 +147,8 @@ module module_radiation_astronomy !!\param me print message control flag !>\section sol_init_gen sol_init General Algorithm subroutine sol_init & - & ( me, isolar, solar_file, con_solr, con_solr_old, con_pi ) ! --- inputs + & ( mpicomm, mpirank, mpiroot, & + & isolar, solar_file, con_solr, con_solr_old, con_pi ) ! --- inputs ! --- outputs: ( none ) ! =================================================================== ! @@ -180,18 +183,21 @@ subroutine sol_init & implicit none ! --- input: - integer, intent(in) :: me, isolar + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot + integer, intent(in) :: isolar character(len=26), intent(in) :: solar_file real(kind=kind_phys), intent(in) :: con_solr, con_solr_old, con_pi ! --- output: ( none ) ! --- local: logical :: file_exist + integer :: ierr integer :: imonth ! !===> ... begin here ! - if ( me == 0 ) print *, VTAGAST !print out version tag + if (mpirank==mpiroot) print *, VTAGAST !print out version tag degrad = 180.0/con_pi tpi = 2.0 * con_pi @@ -210,26 +216,29 @@ subroutine sol_init & if ( isolar == 0 ) then solc0 = con_solr_old - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' - Using old fixed solar constant =', solc0 endif elseif ( isolar == 10 ) then - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' - Using new fixed solar constant =', solc0 endif elseif ( isolar == 1 ) then ! noaa ann-mean tsi in absolute scale solar_fname(15:26) = 'noaa_a0.txt' - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' - Using NOAA annual mean TSI table in ABS scale', & & ' with cycle approximation (old values)!' endif - inquire (file=solar_fname, exist=file_exist) + if ( mpirank == mpiroot ) then + inquire (file=solar_fname, exist=file_exist) + endif + call ccpp_bcast(file_exist, mpiroot, mpicomm, ierr) if ( .not. file_exist ) then isolflg = 10 - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' Requested solar data file "',solar_fname, & & '" not found!' print *,' Using the default solar constant value =',solc0,& @@ -239,16 +248,19 @@ subroutine sol_init & elseif ( isolar == 2 ) then ! noaa ann-mean tsi in tim scale solar_fname(15:26) = 'noaa_an.txt' - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' - Using NOAA annual mean TSI table in TIM scale', & & ' with cycle approximation (new values)!' endif - inquire (file=solar_fname, exist=file_exist) + if ( mpirank == mpiroot ) then + inquire (file=solar_fname, exist=file_exist) + endif + call ccpp_bcast(file_exist, mpiroot, mpicomm, ierr) if ( .not. file_exist ) then isolflg = 10 - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' Requested solar data file "',solar_fname, & & '" not found!' print *,' Using the default solar constant value =',solc0,& @@ -258,16 +270,19 @@ subroutine sol_init & elseif ( isolar == 3 ) then ! cmip5 ann-mean tsi in tim scale solar_fname(15:26) = 'cmip_an.txt' - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' - Using CMIP5 annual mean TSI table in TIM scale', & & ' with cycle approximation' endif - inquire (file=solar_fname, exist=file_exist) + if ( mpirank == mpiroot ) then + inquire (file=solar_fname, exist=file_exist) + endif + call ccpp_bcast(file_exist, mpiroot, mpicomm, ierr) if ( .not. file_exist ) then isolflg = 10 - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' Requested solar data file "',solar_fname, & & '" not found!' print *,' Using the default solar constant value =',solc0,& @@ -277,16 +292,19 @@ subroutine sol_init & elseif ( isolar == 4 ) then ! cmip5 mon-mean tsi in tim scale solar_fname(15:26) = 'cmip_mn.txt' - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' - Using CMIP5 monthly mean TSI table in TIM scale', & & ' with cycle approximation' endif - inquire (file=solar_fname, exist=file_exist) + if ( mpirank == mpiroot ) then + inquire (file=solar_fname, exist=file_exist) + endif + call ccpp_bcast(file_exist, mpiroot, mpicomm, ierr) if ( .not. file_exist ) then isolflg = 10 - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' Requested solar data file "',solar_fname, & & '" not found!' print *,' Using the default solar constant value =',solc0,& @@ -296,7 +314,7 @@ subroutine sol_init & else ! selection error isolflg = 10 - if ( me == 0 ) then + if (mpirank==mpiroot) then print *,' - !!! ERROR in selection of solar constant data', & & ' source, ISOL =',isolar print *,' Using the default solar constant value =',solc0, & @@ -325,7 +343,8 @@ end subroutine sol_init !>\section gen_sol_update sol_update General Algorithm !----------------------------------- subroutine sol_update & - & ( jdate,kyear,deltsw,deltim,lsol_chg, me, & ! --- inputs + & ( jdate,kyear,deltsw,deltim,lsol_chg, & ! --- inputs + & mpicomm,mpirank,mpiroot, & ! --- inputs & slag, sdec, cdec, solcon, con_pi, errmsg, errflg & ! --- outputs & ) @@ -380,7 +399,9 @@ subroutine sol_update & implicit none ! --- input: - integer, intent(in) :: jdate(:), kyear, me + integer, intent(in) :: jdate(:), kyear + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot logical, intent(in) :: lsol_chg real (kind=kind_phys), intent(in) :: deltsw, deltim, con_pi @@ -404,6 +425,7 @@ subroutine sol_update & logical :: file_exist character :: cline*60 + integer :: ierr ! !===> ... begin here ! @@ -427,17 +449,18 @@ subroutine sol_update & endif else ! need to read in new data iyr_sav = iyear - + iyr = iyear + if (mpirank == mpiroot) then ! --- ... check to see if the solar constant data file existed + inquire (file=solar_fname, exist=file_exist) + if ( .not. file_exist ) then + print *,' !!! ERROR! Can not find solar constant file!!!' + errflg = 1 + errmsg = "ERROR(radiation_astronomy): solar constant file"& + & // " not found" + return - inquire (file=solar_fname, exist=file_exist) - if ( .not. file_exist ) then - errflg = 1 - errmsg = "ERROR(radiation_astronomy): solar constant file"//& - & " not found" - return - else - iyr = iyear + endif close(NIRADSF) open (NIRADSF,file=solar_fname,form='formatted', & @@ -447,12 +470,21 @@ subroutine sol_update & read (NIRADSF, * ) iyr1,iyr2,icy1,icy2,smean,cline(1:60) ! read (NIRADSF, 24) iyr1,iyr2,icy1,icy2,smean,cline ! 24 format(4i5,f8.2,a60) + + print *,' Updating solar constant with cycle approx' + print *,' Opened solar constant data file: ',solar_fname +!check print *, iyr1, iyr2, icy1, icy2, smean, cline + endif - if ( me == 0 ) then - print *,' Updating solar constant with cycle approx' - print *,' Opened solar constant data file: ',solar_fname -!check print *, iyr1, iyr2, icy1, icy2, smean, cline - endif + ! Prevent warnings for potentially uninitialized data + file_exist = .true. + cline = '' + + call ccpp_bcast(iyr1, mpiroot, mpicomm, ierr) + call ccpp_bcast(iyr2, mpiroot, mpicomm, ierr) + call ccpp_bcast(icy1, mpiroot, mpicomm, ierr) + call ccpp_bcast(icy2, mpiroot, mpicomm, ierr) + call ccpp_bcast(smean, mpiroot, mpicomm, ierr) ! --- ... check if there is a upper year limit put on the data table @@ -495,7 +527,7 @@ subroutine sol_update & iyr = iyr + icy enddo Lab_dowhile1 - if ( me == 0 ) then + if ( mpirank == mpiroot ) then print *,' *** Year',iyear,' out of table range!', & & iyr1, iyr2 print *,' Using the closest-cycle year (',iyr,')' @@ -506,7 +538,7 @@ subroutine sol_update & iyr = iyr - icy enddo Lab_dowhile2 - if ( me == 0 ) then + if ( mpirank == mpiroot ) then print *,' *** Year',iyear,' out of table range!', & & iyr1, iyr2 print *,' Using the closest-cycle year (',iyr,')' @@ -520,12 +552,16 @@ subroutine sol_update & Lab_dowhile3 : do while ( i >= iyr1 ) ! read (NIRADSF,26) jyr, solc1 ! 26 format(i4,f10.4) - read (NIRADSF,*) jyr, solc1 + if (mpirank == mpiroot) then + read (NIRADSF,*) jyr, solc1 + end if + call ccpp_bcast(jyr, mpiroot, mpicomm, ierr) + call ccpp_bcast(solc1, mpiroot, mpicomm, ierr) if ( i == iyr .and. iyr == jyr ) then solc0 = smean + solc1 - if (me == 0) then + if (mpirank == mpiroot) then print *,' CHECK: Solar constant data used for year',& & iyr, solc1, solc0 endif @@ -540,7 +576,11 @@ subroutine sol_update & Lab_dowhile4 : do while ( i >= iyr1 ) ! read (NIRADSF,26) jyr, smon(:) ! 26 format(i4,12f10.4) - read (NIRADSF,*) jyr, smon(1:12) + if (mpirank == mpiroot) then + read (NIRADSF,*) jyr, smon(1:12) + end if + call ccpp_bcast(jyr, mpiroot, mpicomm, ierr) + call ccpp_bcast(smon, mpiroot, mpicomm, ierr) if ( i == iyr .and. iyr == jyr ) then do nn = 1, 12 @@ -548,7 +588,7 @@ subroutine sol_update & enddo solc0 = smean + smon(imon) - if (me == 0) then + if (mpirank == mpiroot) then print *,' CHECK: Solar constant data used for year',& & iyr,' and month',imon endif @@ -560,8 +600,7 @@ subroutine sol_update & enddo Lab_dowhile4 endif ! end if_isolflg_block - close ( NIRADSF ) - endif ! end if_file_exist_block + if (mpirank==mpiroot) close ( NIRADSF ) endif ! end if_iyr_sav_block endif ! end if_lsol_chg_block @@ -604,7 +643,7 @@ subroutine sol_update & ! --- ... diagnostic print out - if (me == 0) then + if (mpirank == mpiroot) then !> -# Call prtime() call prtime & @@ -632,7 +671,7 @@ subroutine sol_update & nstp = max(6, nswr) anginc = pid12 * dtswh / float(nstp) - if ( me == 0 ) then + if ( mpirank == mpiroot ) then print *,' for cosz calculations: nswr,deltim,deltsw,dtswh =', & & nswr,deltim,deltsw,dtswh,' anginc,nstp =',anginc,nstp endif diff --git a/physics/Radiation/radiation_gases.f b/physics/Radiation/radiation_gases.f index 784e8917e..5e73fabd1 100644 --- a/physics/Radiation/radiation_gases.f +++ b/physics/Radiation/radiation_gases.f @@ -1,7 +1,7 @@ !> \file radiation_gases.f -!! This file contains routines that set up gas profiles, such as co2, -!! ch4, n2o, o2, and those of cfc gases. All data are entered as mixing -!! ratio by volume +!! This file contains routines that set up gas profiles, such as co2, +!! ch4, n2o, o2, and those of cfc gases. All data are entered as +!! mixing ratio by volume ! ========================================================== !!!!! ! 'module_radiation_gases' description !!!!! @@ -87,20 +87,26 @@ !> \defgroup module_radiation_gases_mod Radiation Gases Module !> @{ !> This module sets up constant gas profiles, such as co2, ch4, n2o, o2, -!! and those of cfc gases. All data are entered as mixing ratio by volume. -!!\image html rad_gas_AGGI.png "Figure 1: Atmospheric radiative forcing, relative to 1750, by long-lived greenhouse gases and the 2016 update of the NOAA Annual Greenhouse Gas Index (AGGI)" +!! and those of cfc gases. All data are entered as mixing ratio by +!! volume. +!! \image html rad_gas_AGGI.png "Figure 1: Atmospheric radiative +!! forcing, relative to 1750, by long-lived greenhouse gases and the +!! 2016 update of the NOAA Annual Greenhouse Gas Index (AGGI)" !! NOAA Annual Greenhouse Gas Index (AGGI) shows that from 1990 to 2016, -!! radiative forcing by long-lived greenhouse gases (LLGHGs) increased by -!! 40%, with \f$CO_2\f$ accounting for about 80% of this increase(WMO -!! Greenhouse Gas Bulletin (2017) \cite wmo_greenhouse_gas_bulletin_2017). +!! radiative forcing by long-lived greenhouse gases (LLGHGs) increased +!! by 40%, with \f$CO_2\f$ accounting for about 80% of this increase +!! (WMO Greenhouse Gas Bulletin (2017) +!! \cite wmo_greenhouse_gas_bulletin_2017). !! !! Operational GFS selection for gas distribution: !!\n CO2 Distribution (namelist control parameter -\b ICO2=2): -!!\n ICO2=0: use prescribed global annual mean value (currently = 380 ppmv) +!!\n ICO2=0: use prescribed global annual mean value (currently=380ppmv) !!\n ICO2=1: use observed global annual mean value -!!\n ICO2=2: use observed monthly 2-d data table in \f$15^o\f$ horizontal resolution +!!\n ICO2=2: use observed monthly 2-d data table in \f$15^o\f$ +!! horizontal resolution !! -!! Trace Gases (currently using the global mean climatology in unit of ppmv): +!! Trace Gases (currently using the global mean climatology in unit of +!! ppmv): !! \f$CH_4-1.50\times10^{-6}\f$; !! \f$N_2O-0.31\times10^{-6}\f$; !! \f$O_2-0.209\f$; @@ -112,9 +118,11 @@ !! !!\version NCEP-Radiation_gases v5.1 Nov 2012 -!> This module sets up constant gas rofiles, such as co2, ch4, n2o, o2, and those -!! of cfc gases. +!> This module sets up constant gas rofiles, such as co2, ch4, n2o, o2, +!! and those of cfc gases. module module_radiation_gases + use mpi_f08 + use mpiutil, only: ccpp_bcast use machine, only : kind_phys, kind_io4 use funcphys, only : fpkapx use module_iounitdef, only : NIO3CLM, NICO2CN @@ -124,39 +132,50 @@ module module_radiation_gases private ! --- version tag and last revision date - character(40), parameter :: & + character(40), parameter :: & VTAGGAS='NCEP-Radiation_gases v5.1 Nov 2012 ' ! & VTAGGAS='NCEP-Radiation_gases v5.0 Aug 2012 ' - integer, parameter, public :: NF_VGAS = 10 ! number of gas species - integer, parameter :: IMXCO2 = 24 ! input CO2 data longitude points - integer, parameter :: JMXCO2 = 12 ! input CO2 data latitude points - integer, parameter :: MINYEAR = 1957 ! earlist year 2D CO2 data available - - real (kind=kind_phys), parameter :: resco2=15.0 ! horizontal resolution in degree - real (kind=kind_phys), parameter :: prsco2=788.0 ! pressure limitation for 2D CO2 (mb) - real (kind=kind_phys) :: raddeg ! rad->deg conversion - real (kind=kind_phys) :: hfpi ! half of pi - - real (kind=kind_phys), parameter :: co2vmr_def = 350.0e-6 ! parameter constant for CO2 volume mixing ratio - real (kind=kind_phys), parameter :: n2ovmr_def = 0.31e-6 ! parameter constant for N2O volume mixing ratio - real (kind=kind_phys), parameter :: ch4vmr_def = 1.50e-6 ! parameter constant for CH4 volume mixing ratio - real (kind=kind_phys), parameter :: o2vmr_def = 0.209 ! parameter constant for O2 volume mixing ratio - real (kind=kind_phys), parameter :: covmr_def = 1.50e-8 ! parameter constant for CO colume mixing ratio -! aer 2003 value + ! number of gas species + integer, parameter, public :: NF_VGAS = 10 + ! input CO2 data longitude points + integer, parameter :: IMXCO2 = 24 + ! input CO2 data latitude points + integer, parameter :: JMXCO2 = 12 + ! earlist year 2D CO2 data available + integer, parameter :: MINYEAR = 1957 + + ! horizontal resolution in degree + real (kind=kind_phys), parameter :: resco2=15.0 + ! pressure limitation for 2D CO2 (mb) + real (kind=kind_phys), parameter :: prsco2=788.0 + real (kind=kind_phys) :: raddeg ! rad->deg conversion + real (kind=kind_phys) :: hfpi ! half of pi + + ! parameter constant for CO2 volume mixing ratio + real (kind=kind_phys), parameter :: co2vmr_def = 350.0e-6 + ! parameter constant for N2O volume mixing ratio + real (kind=kind_phys), parameter :: n2ovmr_def = 0.31e-6 + ! parameter constant for CH4 volume mixing ratio + real (kind=kind_phys), parameter :: ch4vmr_def = 1.50e-6 + ! parameter constant for O2 volume mixing ratio + real (kind=kind_phys), parameter :: o2vmr_def = 0.209 + ! parameter constant for CO colume mixing ratio + real (kind=kind_phys), parameter :: covmr_def = 1.50e-8 + ! aer 2003 value real (kind=kind_phys), parameter :: f11vmr_def = 3.520e-10 -! aer 2003 value + ! aer 2003 value real (kind=kind_phys), parameter :: f12vmr_def = 6.358e-10 -! aer 2003 value + ! aer 2003 value real (kind=kind_phys), parameter :: f22vmr_def = 1.500e-10 -! aer 2003 value + ! aer 2003 value real (kind=kind_phys), parameter :: cl4vmr_def = 1.397e-10 -! gfdl 1999 value + ! gfdl 1999 value real (kind=kind_phys), parameter :: f113vmr_def= 8.2000e-11 -! --- module variables to be set in subroutin gas_init and/or gas_update +! - module variables to be set in subroutine gas_init and/or gas_update -! arrays for co2 2-d monthly data and global mean values from observed data +! arrays for co2 2-d mon. data and global mean values from observed data real (kind=kind_phys), allocatable :: co2vmr_sav(:,:,:) real (kind=kind_phys), allocatable :: co2cyc_sav(:,:,:) @@ -188,50 +207,53 @@ module module_radiation_gases !!\param errmsg error message !>\section gas_init_gen gas_init General Algorithm !----------------------------------- - subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & + subroutine gas_init( mpicomm, mpirank, mpiroot, co2usr_file, + & co2cyc_file, ico2flg, & ictmflg, con_pi, errflg, errmsg) -! =================================================================== ! -! ! -! gas_init sets up co2, etc. parameters. ! -! ! -! inputs: ! -! me - print message control flag ! -! ico2flg - co2 data source control flag ! -! =0: use prescribed co2 global mean value ! -! =1: use input global mean co2 value (co2_glb) ! -! =2: use input 2-d monthly co2 value (co2vmr_sav) ! -! ictmflg - =yyyy#, data ic time/date control flag ! -! =-2: same as 0, but superimpose seasonal cycle ! -! from climatology data set. ! -! =-1: use user provided external data for the fcst ! -! time, no extrapolation. ! -! =0: use data at initial cond time, if not existed ! -! then use latest, without extrapolation. ! -! =1: use data at the forecast time, if not existed ! -! then use latest and extrapolate to fcst time. ! -! =yyyy0: use yyyy data for the forecast time, no ! -! further data extrapolation. ! -! =yyyy1: use yyyy data for the fcst. if needed, do ! -! extrapolation to match the fcst time. ! -! co2usr_file - external co2 user defined data table ! -! co2cyc_file - external co2 climotology monthly cycle data table ! -! con_pi - physical constant Pi ! -! ! -! outputs: (CCPP error handling) ! -! errflg - error flag ! -! errmsg - error message ! -! ! -! usage: call gas_init ! -! ! -! subprograms called: none ! -! ! -! =================================================================== ! +! =================================================================== ! +! ! +! gas_init sets up co2, etc. parameters. ! +! ! +! inputs: ! +! me - print message control flag ! +! ico2flg - co2 data source control flag ! +! =0: use prescribed co2 global mean value ! +! =1: use input global mean co2 value (co2_glb) ! +! =2: use input 2-d monthly co2 value (co2vmr_sav) ! +! ictmflg - =yyyy#, data ic time/date control flag ! +! =-2: same as 0, but superimpose seasonal cycle ! +! from climatology data set. ! +! =-1: use user provided external data for the fcst ! +! time, no extrapolation. ! +! =0: use data at initial cond time, if not existed ! +! then use latest, without extrapolation. ! +! =1: use data at the forecast time, if not existed ! +! then use latest and extrapolate to fcst time. ! +! =yyyy0: use yyyy data for the forecast time, no ! +! further data extrapolation. ! +! =yyyy1: use yyyy data for the fcst. if needed, do ! +! extrapolation to match the fcst time. ! +! co2usr_file - external co2 user defined data table ! +! co2cyc_file - external co2 climotology monthly cycle data table ! +! con_pi - physical constant Pi ! +! ! +! outputs: (CCPP error handling) ! +! errflg - error flag ! +! errmsg - error message ! +! ! +! usage: call gas_init ! +! ! +! subprograms called: none ! +! ! +! =================================================================== ! ! implicit none ! --- inputs: - integer, intent(in) :: me, ictmflg, ico2flg + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot + integer, intent(in) :: ictmflg, ico2flg character(len=26),intent(in) :: co2usr_file,co2cyc_file real(kind=kind_phys), intent(in) :: con_pi @@ -247,6 +269,7 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & logical :: file_exist, lextpl character :: cline*100, cform*8 data cform / '(24f7.2)' / !! data format in IMXCO2*f7.2 + integer :: ierr ! !===> ... begin here ! @@ -259,7 +282,7 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & raddeg = 180.0/con_pi hfpi = 0.5*con_pi - if ( me == 0 ) print *, VTAGGAS ! print out version tag + if ( mpirank==mpiroot ) print *, VTAGGAS ! print out version tag kyrsav = 0 kmonsav = 1 @@ -270,80 +293,82 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & lab_ico2 : if ( ico2flg == 0 ) then - if ( me == 0 ) then - print *,' - Using prescribed co2 global mean value=', & + if ( mpirank==mpiroot ) then + print *,' - Using prescribed co2 global mean value=', & co2vmr_def endif else lab_ico2 - lab_ictm : if ( ictmflg == -1 ) then ! input user provided data + lab_ictm : if ( ictmflg == -1 ) then ! input user provided data - inquire (file=co2usr_file, exist=file_exist) - if ( .not. file_exist ) then - errflg = 1 - errmsg = 'ERROR(gas_init): Cannot find user CO2 data file'//& - & ': '//co2usr_file - return - else - close (NICO2CN) - open(NICO2CN,file=co2usr_file,form='formatted',status='old') - rewind NICO2CN - read (NICO2CN, 25) iyr, cline, co2g1, co2g2 - 25 format(i4,a94,f7.2,16x,f5.2) - co2_glb = co2g1 * 1.0e-6 + read_and_broadcast_co2_v1: if ( mpirank==mpiroot ) then + inquire (file=co2usr_file, exist=file_exist) + if ( .not. file_exist ) then + print *,' Can not find user CO2 data file: ',co2usr_file + errflg = 1 + errmsg = 'ERROR(gas_init): Cannot find user CO2 data file' + return + else + close (NICO2CN) + open(NICO2CN,file=co2usr_file,form='formatted', + & status='old') + rewind NICO2CN + read (NICO2CN, 25) iyr, cline, co2g1, co2g2 + 25 format(i4,a94,f7.2,16x,f5.2) + co2_glb = co2g1 * 1.0e-6 - if ( ico2flg == 1 ) then - if ( me == 0 ) then - print *,' - Using co2 global annual mean value from', & - & ' user provided data set:',co2usr_file + if ( ico2flg == 1 ) then + print *,' - Using co2 global annual mean value from', + & ' user provided data set:',co2usr_file print *, iyr,cline(1:94),co2g1,' GROWTH RATE =', co2g2 - endif - elseif ( ico2flg == 2 ) then - allocate ( co2vmr_sav(IMXCO2,JMXCO2,12) ) + elseif ( ico2flg == 2 ) then + allocate ( co2vmr_sav(IMXCO2,JMXCO2,12) ) - do imo = 1, 12 - read (NICO2CN,cform) co2dat -!check print cform, co2dat + do imo = 1, 12 + read (NICO2CN,cform) co2dat +!check print cform, co2dat - do j = 1, JMXCO2 - do i = 1, IMXCO2 - co2vmr_sav(i,j,imo) = co2dat(i,j) * 1.0e-6 + do j = 1, JMXCO2 + do i = 1, IMXCO2 + co2vmr_sav(i,j,imo) = co2dat(i,j) * 1.0e-6 + enddo enddo enddo - enddo - if ( me == 0 ) then - print *,' - Using co2 monthly 2-d data from user', & - & ' provided data set:',co2usr_file - print *, iyr,cline(1:94),co2g1,' GROWTH RATE =', co2g2 + print *,' - Using co2 monthly 2-d data from user', + & ' provided data set:',co2usr_file + print *, iyr,cline(1:94),co2g1,' GROWTH RATE =', co2g2 print *,' CHECK: Sample of selected months of CO2 data' do imo = 1, 12, 3 print *,' Month =',imo print *, (co2vmr_sav(1,j,imo),j=1,jmxco2) enddo - endif - else - print *,' ICO2=',ico2flg,' is not a valid selection' - errflg = 1 - errmsg = 'ERROR(gas_init): ICO2 is not a valid selection' - return - endif ! endif_ico2flg_block + else + print *,' ICO2=',ico2flg,' is not a valid selection' + errflg = 1 + errmsg = 'ERROR(gas_init): ICO2 is not valid' + return + endif ! endif_ico2flg_block - close (NICO2CN) - endif ! endif_file_exist_block + close (NICO2CN) + endif ! endif_file_exist_block + else + if ( ico2flg == 2 ) then + allocate ( co2vmr_sav(IMXCO2,JMXCO2,12) ) + endif + endif read_and_broadcast_co2_v1 - else lab_ictm ! input from observed data + else lab_ictm ! input from observed data if ( ico2flg == 1 ) then - if ( me == 0 ) then + if ( mpirank==mpiroot ) then print *,' - Using observed co2 global annual mean value' - endiF + endif elseif ( ico2flg == 2 ) then allocate ( co2vmr_sav(IMXCO2,JMXCO2,12) ) - - if ( me == 0 ) then + if ( mpirank==mpiroot ) then print *,' - Using observed co2 monthly 2-d data' endif else @@ -354,52 +379,66 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & endif if ( ictmflg == -2 ) then - inquire (file=co2cyc_file, exist=file_exist) - if ( .not. file_exist ) then - errflg = 1 - errmsg = 'ERROR(gas_init): Cannot find seasonal cycle '// & - & 'CO2 data file: '//co2cyc_file - return - else - allocate( co2cyc_sav(IMXCO2,JMXCO2,12) ) + read_and_broadcast_co2_v2: if ( mpirank==mpiroot ) then + inquire (file=co2cyc_file, exist=file_exist) + if ( .not. file_exist ) then + print *,' Can not find seasonal cycle CO2 data: ', + & co2cyc_file + errflg = 1 + errmsg = 'ERROR(gas_init): Can not find seasonal cycle ' + & // 'CO2 data' + return + else + allocate( co2cyc_sav(IMXCO2,JMXCO2,12) ) ! --- ... read in co2 2-d seasonal cycle data - close (NICO2CN) - open (NICO2CN,file=co2cyc_file,form='formatted', & - & status='old') - rewind NICO2CN - read (NICO2CN, 35) cline, co2g1, co2g2 - 35 format(a98,f7.2,16x,f5.2) - read (NICO2CN,cform) co2dat ! skip annual mean part + close (NICO2CN) + open (NICO2CN,file=co2cyc_file,form='formatted', + & status='old') + rewind NICO2CN + read (NICO2CN, 35) cline, co2g1, co2g2 + 35 format(a98,f7.2,16x,f5.2) + read (NICO2CN,cform) co2dat ! skip annual mean part - if ( me == 0 ) then print *,' - Superimpose seasonal cycle to mean CO2 data' - print *,' Opened CO2 climatology seasonal cycle data',& + print *,' Opened CO2 climatology seasonal cycle data', & ' file: ',co2cyc_file !check print *, cline(1:98), co2g1, co2g2 - endif - do imo = 1, 12 - read (NICO2CN,45) cline, gco2cyc(imo) - 45 format(a58,f7.2) -!check print *, cline(1:58),gco2cyc(imo) - gco2cyc(imo) = gco2cyc(imo) * 1.0e-6 - - read (NICO2CN,cform) co2dat -!check print cform, co2dat - do j = 1, JMXCO2 - do i = 1, IMXCO2 - co2cyc_sav(i,j,imo) = co2dat(i,j) * 1.0e-6 + do imo = 1, 12 + read (NICO2CN,45) cline, gco2cyc(imo) + 45 format(a58,f7.2) +!check print *, cline(1:58),gco2cyc(imo) + gco2cyc(imo) = gco2cyc(imo) * 1.0e-6 + + read (NICO2CN,cform) co2dat +!check print cform, co2dat + do j = 1, JMXCO2 + do i = 1, IMXCO2 + co2cyc_sav(i,j,imo) = co2dat(i,j) * 1.0e-6 + enddo enddo enddo - enddo - close (NICO2CN) - endif ! endif_file_exist_block + close (NICO2CN) + endif ! endif_file_exist_block + else + allocate( co2cyc_sav(IMXCO2,JMXCO2,12) ) + endif read_and_broadcast_co2_v2 endif endif lab_ictm endif lab_ico2 + + ! Broadcast all necessary fields + call ccpp_bcast(co2_glb, mpiroot, mpicomm, ierr) + call ccpp_bcast(gco2cyc, mpiroot, mpicomm, ierr) + if (allocated(co2vmr_sav)) then + call ccpp_bcast(co2vmr_sav, mpiroot, mpicomm, ierr) + endif + if (allocated(co2cyc_sav)) then + call ccpp_bcast(co2cyc_sav, mpiroot, mpicomm, ierr) + endif ! !................................... end subroutine gas_init @@ -421,63 +460,66 @@ end subroutine gas_init !!\param errmsg error message !>\section gen_gas_update gas_update General Algorithm !----------------------------------- - subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & - & me, co2dat_file, co2gbl_file, ictmflg, ico2flg, & - & errflg, errmsg ) - -! =================================================================== ! -! ! -! gas_update reads in 2-d monthly co2 data set for a specified year. ! -! data are in a 15 degree lat/lon horizontal resolution. ! -! ! -! inputs: dimemsion ! -! iyear - year of the requested data for fcst 1 ! -! imon - month of the year 1 ! -! iday - day of the month 1 ! -! ihour - hour of the day 1 ! -! ldoco2 - co2 update control flag 1 ! -! me - print message control flag 1 ! -! ico2flg - co2 data source control flag ! -! =0: use prescribed co2 global mean value ! -! =1: use input global mean co2 value (co2_glb) ! -! =2: use input 2-d monthly co2 value (co2vmr_sav) ! -! ictmflg - =yyyy#, data ic time/date control flag ! -! =-2: same as 0, but superimpose seasonal cycle ! -! from climatology data set. ! -! =-1: use user provided external data for the fcst ! -! time, no extrapolation. ! -! =0: use data at initial cond time, if not existed ! -! then use latest, without extrapolation. ! -! =1: use data at the forecast time, if not existed ! -! then use latest and extrapolate to fcst time. ! -! =yyyy0: use yyyy data for the forecast time, no ! -! further data extrapolation. ! -! =yyyy1: use yyyy data for the fcst. if needed, do ! -! extrapolation to match the fcst time. ! -! ivflip - vertical profile indexing flag ! -! co2dat_file - external co2 2d monthly obsv data table ! -! co2gbl_file - external co2 global annual mean data table ! -! ! -! outputs: (CCPP error handling) ! -! errflg - error flag ! -! errmsg - error message ! -! ! -! internal module variables: ! -! co2vmr_sav - monthly co2 volume mixing ratio IMXCO2*JMXCO2*12 ! -! co2cyc_sav - monthly cycle co2 vol mixing ratio IMXCO2*JMXCO2*12 ! -! co2_glb - global annual mean co2 mixing ratio ! -! gco2cyc - global monthly mean co2 variation 12 ! -! ! -! usage: call gas_update ! -! ! -! subprograms called: none ! -! ! -! =================================================================== ! + subroutine gas_update(iyear, imon, iday, ihour, ldoco2, + & mpicomm, mpirank, mpiroot, co2dat_file, co2gbl_file, + & ictmflg, ico2flg, errflg, errmsg ) + +! =================================================================== ! +! ! +! gas_update reads in 2-d monthly co2 data set for a specified year. ! +! data are in a 15 degree lat/lon horizontal resolution. ! +! ! +! inputs: dimemsion ! +! iyear - year of the requested data for fcst 1 ! +! imon - month of the year 1 ! +! iday - day of the month 1 ! +! ihour - hour of the day 1 ! +! ldoco2 - co2 update control flag 1 ! +! me - print message control flag 1 ! +! ico2flg - co2 data source control flag ! +! =0: use prescribed co2 global mean value ! +! =1: use input global mean co2 value (co2_glb) ! +! =2: use input 2-d monthly co2 value (co2vmr_sav) ! +! ictmflg - =yyyy#, data ic time/date control flag ! +! =-2: same as 0, but superimpose seasonal cycle ! +! from climatology data set. ! +! =-1: use user provided external data for the fcst ! +! time, no extrapolation. ! +! =0: use data at initial cond time, if not existed ! +! then use latest, without extrapolation. ! +! =1: use data at the forecast time, if not existed ! +! then use latest and extrapolate to fcst time. ! +! =yyyy0: use yyyy data for the forecast time, no ! +! further data extrapolation. ! +! =yyyy1: use yyyy data for the fcst. if needed, do ! +! extrapolation to match the fcst time. ! +! ivflip - vertical profile indexing flag ! +! co2dat_file - external co2 2d monthly obsv data table ! +! co2gbl_file - external co2 global annual mean data table ! +! ! +! outputs: (CCPP error handling) ! +! errflg - error flag ! +! errmsg - error message ! +! ! +! internal module variables: ! +! co2vmr_sav - monthly co2 volume mixing ratio IMXCO2*JMXCO2*12! +! co2cyc_sav - monthly cycle co2 vol mixing ratio IMXCO2*JMXCO2*12! +! co2_glb - global annual mean co2 mixing ratio ! +! gco2cyc - global monthly mean co2 variation 12 ! +! ! +! usage: call gas_update ! +! ! +! subprograms called: none ! +! ! +! =================================================================== ! ! implicit none ! --- inputs: - integer, intent(in) :: iyear,imon,iday,ihour,me,ictmflg,ico2flg + integer, intent(in) :: iyear, imon, iday, ihour + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot + integer, intent(in) :: ictmflg,ico2flg character(len=26),intent(in) :: co2dat_file, co2gbl_file logical, intent(in) :: ldoco2 @@ -497,6 +539,7 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & logical :: file_exist, lextpl, change character :: cline*100, cform*8, cfile1*26 data cform / '(24f7.2)' / !! data format in IMXCO2*f7.2 + integer :: ierr ! !===> ... begin here ! @@ -506,17 +549,17 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & !> - co2 data section - if ( ico2flg == 0 ) return ! use prescribed global mean co2 data - if ( ictmflg ==-1 ) return ! use user provided co2 data - if ( .not. ldoco2 ) return ! no need to update co2 data + if ( ico2flg == 0 ) return ! use prescribed global mean co2 data + if ( ictmflg ==-1 ) return ! use user provided co2 data + if ( .not. ldoco2 ) return ! no need to update co2 data if ( ictmflg < 0 ) then ! use user provided external data lextpl = .false. ! no time extrapolation idyr = iyear ! use the model year else ! use historically observed data - lextpl = ( mod(ictmflg,10) == 1 ) ! flag for data extrapolation - idyr = ictmflg / 10 ! year of data source used - if ( idyr == 0 ) idyr = iyear ! not specified, use model year + lextpl = ( mod(ictmflg,10) == 1 )! flag for data extrapolation + idyr = ictmflg / 10 ! year of data source used + if ( idyr == 0 ) idyr = iyear ! not specified, use model year endif ! --- ... auto select co2 2-d data table for required year @@ -532,70 +575,69 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & Lab_if_idyr : if ( idyr < MINYEAR .and. ictmflg > 0 ) then - if ( me == 0 ) then - print *,' Requested CO2 data year',iyear,' earlier than', & + read_and_broadcast_co2_v1: if ( mpirank==mpiroot ) then + print *,' Requested CO2 data year',iyear,' earlier than', & MINYEAR - print *,' Which is the earliest monthly observation', & + print *,' Which is the earliest monthly observation', & ' data available.' print *,' Thus, historical global mean data is used' - endif ! --- ... check to see if requested co2 data file existed - inquire (file=co2gbl_file, exist=file_exist) - if ( .not. file_exist ) then - errflg = 1 - errmsg = 'ERROR(gas_update): Requested co2 data file not '// & - & 'found: '//co2gbl_file - return - else - close(NICO2CN) - open (NICO2CN,file=co2gbl_file,form='formatted',status='old') - rewind NICO2CN + inquire (file=co2gbl_file, exist=file_exist) + if ( .not. file_exist ) then + print *,' Requested co2 data file "',co2gbl_file, + & '" not found' + errflg = 1 + errmsg = 'ERROR(gas_update): Requested co2 data file not '// + & 'found' + return + else + close(NICO2CN) + open(NICO2CN,file=co2gbl_file,form='formatted',status='old') + rewind NICO2CN - read (NICO2CN, 24) iyr1, iyr2, cline - 24 format(i4,4x,i4,a48) + read (NICO2CN, 24) iyr1, iyr2, cline + 24 format(i4,4x,i4,a48) - if ( me == 0 ) then print *,' Opened co2 data file: ',co2gbl_file !check print *, iyr1, iyr2, cline(1:48) - endif - if ( idyr < iyr1 ) then - iyr = iyr1 -!check if ( me == 0 ) then -! print *,' Using earlist available co2 data, year=',iyr1 -!check endif - endif - - i = iyr2 - Lab_dowhile1 : do while ( i >= iyr1 ) -! read (NICO2CN,26) jyr, co2g1, co2g2 -! 26 format(i4,4x,2f7.2) - read (NICO2CN, *) jyr, co2g1, co2g2 + if ( idyr < iyr1 ) then + iyr = iyr1 +!check if ( me == 0 ) then +! print *,' Using earlist available co2 data, year=',iyr1 +!check endif + endif - if ( i == iyr .and. iyr == jyr ) then - co2_glb = (co2g1+co2g2) * 0.5e-6 - if ( ico2flg == 2 ) then - do j = 1, JMXCO2 - do i = 1, IMXCO2 - co2vmr_sav(i,j,1:6) = co2g1 * 1.0e-6 - co2vmr_sav(i,j,7:12) = co2g2 * 1.0e-6 + i = iyr2 + Lab_dowhile1 : do while ( i >= iyr1 ) +! read (NICO2CN,26) jyr, co2g1, co2g2 +! 26 format(i4,4x,2f7.2) + read (NICO2CN, *) jyr, co2g1, co2g2 + + if ( i == iyr .and. iyr == jyr ) then + co2_glb = (co2g1+co2g2) * 0.5e-6 + if ( ico2flg == 2 ) then + do j = 1, JMXCO2 + do i = 1, IMXCO2 + co2vmr_sav(i,j,1:6) = co2g1 * 1.0e-6 + co2vmr_sav(i,j,7:12) = co2g2 * 1.0e-6 + enddo enddo - enddo - endif + endif - if ( me == 0 ) print *,' Co2 data for year',iyear, & - & co2_glb - exit Lab_dowhile1 - else -!check if ( me == 0 ) print *,' Skip co2 data for year',i - i = i - 1 - endif - enddo Lab_dowhile1 + print *,' Co2 data for year',iyear, co2_glb + exit Lab_dowhile1 + else +!check if ( me == 0 ) print *,' Skip co2 data for year',i + i = i - 1 + endif + enddo Lab_dowhile1 - close ( NICO2CN ) - endif ! end if_file_exist_block + close ( NICO2CN ) + endif ! end if_file_exist_block + endif read_and_broadcast_co2_v1 else Lab_if_idyr @@ -606,157 +648,152 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & 34 format(i4.4) ! --- ... check to see if requested co2 data file existed - - inquire (file=cfile1, exist=file_exist) - if ( .not. file_exist ) then - - Lab_if_ictm : if ( ictmflg > 10 ) then ! specified year of data not found - if ( me == 0 ) then - print *,' Specified co2 data for year',idyr, & + read_and_broadcast_co2_v2: if ( mpirank==mpiroot ) then + inquire (file=cfile1, exist=file_exist) + if ( .not. file_exist ) then + ! specified year of data not found + Lab_if_ictm : if ( ictmflg > 10 ) then + print *,' Specified co2 data for year',idyr, & ' not found !! Need to change namelist ICTM !!' - endif - errflg = 1 - errmsg = 'ERROR(gas_update): Specified co2 data for year '//& - & 'not found' - return - else Lab_if_ictm ! looking for latest available data - if ( me == 0 ) then - print *,' Requested co2 data for year',idyr, & + errflg = 1 + errmsg = 'ERROR(gas_update): Specified co2 data for year ' + & // 'not found' + return + else Lab_if_ictm ! looking for latest available data + print *,' Requested co2 data for year',idyr, & ' not found, check for other available data set' - endif - Lab_dowhile2 : do while ( iyr >= MINYEAR ) - iyr = iyr - 1 - write(cfile1(19:22),34) iyr + Lab_dowhile2 : do while ( iyr >= MINYEAR ) + iyr = iyr - 1 + write(cfile1(19:22),34) iyr - inquire (file=cfile1, exist=file_exist) - if ( me == 0 ) then + inquire (file=cfile1, exist=file_exist) print *,' Looking for CO2 file ',cfile1 - endif - if ( file_exist ) then - exit Lab_dowhile2 + if ( file_exist ) then + exit Lab_dowhile2 + endif + enddo Lab_dowhile2 + + if ( .not. file_exist ) then + print *,' Can not find co2 data source file' + errflg = 1 + errmsg = 'ERROR(gas_update): Can not find co2 data '// + & 'source file' + return endif - enddo Lab_dowhile2 - - if ( .not. file_exist ) then - errflg = 1 - errmsg = 'ERROR(gas_update): Cannot find co2 data '// & - & 'source file: '//co2dat_file - return - endif - endif Lab_if_ictm - endif ! end if_file_exist_block + endif Lab_if_ictm + endif ! end if_file_exist_block ! --- ... read in co2 2-d data for the requested month - close(NICO2CN) - open (NICO2CN,file=cfile1,form='formatted',status='old') - rewind NICO2CN - read (NICO2CN, 36) iyr, cline, co2g1, co2g2 - 36 format(i4,a94,f7.2,16x,f5.2) + close(NICO2CN) + open (NICO2CN,file=cfile1,form='formatted',status='old') + rewind NICO2CN + read (NICO2CN, 36) iyr, cline, co2g1, co2g2 + 36 format(i4,a94,f7.2,16x,f5.2) - if ( me == 0 ) then print *,' Opened co2 data file: ',cfile1 print *, iyr, cline(1:94), co2g1,' GROWTH RATE =', co2g2 - endif ! --- ... add growth rate if needed - if ( lextpl ) then -! rate = co2g2 * (iyear - iyr) ! rate from early year -! rate = 1.60 * (iyear - iyr) ! avg rate over long period - rate = 2.00 * (iyear - iyr) ! avg rate for recent period - else - rate = 0.0 - endif + if ( lextpl ) then +! rate = co2g2 * (iyear - iyr) ! rate from early year +! rate = 1.60 * (iyear - iyr) ! avg rate over long period + rate = 2.00 * (iyear - iyr) ! avg rate for recent period + else + rate = 0.0 + endif - co2_glb = (co2g1 + rate) * 1.0e-6 - if ( me == 0 ) then - print *,' Global annual mean CO2 data for year', & + co2_glb = (co2g1 + rate) * 1.0e-6 + print *,' Global annual mean CO2 data for year', & iyear, co2_glb - endif - - if ( ictmflg == -2 ) then ! need to calc ic time annual mean first + ! need to calc ic time annual mean first + if ( ictmflg == -2 ) then - if ( ico2flg == 1 ) then - if ( me==0 ) then - print *,' CHECK: Monthly deviations of climatology ', & + if ( ico2flg == 1 ) then + print *,' CHECK: Monthly deviations of climatology ', & 'to be superimposed on global annual mean' print *, gco2cyc - endif - elseif ( ico2flg == 2 ) then - co2ann(:,:) = 0.0 + elseif ( ico2flg == 2 ) then + co2ann(:,:) = 0.0 - do imo = 1, 12 - read (NICO2CN,cform) co2dat -!check print cform, co2dat + do imo = 1, 12 + read (NICO2CN,cform) co2dat +!check print cform, co2dat - do j = 1, JMXCO2 - do i = 1, IMXCO2 - co2ann(i,j) = co2ann(i,j) + co2dat(i,j) + do j = 1, JMXCO2 + do i = 1, IMXCO2 + co2ann(i,j) = co2ann(i,j) + co2dat(i,j) + enddo enddo enddo - enddo - - do j = 1, JMXCO2 - do i = 1, IMXCO2 - co2ann(i,j) = co2ann(i,j) * 1.0e-6 / float(12) - enddo - enddo - do imo = 1, 12 do j = 1, JMXCO2 do i = 1, IMXCO2 - co2vmr_sav(i,j,imo) = co2ann(i,j)+co2cyc_sav(i,j,imo) + co2ann(i,j) = co2ann(i,j) * 1.0e-6 / float(12) + enddo + enddo + + do imo = 1, 12 + do j = 1, JMXCO2 + do i = 1, IMXCO2 + co2vmr_sav(i,j,imo) = co2ann(i,j)+co2cyc_sav(i,j,imo) + enddo enddo enddo - enddo - if ( me==0 ) then - print *,' CHECK: Sample of 2-d annual mean of CO2 ', & + print *,' CHECK: Sample of 2-d annual mean of CO2 ', & 'data used for year:',iyear print *, co2ann(1,:) - print *,' CHECK: AFTER adding seasonal cycle, Sample ', & + print *,' CHECK: AFTER adding seasonal cycle, Sample ', & 'of selected months of CO2 data for year:',iyear do imo = 1, 12, 3 print *,' Month =',imo print *, co2vmr_sav(1,:,imo) enddo - endif - endif ! endif_icl2flg_block + endif ! endif_icl2flg_block - else ! no need to calc ic time annual mean first + else ! no need to calc ic time annual mean first - if ( ico2flg == 2 ) then ! directly save monthly data - do imo = 1, 12 - read (NICO2CN,cform) co2dat -!check print cform, co2dat + if ( ico2flg == 2 ) then ! directly save monthly data + do imo = 1, 12 + read (NICO2CN,cform) co2dat +!check print cform, co2dat - do j = 1, JMXCO2 - do i = 1, IMXCO2 - co2vmr_sav(i,j,imo) = (co2dat(i,j) + rate) * 1.0e-6 + do j = 1, JMXCO2 + do i = 1, IMXCO2 + co2vmr_sav(i,j,imo) = (co2dat(i,j) + rate) * 1.0e-6 + enddo enddo enddo - enddo - if ( me == 0 ) then - print *,' CHECK: Sample of selected months of CO2 ', & + print *,' CHECK: Sample of selected months of CO2 ', & 'data used for year:',iyear do imo = 1, 12, 3 print *,' Month =',imo print *, co2vmr_sav(1,:,imo) enddo - endif - endif ! endif_ico2flg_block - - do imo = 1, 12 - gco2cyc(imo) = 0.0 - enddo - endif ! endif_ictmflg_block - close ( NICO2CN ) + endif ! endif_ico2flg_block + do imo = 1, 12 + gco2cyc(imo) = 0.0 + enddo + endif ! endif_ictmflg_block + close ( NICO2CN ) + endif read_and_broadcast_co2_v2 endif Lab_if_idyr -! + + ! Broadcast all necessary fields + call ccpp_bcast(co2_glb, mpiroot, mpicomm, ierr) + call ccpp_bcast(gco2cyc, mpiroot, mpicomm, ierr) + if (allocated(co2vmr_sav)) then + call ccpp_bcast(co2vmr_sav, mpiroot, mpicomm, ierr) + endif + if (allocated(co2cyc_sav)) then + call ccpp_bcast(co2cyc_sav, mpiroot, mpicomm, ierr) + endif + !................................... end subroutine gas_update !----------------------------------- @@ -765,17 +802,17 @@ end subroutine gas_update !! gases in volume mixing ratio. Currently only co2 has the options !! from observed values, all other gases are asigned to the !! climatological values. -!!\param plvl (IMAX,LMAX+1), pressure at model layer interfaces (mb) -!!\param xlon (IMAX), grid longitude in radians, ok both 0->2pi -!! or -pi -> +pi arrangements -!!\param xlat (IMAX), grid latitude in radians, default range to -!! pi/2 -> -pi/2, otherwise see in-line comment -!!\param IMAX horizontal dimension for output data -!!\param LMAX vertical dimension for output data -!!\param ico2flg (1), co2 data source control flag -!!\param top_at_1 (1), vertical ordering flag -!!\param con_pi (1), physical constant Pi -!!\param gasdat (IMAX,LMAX,NF_VGAS) - gases volume mixing ratioes +!!\param plvl (IMAX,LMAX+1), pressure at model layer interfaces(mb) +!!\param xlon (IMAX), grid longitude in radians, ok both 0->2pi +!! or -pi -> +pi arrangements +!!\param xlat (IMAX), grid latitude in radians, default range to +!! pi/2 -> -pi/2, otherwise see in-line comment +!!\param IMAX horizontal dimension for output data +!!\param LMAX vertical dimension for output data +!!\param ico2flg (1), co2 data source control flag +!!\param top_at_1 (1), vertical ordering flag +!!\param con_pi (1), physical constant Pi +!!\param gasdat (IMAX,LMAX,NF_VGAS) - gases volume mixing ratioes !!\n (:,:,1) - co2 !!\n (:,:,2) - n2o !!\n (:,:,3) - ch4 @@ -788,60 +825,60 @@ end subroutine gas_update !!\n (:,:,10) - cfc113 !!\n !> - Internal module variables : -!!\n co2vmr_sav - saved monthly co2 concentration from sub gas_update -!!\n co2_glb - saved global annual mean co2 value from gas_update -!!\n gco2cyc - saved global seasonal variation of co2 climatology +!!\n co2vmr_sav - saved monthly co2 concentration from sub gas_update +!!\n co2_glb - saved global annual mean co2 value from gas_update +!!\n gco2cyc - saved global seasonal variation of co2 climatology !! in 12-month form !>\section gen_getgases getgases General Algorithm !----------------------------------- - subroutine getgases( plvl, xlon, xlat, IMAX, LMAX, ico2flg, & + subroutine getgases( plvl, xlon, xlat, IMAX, LMAX, ico2flg, & top_at_1, con_pi, gasdat) -! =================================================================== ! -! ! -! getgases set up global distribution of radiation absorbing gases ! -! in volume mixing ratio. currently only co2 has the options from ! -! observed values, all other gases are asigned to the climatological ! -! values. ! -! ! -! inputs: ! -! plvl(IMAX,LMAX+1)- pressure at model layer interfaces (mb) ! -! xlon(IMAX) - grid longitude in radians, ok both 0->2pi or ! -! -pi -> +pi arrangements ! -! xlat(IMAX) - grid latitude in radians, default range to ! -! pi/2 -> -pi/2, otherwise see in-line comment ! -! IMAX, LMAX - horiz, vert dimensions for output data ! -! ico2flg - co2 data source control flag ! -! =0: use prescribed co2 global mean value ! -! =1: use input global mean co2 value (co2_glb) ! -! =2: use input 2-d monthly co2 value (co2vmr_sav)! -! top_at_1 - vertical profile indexing flag ! -! con_pi - physical constant Pi ! -! ! -! outputs: ! -! gasdat(IMAX,LMAX,NF_VGAS) - gases volume mixing ratioes ! -! (:,:,1) - co2 ! -! (:,:,2) - n2o ! -! (:,:,3) - ch4 ! -! (:,:,4) - o2 ! -! (:,:,5) - co ! -! (:,:,6) - cfc11 ! -! (:,:,7) - cfc12 ! -! (:,:,8) - cfc22 ! -! (:,:,9) - ccl4 ! -! (:,:,10) - cfc113 ! -! ! -! note: for lower atmos co2vmr_sav may have clim monthly deviations ! -! superimposed on init-cond co2 value, while co2_glb only ! -! contains the global mean value, thus needs to add the ! -! monthly dglobal mean deviation gco2cyc at upper atmos. for ! -! ictmflg/=-2, this value will be zero. ! -! ! -! usage: call getgases ! -! ! -! subprograms called: none ! -! ! -! =================================================================== ! -! +! =================================================================== ! +! ! +! getgases set up global distribution of radiation absorbing gases ! +! in volume mixing ratio. currently only co2 has the options from ! +! observed values, all other gases are asigned to the climatological ! +! values. ! +! ! +! inputs: ! +! plvl(IMAX,LMAX+1)- pressure at model layer interfaces (mb) ! +! xlon(IMAX) - grid longitude in radians, ok both 0->2pi or ! +! -pi -> +pi arrangements ! +! xlat(IMAX) - grid latitude in radians, default range to ! +! pi/2 -> -pi/2, otherwise see in-line comment ! +! IMAX, LMAX - horiz, vert dimensions for output data ! +! ico2flg - co2 data source control flag ! +! =0: use prescribed co2 global mean value ! +! =1: use input global mean co2 value (co2_glb) ! +! =2: use input 2-d monthly co2 value (co2vmr_sav)! +! top_at_1 - vertical profile indexing flag ! +! con_pi - physical constant Pi ! +! ! +! outputs: ! +! gasdat(IMAX,LMAX,NF_VGAS) - gases volume mixing ratioes ! +! (:,:,1) - co2 ! +! (:,:,2) - n2o ! +! (:,:,3) - ch4 ! +! (:,:,4) - o2 ! +! (:,:,5) - co ! +! (:,:,6) - cfc11 ! +! (:,:,7) - cfc12 ! +! (:,:,8) - cfc22 ! +! (:,:,9) - ccl4 ! +! (:,:,10) - cfc113 ! +! ! +! note: for lower atmos co2vmr_sav may have clim monthly deviations! +! superimposed on init-cond co2 value, while co2_glb only ! +! contains the global mean value, thus needs to add the ! +! monthly dglobal mean deviation gco2cyc at upper atmos. for ! +! ictmflg/=-2, this value will be zero. ! +! ! +! usage: call getgases ! +! ! +! subprograms called: none ! +! ! +! =================================================================== ! + implicit none ! --- input: @@ -895,9 +932,10 @@ subroutine getgases( plvl, xlon, xlat, IMAX, LMAX, ico2flg, & tmp = raddeg / resco2 do i = 1, IMAX xlon1 = xlon(i) - if ( xlon1 < 0.0 ) xlon1 = xlon1 + con_pi ! if xlon in -pi->pi, convert to 0->2pi - xlat1 = hfpi - xlat(i) ! if xlat in pi/2 -> -pi/2 range -!note xlat1 = xlat(i) ! if xlat in 0 -> pi range + ! if xlon in -pi->pi, convert to 0->2pi + if ( xlon1 < 0.0 ) xlon1 = xlon1 + con_pi + xlat1 = hfpi - xlat(i) ! if xlat in pi/2 -> -pi/2 range +!note xlat1 = xlat(i) ! if xlat in 0 -> pi range ilon = min( IMXCO2, int( xlon1*tmp + 1 )) ilat = min( JMXCO2, int( xlat1*tmp + 1 )) diff --git a/physics/Radiation/radiation_surface.f b/physics/Radiation/radiation_surface.f index 3f62b66fc..1dbe687bc 100644 --- a/physics/Radiation/radiation_surface.f +++ b/physics/Radiation/radiation_surface.f @@ -104,6 +104,8 @@ !! emissivity for LW radiation. module module_radiation_surface ! + use mpi_f08 + use mpiutil, only : ccpp_bcast use machine, only : kind_phys use module_iounitdef, only : NIRADSF use surface_perturbation, only : ppfbet @@ -139,7 +141,8 @@ module module_radiation_surface !>\section gen_sfc_init sfc_init General Algorithm !----------------------------------- subroutine sfc_init & - & ( me, ialbflg, iemsflg, semis_file, con_pi, errmsg, errflg )! --- inputs/outputs: + & ( mpicomm, mpirank, mpiroot, ialbflg, iemsflg, semis_file, & + & con_pi, errmsg, errflg ) ! --- inputs/outputs: ! ! =================================================================== ! ! ! @@ -172,7 +175,9 @@ subroutine sfc_init & implicit none ! --- inputs: - integer, intent(in) :: me, ialbflg, iemsflg + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot + integer, intent(in) :: ialbflg, iemsflg real(kind=kind_phys), intent(in) :: con_pi character(len=26), intent(in) :: semis_file ! --- outputs: ( none ) @@ -192,8 +197,7 @@ subroutine sfc_init & ! ! Module rad2dg = 180.0 / con_pi - - if ( me == 0 ) print *, VTAGSFC ! print out version tag + if ( mpirank==mpiroot ) print *, VTAGSFC ! print out version tag !> - Initialization of surface albedo section !! \n GFS_typedefs::ialbflg @@ -202,13 +206,13 @@ subroutine sfc_init & if ( ialbflg == 1 ) then - if ( me == 0 ) then + if ( mpirank==mpiroot ) then print *,' - Using MODIS based land surface albedo for sw' endif elseif ( ialbflg == 2 ) then ! use albedo from land model - if ( me == 0 ) then + if ( mpirank==mpiroot ) then print *,' - Using Albedo From Land Model' endif @@ -236,30 +240,28 @@ subroutine sfc_init & ! --- check to see if requested emissivity data file existed - inquire (file=semis_file, exist=file_exist) + read_and_broadcast: if (mpirank==mpiroot) then + inquire (file=semis_file, exist=file_exist) - if ( .not. file_exist ) then - if ( me == 0 ) then + if ( .not. file_exist ) then print *,' - Using Varying Surface Emissivity for lw' print *,' Requested data file "',semis_file,'" not found!' - endif - errmsg = 'module_radiation_surface: surface emissivity + errmsg = 'module_radiation_surface: surface emissivity & file not provided' - errflg = 1 - return + errflg = 1 + return - else - close(NIRADSF) - open (NIRADSF,file=semis_file,form='formatted',status='old') - rewind NIRADSF + else + close(NIRADSF) + open (NIRADSF,file=semis_file,form='formatted',status='old') + rewind NIRADSF - read (NIRADSF,12) cline - 12 format(a80) + read (NIRADSF,12) cline + 12 format(a80) - read (NIRADSF,14) idxems - 14 format(80i1) + read (NIRADSF,14) idxems + 14 format(80i1) - if ( me == 0 ) then print *,' - Using Varying Surface Emissivity for lw' print *,' Opened data file: ',semis_file print *, cline @@ -267,14 +269,15 @@ subroutine sfc_init & ! ia = IMXEMS / 5 ! ja = JMXEMS / 5 ! print *, idxems(1:IMXEMS:ia,1:JMXEMS:ja) - endif + close(NIRADSF) + endif ! end if_file_exist_block + endif read_and_broadcast - close(NIRADSF) - endif ! end if_file_exist_block + call ccpp_bcast(idxems, mpiroot, mpicomm, errflg) elseif ( iemslw == 2 ) then ! use emiss from land model - if ( me == 0 ) then + if ( mpirank==mpiroot ) then print *,' - Using Surface Emissivity From Land Model' endif diff --git a/physics/SFC_Layer/MYNN/MYNN b/physics/SFC_Layer/MYNN/MYNN index b2d7d8731..cce9a5fc4 160000 --- a/physics/SFC_Layer/MYNN/MYNN +++ b/physics/SFC_Layer/MYNN/MYNN @@ -1 +1 @@ -Subproject commit b2d7d8731c84964c7afcab74cc9f2acb23d7fd71 +Subproject commit cce9a5fc4479749f489be24020e5c06c3e4202d4 diff --git a/physics/SFC_Layer/UFS/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 index eb84aa352..d6b0e3383 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.f90 +++ b/physics/SFC_Layer/UFS/sfc_nst.f90 @@ -469,7 +469,7 @@ subroutine sfc_nst_run & endif ! apply fca - if ( d_conv(i) > zero ) then + if ( d_conv(i) > zero .and. xt(i) > zero ) then !> - If thickness of free convection layer > 0.0, call dtm_1p_fca() !! to apply free convection adjustment. !> - If \a dtl thickness >= module_nst_parameters::z_w_max(), call dtl_reset() diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 index f82669a5d..cf32a8604 100644 --- a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -170,6 +170,9 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file, me, write(iosstr, '(I0)') ios errmsg = 'lnd_iau_mod_set_control: I/O error code '//trim(iosstr)//' at land_iau namelist read' errflg = 1 +#ifndef INTERNAL_FILE_NML + close(nlunit) +#endif return end if @@ -179,6 +182,9 @@ subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file, me, WRITE(6, * ) 'lnd_iau_mod_set_control: Warning! EoF ('//trim(iosstr)//') while reading land_iau namelist,' & // ' likely because land_iau_nml was not found in input.nml. It will be set to default.' endif +#ifndef INTERNAL_FILE_NML + close(nlunit) +#endif endif if (me == mpi_root) then diff --git a/physics/tools/mpiutil.F90 b/physics/tools/mpiutil.F90 new file mode 100644 index 000000000..f70c3f931 --- /dev/null +++ b/physics/tools/mpiutil.F90 @@ -0,0 +1,245 @@ +module mpiutil + + use iso_fortran_env, only : real32, real64 + use iso_fortran_env, only : error_unit, output_unit + use mpi_f08 + + implicit none + + private + public ccpp_bcast + + interface ccpp_bcast + procedure :: bcast_i32d0 + procedure :: bcast_i32d1 + procedure :: bcast_i32d2 + procedure :: bcast_i32d3 + procedure :: bcast_r32d0 + procedure :: bcast_r64d0 + procedure :: bcast_r32d1 + procedure :: bcast_r64d1 + procedure :: bcast_r32d2 + procedure :: bcast_r64d2 + procedure :: bcast_r32d3 + procedure :: bcast_r64d3 + procedure :: bcast_r32d4 + procedure :: bcast_r64d4 + procedure :: bcast_r32d5 + procedure :: bcast_r64d5 + procedure :: bcast_ld0 + end interface ccpp_bcast + +contains + +! Helper routines for MPI broadcasting + + subroutine bcast_i32d0(arr, root, comm, ierr) + integer, intent(inout) :: arr + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, 1, MPI_INTEGER, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_i32d0") + end if + end subroutine bcast_i32d0 + + subroutine bcast_i32d1(arr, root, comm, ierr) + integer, intent(inout) :: arr(:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_INTEGER, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_i32d1") + end if + end subroutine bcast_i32d1 + + subroutine bcast_i32d2(arr, root, comm, ierr) + integer, intent(inout) :: arr(:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_INTEGER, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_i32d2") + end if + end subroutine bcast_i32d2 + + subroutine bcast_i32d3(arr, root, comm, ierr) + integer, intent(inout) :: arr(:,:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_INTEGER, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_i32d3") + end if + end subroutine bcast_i32d3 + + subroutine bcast_r32d0(arr, root, comm, ierr) + real(kind=real32), intent(inout) :: arr + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, 1, MPI_REAL, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r32d0") + end if + end subroutine bcast_r32d0 + + subroutine bcast_r64d0(arr, root, comm, ierr) + real(kind=real64), intent(inout) :: arr + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, 1, MPI_DOUBLE_PRECISION, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r64d0") + end if + end subroutine bcast_r64d0 + + subroutine bcast_r32d1(arr, root, comm, ierr) + real(kind=real32), intent(inout) :: arr(:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_REAL, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r32d1") + end if + end subroutine bcast_r32d1 + + subroutine bcast_r64d1(arr, root, comm, ierr) + real(kind=real64), intent(inout) :: arr(:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_DOUBLE_PRECISION, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r64d1") + end if + end subroutine bcast_r64d1 + + subroutine bcast_r32d2(arr, root, comm, ierr) + real(kind=real32), intent(inout) :: arr(:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_REAL, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r32d2") + end if + end subroutine bcast_r32d2 + + subroutine bcast_r64d2(arr, root, comm, ierr) + real(kind=real64), intent(inout) :: arr(:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_DOUBLE_PRECISION, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r64d2") + end if + end subroutine bcast_r64d2 + + subroutine bcast_r32d3(arr, root, comm, ierr) + real(kind=real32), intent(inout) :: arr(:,:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_REAL, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r32d3") + end if + end subroutine bcast_r32d3 + + subroutine bcast_r64d3(arr, root, comm, ierr) + real(kind=real64), intent(inout) :: arr(:,:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_DOUBLE_PRECISION, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r64d3") + end if + end subroutine bcast_r64d3 + + subroutine bcast_r32d4(arr, root, comm, ierr) + real(kind=real32), intent(inout) :: arr(:,:,:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_REAL, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r32d4") + end if + end subroutine bcast_r32d4 + + subroutine bcast_r64d4(arr, root, comm, ierr) + real(kind=real64), intent(inout) :: arr(:,:,:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_DOUBLE_PRECISION, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r64d4") + end if + end subroutine bcast_r64d4 + + subroutine bcast_r32d5(arr, root, comm, ierr) + real(kind=real32), intent(inout) :: arr(:,:,:,:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_REAL, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r32d5") + end if + end subroutine bcast_r32d5 + + subroutine bcast_r64d5(arr, root, comm, ierr) + real(kind=real64), intent(inout) :: arr(:,:,:,:,:) + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, size(arr), MPI_DOUBLE_PRECISION, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_r64d5") + end if + end subroutine bcast_r64d5 + + subroutine bcast_ld0(arr, root, comm, ierr) + logical, intent(inout) :: arr + integer, intent(in) :: root + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ierr + call MPI_BCAST(arr, 1, MPI_LOGICAL, root, comm, ierr) + if (ierr/=MPI_SUCCESS) then + call ccpp_abort(comm, "mpiutil.F90:bcast_ld0") + end if + end subroutine bcast_ld0 + +! Temporary: helper routine to abort code until +! discussion about potential redesign of how to +! abort model runs for CCPP errors is settled. + + subroutine ccpp_abort(comm, str) +#ifdef __INTEL_COMPILER + use ifcore +#endif + implicit none + type(MPI_Comm), intent(in) :: comm + character(len=*), intent(in) :: str + integer :: ierr + write(output_unit,'(a)') "ccpp_abort: " // trim(str) + write(error_unit,'(a)') "ccpp_abort: " // trim(str) +#if defined(__INTEL_COMPILER) + call tracebackqq("ccpp_abort" // trim(str), user_exit_code=-1) +#elif defined(__GFORTRAN__) + call backtrace() +#endif + call MPI_ABORT(comm, ierr) + end subroutine ccpp_abort + +end module mpiutil