From 4c42f034d48485f3e8733fd4ebc631204e8cd7ed Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 26 Jan 2021 20:40:52 -0700 Subject: [PATCH 1/3] update SCM-only time-vary schemes to use timestep_init phase (revert CMakeLists.txt change in order to compile?) --- CMakeLists.txt | 9 +- physics/GFS_phys_time_vary.scm.F90 | 638 ++++++++++++----------- physics/GFS_phys_time_vary.scm.meta | 782 +++++++++++++++++++++++++--- physics/GFS_rad_time_vary.scm.F90 | 160 +++--- physics/GFS_rad_time_vary.scm.meta | 218 +++++++- physics/GFS_time_vary_pre.scm.F90 | 12 +- physics/GFS_time_vary_pre.scm.meta | 2 +- 7 files changed, 1347 insertions(+), 474 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 441f047f6..4dedf715a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -72,7 +72,8 @@ set(TYPEDEFS $ENV{CCPP_TYPEDEFS}) if(TYPEDEFS) message(STATUS "Got CCPP TYPEDEFS from environment variable: ${TYPEDEFS}") else(TYPEDEFS) - include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) + #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) + include(./CCPP_TYPEDEFS.cmake) message(STATUS "Got CCPP TYPEDEFS from cmakefile include file: ${TYPEDEFS}") endif(TYPEDEFS) @@ -88,7 +89,8 @@ set(SCHEMES $ENV{CCPP_SCHEMES}) if(SCHEMES) message(STATUS "Got CCPP SCHEMES from environment variable: ${SCHEMES}") else(SCHEMES) - include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) + #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) + include(./CCPP_SCHEMES.cmake) message(STATUS "Got CCPP SCHEMES from cmakefile include file: ${SCHEMES}") endif(SCHEMES) @@ -97,7 +99,8 @@ set(CAPS $ENV{CCPP_CAPS}) if(CAPS) message(STATUS "Got CCPP CAPS from environment variable: ${CAPS}") else(CAPS) - include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) + #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) + include(./CCPP_CAPS.cmake) message(STATUS "Got CCPP CAPS from cmakefile include file: ${CAPS}") endif(CAPS) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 7f2377397..a1acc3fa0 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -1,19 +1,27 @@ -!> \file GFS_phys_time_vary.F90 +!> \file GFS_phys_time_vary.scm.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 ozone, stratospheric water vapor, +!! aerosol, IN&CCN and surface properties updates. +!> @{ module GFS_phys_time_vary + + use machine, only : kind_phys - use ozne_def, only : levozp, oz_coeff, oz_lat, oz_pres, oz_time, ozplin - use ozinterp, only : read_o3data, setindxoz, ozinterpol + use mersenne_twister, only: random_setseed, random_number - use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin - use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol + use ozne_def, only : levozp, oz_coeff, oz_lat, oz_pres, oz_time, ozplin + use ozinterp, only : read_o3data, setindxoz, ozinterpol - use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm - use aerinterp, only : read_aerdata, setindxaer, aerinterpol + use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin + use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol - use iccn_def, only : ciplin, ccnin, ci_pres - use iccninterp, only : read_cidata, setindxci, ciinterpol + use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm + use aerinterp, only : read_aerdata, setindxaer, aerinterpol + + use iccn_def, only : ciplin, ccnin, ci_pres + use iccninterp, only : read_cidata, setindxci, ciinterpol #if 0 !--- variables needed for calculating 'sncovr' @@ -24,376 +32,400 @@ module GFS_phys_time_vary private - public GFS_phys_time_vary_init, GFS_phys_time_vary_run, GFS_phys_time_vary_finalize + public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_timestep_finalize, GFS_phys_time_vary_finalize logical :: is_initialized = .false. + 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 + contains !> \section arg_table_GFS_phys_time_vary_init Argument Table !! \htmlinclude GFS_phys_time_vary_init.html !! - subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & - GFS_Tbd_type, GFS_interstitial_type +!>\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, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & + jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & + 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, & + errmsg, errflg) implicit none ! Interface variables - type(GFS_grid_type), intent(inout) :: Grid - type(GFS_control_type), intent(in) :: Model - type(GFS_interstitial_type), intent(inout) :: Interstitial - type(GFS_tbd_type), intent(in) :: Tbd - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny + logical, intent(in) :: h2o_phys, iaerclm + integer, intent(in) :: idate(:) + real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) + + integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(in) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) + real(kind_phys), intent(in) :: aer_nm(:,:,:) + integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) + integer, intent(inout) :: imap(:), jmap(:) + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! Local variables - integer :: i, j, ix, nb, nt + integer :: i, j, ix ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (is_initialized) return - - nb = 1 - nt = 1 - call read_o3data (Model%ntoz, Model%me, Model%master) +!> - Call read_o3data() to read ozone data + call read_o3data (ntoz, me, master) ! Consistency check that the hardcoded values for levozp and ! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data - ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) - if (size(Tbd%ozpl, dim=2).ne.levozp) then + ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) + if (size(ozpl, dim=2).ne.levozp) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levozp from read_o3data does not match value in GFS_typedefs.F90: ", & - levozp, " /= ", size(Tbd%ozpl, dim=2) + levozp, " /= ", size(ozpl, dim=2) errflg = 1 end if - if (size(Tbd%ozpl, dim=3).ne.oz_coeff) then + if (size(ozpl, dim=3).ne.oz_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", & - oz_coeff, " /= ", size(Tbd%ozpl, dim=3) + oz_coeff, " /= ", size(ozpl, dim=3) errflg = 1 end if - - call read_h2odata (Model%h2o_phys, Model%me, Model%master) - + +!> - Call read_h2odata() to read stratospheric water vapor data + call read_h2odata (h2o_phys, me, master) + ! Consistency check that the hardcoded values for levh2o and ! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - if (size(Tbd%h2opl, dim=2).ne.levh2o) then + if (size(h2opl, dim=2).ne.levh2o) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & - levh2o, " /= ", size(Tbd%h2opl, dim=2) + levh2o, " /= ", size(h2opl, dim=2) errflg = 1 end if - if (size(Tbd%h2opl, dim=3).ne.h2o_coeff) then + if (size(h2opl, dim=3).ne.h2o_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & - h2o_coeff, " /= ", size(Tbd%h2opl, dim=3) + h2o_coeff, " /= ", size(h2opl, dim=3) errflg = 1 - end if - - if (Model%iaerclm) then - ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 - ! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def - if (size(Tbd%aer_nm, dim=3).ne.ntrcaerm) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & - ntrcaerm, " /= ", size(Tbd%aer_nm, dim=3) - errflg = 1 - else - ! Update the value of ntrcaer in aerclm_def with the value defined - ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm - ntrcaer = size(Tbd%aer_nm, dim=3) - ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) - if (errflg/=0) return - endif + end if + +!> - Call read_aerdata() to read aerosol climatology + if (iaerclm) then + ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 + ! and used to allocate aer_nm matches the value defined in aerclm_def + if (size(aer_nm, dim=3).ne.ntrcaerm) then + write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & + "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & + ntrcaerm, " /= ", size(aer_nm, dim=3) + errflg = 1 + else + ! Update the value of ntrcaer in aerclm_def with the value defined + ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. + ! If iaerclm is .true., then ntrcaer == ntrcaerm + ntrcaer = size(aer_nm, dim=3) + ! Read aerosol climatology + call read_aerdata (me,master,iflip,idate,errmsg,errflg) + endif else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%iaerclm is .false., then ntrcaer == 1 - ntrcaer = size(Tbd%aer_nm, dim=3) + ! If iaerclm is .false., then ntrcaer == 1 + ntrcaer = size(aer_nm, dim=3) endif - - if (Model%iccn == 1) then - call read_cidata ( Model%me, Model%master) - ! No consistency check needed for in/ccn data, all values are - ! hardcoded in module iccn_def.F and GFS_typedefs.F90 + +!> - Call read_cidata() to read IN and CCN data + if (iccn == 1) then + call read_cidata (me,master) + ! No consistency check needed for in/ccn data, all values are + ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif - - ! Update values of oz_pres in Interstitial data type for all threads - if (Model%ntoz > 0) then - Interstitial%oz_pres = oz_pres - end if - ! Update values of h2o_pres in Interstitial data type for all threads - if (Model%h2o_phys) then - Interstitial%h2o_pres = h2o_pres - end if - - - !--- read in and initialize ozone - if (Model%ntoz > 0) then - call setindxoz (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_o3, & - Grid%jindx2_o3, Grid%ddy_o3) +!> - Call setindxoz() to initialize ozone data + if (ntoz > 0) then + call setindxoz (im, xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif - !--- read in and initialize stratospheric water - if (Model%h2o_phys) then - call setindxh2o (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_h, & - Grid%jindx2_h, Grid%ddy_h) +!> - Call setindxh2o() to initialize stratospheric water vapor data + if (h2o_phys) then + call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) endif - !--- read in and initialize aerosols - if (Model%iaerclm) then - call setindxaer (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_aer, & - Grid%jindx2_aer, Grid%ddy_aer, Grid%xlon_d, & - Grid%iindx1_aer, Grid%iindx2_aer, Grid%ddx_aer, & - Model%me, Model%master) +!> - 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, & + me, master) endif - !--- read in and initialize IN and CCN - if (Model%iccn == 1) then - call setindxci (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_ci, & - Grid%jindx2_ci, Grid%ddy_ci, Grid%xlon_d, & - Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci) + +!> - 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 - - !--- initial calculation of maps local ix -> global i and j, store in Tbd + + !--- initial calculation of maps local ix -> global i and j ix = 0 - nb = 1 - do j = 1,Model%ny - do i = 1,Model%nx + do j = 1,ny + do i = 1,nx ix = ix + 1 - if (ix .gt. Model%blksz(nb)) then - ix = 1 - nb = nb + 1 - endif - Tbd%jmap(ix) = j - Tbd%imap(ix) = i + jmap(ix) = j + imap(ix) = i enddo enddo +#if 0 + !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) + ! if (first_time_step) then + ! if (nint(Sfcprop%sncovr(1)) == -9999) then + ! !--- compute sncovr from existing variables + ! !--- code taken directly from read_fix.f + ! do ix = 1, im + ! Sfcprop%sncovr(ix) = 0.0 + ! if (Sfcprop%slmsk(ix) > 0.001) then + ! vegtyp = Sfcprop%vtype(ix) + ! if (vegtyp == 0) vegtyp = 7 + ! rsnow = 0.001*Sfcprop%weasd(ix)/snupx(vegtyp) + ! if (0.001*Sfcprop%weasd(ix) < snupx(vegtyp)) then + ! Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + ! else + ! Sfcprop%sncovr(ix) = 1.0 + ! endif + ! endif + ! enddo + ! ! DH* 20201104: don't forget snocvr_ice for RUC LSM (see FV3GFS_io.F90) + ! endif + ! endif +#endif + is_initialized = .true. - + end subroutine GFS_phys_time_vary_init +!! @} -!> \section arg_table_GFS_phys_time_vary_finalize Argument Table -!! \htmlinclude GFS_phys_time_vary_finalize.html +!> \section arg_table_GFS_phys_time_vary_timestep_init Argument Table +!! \htmlinclude GFS_phys_time_vary_timestep_init.html !! - subroutine GFS_phys_time_vary_finalize(errmsg, errflg) - implicit none +!>\section gen_GFS_phys_time_vary_timestep_init GFS_phys_time_vary_timestep_init General Algorithm +!! @{ + subroutine GFS_phys_time_vary_timestep_init ( & + me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & + imfdeepcnv, cal_pre, random_clds, ntoz, h2o_phys, iaerclm, iccn, clstp, & + jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & + jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & + jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & + imap, jmap, prsl, seed0, rann, errmsg, errflg) - ! Interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + implicit none - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 + ! Interface variables + integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & + nsswr, imfdeepcnv, iccn, ntoz + integer, intent(in) :: idate(:) + real(kind_phys), intent(in) :: fhswr, fhour + logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm + real(kind_phys), intent(out) :: clstp + integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) + real(kind_phys), intent(inout) :: aer_nm(:,:,:) + integer, intent(in) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(in) :: 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(:,:) + ! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg - if (.not.is_initialized) return + ! Local variables + integer :: i, j, k, iseed, iskip, ix, kdt_rad + real(kind=kind_phys) :: sec_zero, rsnow + real(kind=kind_phys) :: wrk(1) + real(kind=kind_phys) :: rannie(cny) + real(kind=kind_phys) :: rndval(cnx*cny*nrcm) - ! Deallocate ozone arrays - if (allocated(oz_lat) ) deallocate(oz_lat) - if (allocated(oz_pres) ) deallocate(oz_pres) - if (allocated(oz_time) ) deallocate(oz_time) - if (allocated(ozplin) ) deallocate(ozplin) + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 - ! Deallocate h2o arrays - if (allocated(h2o_lat) ) deallocate(h2o_lat) - if (allocated(h2o_pres)) deallocate(h2o_pres) - if (allocated(h2o_time)) deallocate(h2o_time) - if (allocated(h2oplin) ) deallocate(h2oplin) + ! 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 - ! Deallocate aerosol arrays - if (allocated(aerin) ) deallocate(aerin) - if (allocated(aer_pres)) deallocate(aer_pres) + !--- 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 - ! Deallocate IN and CCN arrays - if (allocated(ciplin) ) deallocate(ciplin) - if (allocated(ccnin) ) deallocate(ccnin) - if (allocated(ci_pres) ) deallocate(ci_pres) + !--- 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 - is_initialized = .false. + 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 - end subroutine GFS_phys_time_vary_finalize + endif ! imfdeepcnv, cal_re, random_clds -!> \section arg_table_GFS_phys_time_vary_run Argument Table -!! \htmlinclude GFS_phys_time_vary_run.html -!! - subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Diag, first_time_step, errmsg, errflg) - - use mersenne_twister, only: random_setseed, random_number - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & - GFS_Tbd_type, GFS_sfcprop_type, & - GFS_cldprop_type, GFS_diag_type, & - GFS_statein_type - - implicit none - - type(GFS_grid_type), intent(in) :: Grid - type(GFS_statein_type), intent(in) :: Statein - type(GFS_control_type), intent(inout) :: Model - type(GFS_tbd_type), intent(inout) :: Tbd - type(GFS_sfcprop_type), intent(inout) :: Sfcprop - type(GFS_cldprop_type), intent(inout) :: Cldprop - type(GFS_diag_type), intent(inout) :: Diag - logical, intent(in) :: first_time_step - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - 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 - - integer :: i, j, k, iseed, iskip, ix, nb, kdt_rad, vegtyp - real(kind=kind_phys) :: sec_zero, rsnow - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(Model%cny) - real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) - - ! 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_run called before GFS_phys_time_vary_init" - errflg = 1 - return - end if - - nb = 1 - - !--- switch for saving convective clouds - cnvc90.f - !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then - !--- initialize,accumulate,convert - Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (mod(Model%kdt,Model%nsswr) == 0) then - !--- accumulate,convert - Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (Model%lsswr) then - !--- initialize,accumulate - Model%clstp = 1100 - else - !--- accumulate - Model%clstp = 0100 - endif - - !--- random number needed for RAS and old SAS and when cal_pre=.true. - if ( (Model%imfdeepcnv <= 0 .or. Model%cal_pre) .and. Model%random_clds ) then - iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 - call random_setseed(iseed) - call random_number(wrk) - do i = 1,Model%cnx*Model%nrcm - iseed = iseed + nint(wrk(1)*1000.0) * i - call random_setseed(iseed) - call random_number(rannie) - rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) - enddo +!> - Call ozinterpol() to make ozone interpolation + if (ntoz > 0) then + call ozinterpol (me, im, idate, fhour, & + jindx1_o3, jindx2_o3, & + ozpl, ddy_o3) + endif - do k = 1,Model%nrcm - iskip = (k-1)*Model%cnx*Model%cny - do ix=1,Model%blksz(nb) - j = Tbd%jmap(ix) - i = Tbd%imap(ix) - Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) - enddo - enddo - endif ! imfdeepcnv, cal_re, random_clds - - !--- o3 interpolation - if (Model%ntoz > 0) then - call ozinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Grid%jindx1_o3, Grid%jindx2_o3, Tbd%ozpl, Grid%ddy_o3) - endif - - !--- h2o interpolation - if (Model%h2o_phys) then - call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Grid%jindx1_h, Grid%jindx2_h, Tbd%h2opl, Grid%ddy_h) - endif - - !--- aerosol interpolation - if (Model%iaerclm) then - call aerinterpol (Model%me, Model%master, Model%blksz(nb), & - Model%idate, Model%fhour, & - Grid%jindx1_aer, Grid%jindx2_aer, & - Grid%ddy_aer,Grid%iindx1_aer, & - Grid%iindx2_aer,Grid%ddx_aer, & - Model%levs,Statein%prsl, & - Tbd%aer_nm) - endif - !--- ICCN interpolation - if (Model%iccn == 1) then - call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Grid%jindx1_ci, Grid%jindx2_ci, & - Grid%ddy_ci,Grid%iindx1_ci, & - Grid%iindx2_ci,Grid%ddx_ci, & - Model%levs,Statein%prsl, & - Tbd%in_nm, Tbd%ccn_nm) - endif - - !--- original FV3 code, not needed for SCM; also not compatible with the way - ! the time vary steps are run (over each block) --> cannot use - !--- repopulate specific time-varying sfc properties for AMIP/forecast runs - !if (Model%nscyc > 0) then - ! if (mod(Model%kdt,Model%nscyc) == 1) THEN - ! call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) - ! endif +!> - Call h2ointerpol() to make stratospheric water vapor data interpolation + if (h2o_phys) then + call h2ointerpol (me, im, idate, fhour, & + jindx1_h, jindx2_h, & + h2opl, ddy_h) + endif + +!> - Call aerinterpol() to make aerosol interpolation + if (iaerclm) then + call aerinterpol (me, master, im, idate, fhour, & + jindx1_aer, jindx2_aer, & + ddy_aer, iindx1_aer, & + iindx2_aer, ddx_aer, & + levs, prsl, aer_nm) + endif + +!> - Call ciinterpol() to make IN and CCN data interpolation + if (iccn == 1) then + call ciinterpol (me, im, idate, fhour, & + jindx1_ci, jindx2_ci, & + ddy_ci, iindx1_ci, & + iindx2_ci, ddx_ci, & + levs, prsl, in_nm, ccn_nm) + endif + +! Not needed for SCM: +!> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs + !if (nscyc > 0) then + ! if (mod(kdt,nscyc) == 1) THEN + ! call gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, & + ! input_nml_file, lsoil, lsoil_lsm, kice, idate, ialb, isot, ivegsrc, & + ! use_ufo, nst_anl, fhcyc, phour, lakefrac, min_seaice, min_lakeice, & + ! frac_grid, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, tsfc, & + ! tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, & + ! zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, & + ! stype, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf, & + ! xlat_d, xlon_d, slmsk, imap, jmap) + ! endif !endif - !--- determine if diagnostics buckets need to be cleared - sec_zero = nint(Model%fhzero*con_hr) - if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - if (mod(Model%kdt,Model%nszero) == 0) then - call Diag%rad_zero (Model) - call Diag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - endif - else - if (mod(Model%kdt,Model%nszero) == 0) then - call Diag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - endif - kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt, kdt_rad) == 0) then - call Diag%rad_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - endif - endif + end subroutine GFS_phys_time_vary_timestep_init +!! @} -#if 0 - !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) - if (first_time_step) then - if (nint(Sfcprop%sncovr(1)) == -9999) then - !--- compute sncovr from existing variables - !--- code taken directly from read_fix.f - do ix = 1, Model%blksz(nb) - Sfcprop%sncovr(ix) = 0.0 - if (Sfcprop%slmsk(ix) > 0.001) then - vegtyp = Sfcprop%vtype(ix) - if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*Sfcprop%weasd(ix)/snupx(vegtyp) - if (0.001*Sfcprop%weasd(ix) < snupx(vegtyp)) then - Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) - else - Sfcprop%sncovr(ix) = 1.0 - endif - endif - enddo - ! DH* 20201104: don't forget snocvr_ice for RUC LSM (see FV3GFS_io.F90) - endif - endif -#endif +!> \section arg_table_GFS_phys_time_vary_timestep_finalize Argument Table +!! \htmlinclude GFS_phys_time_vary_timestep_finalize.html +!! +!>\section gen_GFS_phys_time_vary_timestep_finalize GFS_phys_time_vary_timestep_finalize General Algorithm +!! @{ + subroutine GFS_phys_time_vary_timestep_finalize (errmsg, errflg) + + implicit none + + ! Interface variables + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine GFS_phys_time_vary_timestep_finalize +!! @} - end subroutine GFS_phys_time_vary_run +!> \section arg_table_GFS_phys_time_vary_finalize Argument Table +!! \htmlinclude GFS_phys_time_vary_finalize.html +!! + subroutine GFS_phys_time_vary_finalize(errmsg, errflg) + + implicit none + + ! Interface variables + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + ! Deallocate ozone arrays + if (allocated(oz_lat) ) deallocate(oz_lat) + if (allocated(oz_pres) ) deallocate(oz_pres) + if (allocated(oz_time) ) deallocate(oz_time) + if (allocated(ozplin) ) deallocate(ozplin) + + ! Deallocate h2o arrays + if (allocated(h2o_lat) ) deallocate(h2o_lat) + if (allocated(h2o_pres)) deallocate(h2o_pres) + if (allocated(h2o_time)) deallocate(h2o_time) + if (allocated(h2oplin) ) deallocate(h2oplin) + + ! 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) + + is_initialized = .false. + + end subroutine GFS_phys_time_vary_finalize - end module GFS_phys_time_vary + end module GFS_phys_time_vary +!> @} diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 556aa80c7..cf0b3afbd 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -7,38 +7,306 @@ [ccpp-arg-table] name = GFS_phys_time_vary_init type = scheme -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT + +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () - type = GFS_grid_type - intent = inout + type = integer + intent = in optional = F -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Interstitial] - standard_name = GFS_interstitial_type_instance - long_name = Fortran DDT containing FV3-GFS interstitial data - units = DDT +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index dimensions = () - type = GFS_interstitial_type - intent = inout + type = integer + intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS miscellaneous data - units = DDT +[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 + optional = F +[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 + optional = F +[iccn] + standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = none dimensions = () - type = GFS_tbd_type + type = integer + intent = in + optional = F +[iflip] + standard_name = flag_for_vertical_index_direction_control + long_name = iflip - is not the same as flipv + units = flag + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[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 + optional = F +[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 + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[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 + optional = F +[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 + optional = F +[jindx1_o3] + standard_name = lower_ozone_interpolation_index + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_o3] + standard_name = upper_ozone_interpolation_index + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_o3] + standard_name = ozone_interpolation_weight + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_h] + standard_name = lower_water_vapor_interpolation_index + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_h] + standard_name = upper_water_vapor_interpolation_index + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_h] + standard_name = water_vapor_interpolation_weight + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[h2opl] + standard_name = h2o_forcing + long_name = water forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_aer] + standard_name = lower_aerosol_y_interpolation_index + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_aer] + standard_name = upper_aerosol_y_interpolation_index + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_aer] + standard_name = aerosol_y_interpolation_weight + 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 = F +[iindx1_aer] + standard_name = lower_aerosol_x_interpolation_index + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[iindx2_aer] + standard_name = upper_aerosol_x_interpolation_index + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddx_aer] + standard_name = aerosol_x_interpolation_weight + 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 = F +[aer_nm] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys intent = in optional = F +[jindx1_ci] + standard_name = lower_cloud_nuclei_y_interpolation_index + 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 = F +[jindx2_ci] + standard_name = upper_cloud_nuclei_y_interpolation_index + 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 = F +[ddy_ci] + standard_name = cloud_nuclei_y_interpolation_weight + 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 = F +[iindx1_ci] + standard_name = lower_cloud_nuclei_x_interpolation_index + 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 = F +[iindx2_ci] + standard_name = upper_cloud_nuclei_x_interpolation_index + 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 = F +[ddx_ci] + standard_name = cloud_nuclei_x_interpolation_weight + 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 = F +[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 + optional = F +[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 + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -81,72 +349,432 @@ ######################################################################## [ccpp-arg-table] - name = GFS_phys_time_vary_run + name = GFS_phys_time_vary_timestep_init type = scheme -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () - type = GFS_grid_type + type = integer intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index dimensions = () - type = GFS_statein_type + type = integer intent = in optional = F -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[cnx] + standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face + long_name = number of points in x direction for this cubed sphere face + units = count dimensions = () - type = GFS_control_type - intent = inout + type = integer + intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS miscellaneous data - units = DDT +[cny] + standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face + long_name = number of points in y direction for this cubed sphere face + units = count dimensions = () - type = GFS_tbd_type - intent = inout + type = integer + intent = in optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = Fortran DDT containing FV3-GFS surface fields - units = DDT +[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 = GFS_sfcprop_type - intent = inout + type = integer + intent = in optional = F -[Cldprop] - standard_name = GFS_cldprop_type_instance - long_name = Fortran DDT containing FV3-GFS cloud fields - units = DDT +[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 = GFS_cldprop_type - intent = inout + type = integer + intent = in optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = Fortran DDT containing FV3-GFS fields targeted for diagnostic output - units = DDT +[nrcm] + standard_name = array_dimension_of_random_number + long_name = second dimension of random number stream for RAS + units = count dimensions = () - type = GFS_diag_type - intent = inout + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[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 + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[cal_pre] + standard_name = flag_for_precipitation_type_algorithm + long_name = flag controls precip type algorithm + units = flag + dimensions = () + type = logical + intent = in + optional = F +[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 + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[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 optional = F -[first_time_step] - standard_name = flag_for_first_time_step - long_name = flag for first time step for time integration loop (cold/warmstart) +[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 optional = F +[iccn] + standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = none + dimensions = () + type = integer + intent = in + optional = F +[clstp] + standard_name = convective_cloud_switch + long_name = index used by cnvc90 (for convective clouds) + units = none + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[jindx1_o3] + standard_name = lower_ozone_interpolation_index + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_o3] + standard_name = upper_ozone_interpolation_index + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_o3] + standard_name = ozone_interpolation_weight + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_h] + standard_name = lower_water_vapor_interpolation_index + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_h] + standard_name = upper_water_vapor_interpolation_index + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_h] + standard_name = water_vapor_interpolation_weight + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[h2opl] + standard_name = h2o_forcing + long_name = water forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_aer] + standard_name = lower_aerosol_y_interpolation_index + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_aer] + standard_name = upper_aerosol_y_interpolation_index + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_aer] + standard_name = aerosol_y_interpolation_weight + 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 = F +[iindx1_aer] + standard_name = lower_aerosol_x_interpolation_index + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[iindx2_aer] + standard_name = upper_aerosol_x_interpolation_index + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddx_aer] + standard_name = aerosol_x_interpolation_weight + 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 = F +[aer_nm] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_ci] + standard_name = lower_cloud_nuclei_y_interpolation_index + 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 = F +[jindx2_ci] + standard_name = upper_cloud_nuclei_y_interpolation_index + 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 = F +[ddy_ci] + standard_name = cloud_nuclei_y_interpolation_weight + 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 = F +[iindx1_ci] + standard_name = lower_cloud_nuclei_x_interpolation_index + 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 = F +[iindx2_ci] + standard_name = upper_cloud_nuclei_x_interpolation_index + 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 = F +[ddx_ci] + standard_name = cloud_nuclei_x_interpolation_weight + 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 = F +[in_nm] + standard_name = ice_nucleation_number + long_name = ice nucleation number in MG MP + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ccn_nm] + standard_name = tendency_of_ccn_activated_number + long_name = tendency of ccn activated number + units = kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[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 + optional = F +[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 + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[seed0] + standard_name = seed_random_numbers_RAS + long_name = random number seed for the RAS scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[rann] + standard_name = random_number_array + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,array_dimension_of_random_number) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -164,3 +792,25 @@ type = integer intent = out optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_phys_time_vary_timestep_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index 9d7302beb..38b9c9508 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -1,90 +1,92 @@ !>\file GFS_rad_time_vary.F90 !! Contains code related to GFS physics suite setup (radiation part of time_vary_step) - module GFS_rad_time_vary + module GFS_rad_time_vary implicit none private - public GFS_rad_time_vary_init, GFS_rad_time_vary_run, GFS_rad_time_vary_finalize + public GFS_rad_time_vary_timestep_init contains -!>\defgroup GFS_rad_time_vary GFS RRTMG Update -!!\ingroup RRTMG -!! @{ - subroutine GFS_rad_time_vary_init - end subroutine GFS_rad_time_vary_init - -!> \section arg_table_GFS_rad_time_vary_run Argument Table -!! \htmlinclude GFS_rad_time_vary_run.html +!>\defgroup mod_GFS_rad_time_vary GFS Radiation Time Update +!> @{ +!> \section arg_table_GFS_rad_time_vary_timestep_init Argument Table +!! \htmlinclude GFS_rad_time_vary_timestep_init.html !! - subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) - - use physparam, only: ipsd0, ipsdlim, iaerflg - use mersenne_twister, only: random_setseed, random_index, random_stat - use machine, only: kind_phys - use GFS_typedefs, only: GFS_statein_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_tbd_type - use radcons, only: qmin, con_100 - - implicit none - - type(GFS_control_type), intent(inout) :: Model - type(GFS_statein_type), intent(in) :: Statein - type(GFS_tbd_type), intent(inout) :: Tbd - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - !--- local variables - type (random_stat) :: stat - integer :: ix, nb, j, i, nblks, ipseed - integer :: numrdm(Model%cnx*Model%cny*2) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - nb = 1 - - if (Model%lsswr .or. Model%lslwr) then - - !--- call to GFS_radupdate_run is now in GFS_rrtmg_setup_run - - !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) - if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then - ipseed = mod(nint(con_100*sqrt(Model%sec)), ipsdlim) + 1 + ipsd0 - call random_setseed (ipseed, stat) - call random_index (ipsdlim, numrdm, stat) - - !--- set the random seeds for each column in a reproducible way - do ix=1,Model%blksz(nb) - j = Tbd%jmap(ix) - i = Tbd%imap(ix) - !--- for testing purposes, replace numrdm with '100' - Tbd%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) - Tbd%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) - enddo - endif ! isubc_lw and isubc_sw - - if (Model%imp_physics == 99) then - if (Model%kdt == 1) then - Tbd%phy_f3d(:,:,1) = Statein%tgrs - Tbd%phy_f3d(:,:,2) = max(qmin,Statein%qgrs(:,:,1)) - Tbd%phy_f3d(:,:,3) = Statein%tgrs - Tbd%phy_f3d(:,:,4) = max(qmin,Statein%qgrs(:,:,1)) - Tbd%phy_f2d(:,1) = Statein%prsi(:,1) - Tbd%phy_f2d(:,2) = Statein%prsi(:,1) - endif - endif - - endif - - end subroutine GFS_rad_time_vary_run - - subroutine GFS_rad_time_vary_finalize() - end subroutine GFS_rad_time_vary_finalize -!! @} - end module GFS_rad_time_vary + subroutine GFS_rad_time_vary_timestep_init ( & + lslwr, lsswr, isubc_lw, isubc_sw, icsdsw, icsdlw, cnx, cny, isc, jsc, & + imap, jmap, sec, kdt, imp_physics, imp_physics_zhao_carr, ps_2delt, & + ps_1delt, t_2delt, t_1delt, qv_2delt, qv_1delt, t, qv, ps, errmsg, errflg) + + use physparam, only: ipsd0, ipsdlim, iaerflg + 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 + integer, intent(in) :: isubc_lw, isubc_sw, cnx, cny, isc, jsc, kdt + integer, intent(in) :: imp_physics, imp_physics_zhao_carr + logical, intent(in) :: lslwr, lsswr + integer, intent(inout) :: icsdsw(:), icsdlw(:) + integer, intent(in) :: imap(:), jmap(:) + real(kind_phys), intent(in) :: sec + real(kind_phys), intent(inout) :: ps_2delt(:) + real(kind_phys), intent(inout) :: ps_1delt(:) + real(kind_phys), intent(inout) :: t_2delt(:,:) + real(kind_phys), intent(inout) :: t_1delt(:,:) + real(kind_phys), intent(inout) :: qv_2delt(:,:) + real(kind_phys), intent(inout) :: 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 + 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 + + 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 = max(qmin,qv) + qv_1delt = max(qmin,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/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta index b78be178a..ffe33810c 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/GFS_rad_time_vary.scm.meta @@ -5,32 +5,218 @@ ######################################################################## [ccpp-arg-table] - name = GFS_rad_time_vary_run + name = GFS_rad_time_vary_timestep_init type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_control_type + type = logical + intent = in + optional = F +[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 + optional = F +[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 + optional = F +[icsdsw] + standard_name = seed_random_numbers_sw + long_name = random seeds for sub-column cloud generators sw + units = none + dimensions = (horizontal_dimension) + type = integer intent = inout optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = Fortran DDT containing FV3-GFS prognostic state data in from dycore - units = DDT +[icsdlw] + standard_name = seed_random_numbers_lw + long_name = random seeds for sub-column cloud generators lw + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[cnx] + standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in + optional = F +[cny] + standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face + long_name = number of points in y direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in + optional = F +[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 + optional = F +[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 + optional = F +[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 + optional = F +[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 + optional = F +[sec] + standard_name = seconds_elapsed_since_model_initialization + long_name = seconds elapsed since model initialization + units = s dimensions = () - type = GFS_statein_type + type = real + kind = kind_phys intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS data not yet assigned to a defined container - units = DDT +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag dimensions = () - type = GFS_tbd_type + type = integer + intent = in + optional = F +[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 = F +[ps_1delt] + standard_name = surface_air_pressure_at_previous_timestep + long_name = surface air pressure at previous timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys intent = inout optional = F +[t_2delt] + standard_name = air_temperature_two_timesteps_back + long_name = air temperature two timesteps back + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t_1delt] + standard_name = air_temperature_at_previous_timestep + long_name = air temperature at previous timestep + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qv_2delt] + standard_name = water_vapor_specific_humidity_two_timesteps_back + long_name = water vapor specific humidity two timesteps back + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qv_1delt] + standard_name = water_vapor_specific_humidity_at_previous_timestep + long_name = water vapor specific humidity at previous timestep + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qv] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[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 + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/GFS_time_vary_pre.scm.F90 index ad98b14e3..365bd2c56 100644 --- a/physics/GFS_time_vary_pre.scm.F90 +++ b/physics/GFS_time_vary_pre.scm.F90 @@ -9,7 +9,7 @@ module GFS_time_vary_pre private - public GFS_time_vary_pre_init, GFS_time_vary_pre_run, GFS_time_vary_pre_finalize + public GFS_time_vary_pre_init, GFS_time_vary_pre_timestep_init, GFS_time_vary_pre_finalize logical :: is_initialized = .false. @@ -62,10 +62,10 @@ subroutine GFS_time_vary_pre_finalize(errmsg, errflg) end subroutine GFS_time_vary_pre_finalize -!> \section arg_table_GFS_time_vary_pre_run Argument Table -!! \htmlinclude GFS_time_vary_pre_run.html +!> \section arg_table_GFS_time_vary_pre_timestep_init Argument Table +!! \htmlinclude GFS_time_vary_pre_timestep_init.html !! - subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & + subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & nslwr, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, kdt, & julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) @@ -104,7 +104,7 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & ! Check initialization status if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_run called & + write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_timestep_init called & &before GFS_time_vary_pre_init" errflg = 1 return @@ -185,6 +185,6 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & print *,' solhr ', solhr endif - end subroutine GFS_time_vary_pre_run + end subroutine GFS_time_vary_pre_timestep_init end module GFS_time_vary_pre diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/GFS_time_vary_pre.scm.meta index 6241e29f1..5033f7988 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/GFS_time_vary_pre.scm.meta @@ -49,7 +49,7 @@ ######################################################################## [ccpp-arg-table] - name = GFS_time_vary_pre_run + name = GFS_time_vary_pre_timestep_init type = scheme [jdat] standard_name = forecast_date_and_time From 162a47a8ddd0f0c6828543ecccda552f3f55b5f0 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Mon, 1 Mar 2021 14:27:34 -0700 Subject: [PATCH 2/3] revert testing changes to CMakeLists.txt --- CMakeLists.txt | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4dedf715a..441f047f6 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -72,8 +72,7 @@ set(TYPEDEFS $ENV{CCPP_TYPEDEFS}) if(TYPEDEFS) message(STATUS "Got CCPP TYPEDEFS from environment variable: ${TYPEDEFS}") else(TYPEDEFS) - #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) - include(./CCPP_TYPEDEFS.cmake) + include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) message(STATUS "Got CCPP TYPEDEFS from cmakefile include file: ${TYPEDEFS}") endif(TYPEDEFS) @@ -89,8 +88,7 @@ set(SCHEMES $ENV{CCPP_SCHEMES}) if(SCHEMES) message(STATUS "Got CCPP SCHEMES from environment variable: ${SCHEMES}") else(SCHEMES) - #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) - include(./CCPP_SCHEMES.cmake) + include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) message(STATUS "Got CCPP SCHEMES from cmakefile include file: ${SCHEMES}") endif(SCHEMES) @@ -99,8 +97,7 @@ set(CAPS $ENV{CCPP_CAPS}) if(CAPS) message(STATUS "Got CCPP CAPS from environment variable: ${CAPS}") else(CAPS) - #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) - include(./CCPP_CAPS.cmake) + include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) message(STATUS "Got CCPP CAPS from cmakefile include file: ${CAPS}") endif(CAPS) From 8010a66d7f7724d4df896995dc26196e199c0c1e Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 2 Mar 2021 10:52:05 -0700 Subject: [PATCH 3/3] fix Doxygen 'file' comments --- physics/GFS_rad_time_vary.scm.F90 | 2 +- physics/GFS_time_vary_pre.scm.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index 38b9c9508..d7d4cda26 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -1,4 +1,4 @@ -!>\file GFS_rad_time_vary.F90 +!>\file GFS_rad_time_vary.scm.F90 !! Contains code related to GFS physics suite setup (radiation part of time_vary_step) module GFS_rad_time_vary diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/GFS_time_vary_pre.scm.F90 index 365bd2c56..c4c235f61 100644 --- a/physics/GFS_time_vary_pre.scm.F90 +++ b/physics/GFS_time_vary_pre.scm.F90 @@ -1,4 +1,4 @@ -!> \file GFS_time_vary_pre.F90 +!> \file GFS_time_vary_pre.scm.F90 !! Contains code related to GFS physics suite setup (generic part of time_vary_step) module GFS_time_vary_pre