Skip to content

Update to SCM version of GFS_time_vary_pre.F90 #321

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
grantfirl merged 3 commits into from
Sep 23, 2019
Merged

Update to SCM version of GFS_time_vary_pre.F90 #321

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
d58c0ea
update SCM version of GFS_time_vary_pre.F90 (matches FV3 version exce…
grantfirl Sep 18, 2019
d5f0275
Merge branch 'gmtb/develop' into noahmp_scm
grantfirl Sep 20, 2019
3db2144
add calculation of snow cover in GFS_phys_time_vary.scm.F90 to match …
grantfirl Sep 20, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
35 changes: 32 additions & 3 deletions physics/GFS_phys_time_vary.scm.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,11 @@ module GFS_phys_time_vary
use iccn_def, only : ciplin, ccnin, ci_pres
use iccninterp, only : read_cidata, setindxci, ciinterpol

#if 0
!--- variables needed for calculating 'sncovr'
use namelist_soilveg, only: salp_data, snupx
#endif

implicit none

private
Expand Down Expand Up @@ -220,7 +225,7 @@ end subroutine GFS_phys_time_vary_finalize
!> \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, errmsg, errflg)
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
Expand All @@ -238,15 +243,16 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop,
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
real(kind=kind_phys) :: sec_zero
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)
Expand Down Expand Up @@ -362,6 +368,29 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop,
!!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED
endif
endif

#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
endif
endif
#endif

end subroutine GFS_phys_time_vary_run

Expand Down
8 changes: 8 additions & 0 deletions physics/GFS_phys_time_vary.scm.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -133,6 +133,14 @@
type = GFS_diag_type
intent = inout
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)
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down
126 changes: 92 additions & 34 deletions physics/GFS_time_vary_pre.scm.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ subroutine GFS_time_vary_pre_init (errmsg, errflg)
errflg = 0

if (is_initialized) return

!--- Call gfuncphys (funcphys.f) to compute all physics function tables.
call gfuncphys ()

Expand Down Expand Up @@ -65,68 +65,126 @@ end subroutine GFS_time_vary_pre_finalize
!> \section arg_table_GFS_time_vary_pre_run Argument Table
!! \htmlinclude GFS_time_vary_pre_run.html
!!
subroutine GFS_time_vary_pre_run (Model, errmsg, errflg)
subroutine GFS_time_vary_pre_run (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)

use machine, only: kind_phys
use GFS_typedefs, only: GFS_control_type

implicit none

type(GFS_control_type), intent(inout) :: Model

integer, intent(in) :: idate(4)
integer, intent(in) :: jdat(1:8), idat(1:8)
integer, intent(in) :: lsm, lsm_noahmp, &
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
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_phys) :: rinc(5)

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_run called before GFS_time_vary_pre_init"
write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_run called &
&before GFS_time_vary_pre_init"
errflg = 1
return
end if

!--- Model%jdat is being updated directly inside of FV3GFS_cap.F90
!--- jdat is being updated directly inside of the time integration
!--- loop of gmtb_scm.F90
!--- update calendars and triggers
rinc(1:5) = 0
call w3difdat(Model%jdat,Model%idat,4,rinc)
Model%sec = rinc(4)
Model%phour = Model%sec/con_hr
call w3difdat(jdat,idat,4,rinc)
sec = rinc(4)
phour = sec/con_hr
!--- set current bucket hour
Model%zhour = Model%phour
Model%fhour = (Model%sec + Model%dtp)/con_hr
Model%kdt = nint((Model%sec + Model%dtp)/Model%dtp)

Model%ipt = 1
Model%lprnt = .false.
Model%lssav = .true.
zhour = phour
fhour = (sec + dtp)/con_hr
kdt = nint((sec + dtp)/dtp)

if(lsm == lsm_noahmp) then
!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
! 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
endif

ipt = 1
lprnt = .false.
lssav = .true.

!--- radiation triggers
Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1)
Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1)
lsswr = (mod(kdt, nsswr) == 1)
lslwr = (mod(kdt, nslwr) == 1)
!--- allow for radiation to be called on every physics time step, if needed
if (Model%nsswr == 1) Model%lsswr = .true.
if (Model%nslwr == 1) Model%lslwr = .true.
if (nsswr == 1) lsswr = .true.
if (nslwr == 1) lslwr = .true.

!--- set the solar hour based on a combination of phour and time initial hour
Model%solhr = mod(Model%phour+Model%idate(1),con_24)

if ((Model%debug) .and. (Model%me == Model%master)) then
print *,' sec ', Model%sec
print *,' kdt ', Model%kdt
print *,' nsswr ', Model%nsswr
print *,' nslwr ', Model%nslwr
print *,' nscyc ', Model%nscyc
print *,' lsswr ', Model%lsswr
print *,' lslwr ', Model%lslwr
print *,' fhour ', Model%fhour
print *,' phour ', Model%phour
print *,' solhr ', Model%solhr
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_run
Expand Down
Loading