Skip to content

Commit

Permalink
updates to SCM-specific 'time_vary' routines
Browse files Browse the repository at this point in the history
  • Loading branch information
@grantfirl
grantfirl committed Feb 25, 2019
1 parent 4fca8c2 commit 207e4c9
Show file tree
Hide file tree
Showing 3 changed files with 115 additions and 99 deletions.
85 changes: 49 additions & 36 deletions physics/GFS_phys_time_vary.scm.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,8 @@ module GFS_phys_time_vary

public GFS_phys_time_vary_init, GFS_phys_time_vary_run, GFS_phys_time_vary_finalize

logical :: is_initialized = .false.

contains

!> \section arg_table_GFS_phys_time_vary_init Argument Table
Expand All @@ -43,13 +45,13 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Tbd, errmsg, errflg)
integer, intent(out) :: errflg

! Local variables
integer :: nb
integer :: i, j, ix, nb

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

nb = Tbd%blkno
nb = 1

if (Model%aero_in) then
! ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90
Expand Down Expand Up @@ -105,6 +107,22 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Tbd, errmsg, errflg)
! Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci)
! endif

!--- initial calculation of maps local ix -> global i and j, store in Tbd
ix = 0
nb = 1
do j = 1,Model%ny
do i = 1,Model%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
enddo
enddo

is_initialized = .true.


end subroutine GFS_phys_time_vary_init
Expand Down Expand Up @@ -156,22 +174,29 @@ subroutine GFS_phys_time_vary_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, err
errmsg = ''
errflg = 0

if (Tbd%blkno==1) then
!--- 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
! 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.
Expand All @@ -186,37 +211,25 @@ subroutine GFS_phys_time_vary_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, err
rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny)
enddo

! DH* TODO - this could be sped up by saving jsc, jec, isc, iec in Tbd (for example)
! and looping just over them; ix would then run from 1 to blksz(nb); one could also
! use OpenMP to speed up this loop or the inside loops *DH
do k = 1,Model%nrcm
iskip = (k-1)*Model%cnx*Model%cny
ix = 0
nb = 1
do j = 1,Model%ny
do i = 1,Model%nx
ix = ix + 1
if (ix .gt. Model%blksz(nb)) then
ix = 1
nb = nb + 1
endif
if (nb == Tbd%blkno) then
Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip)
endif
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
enddo
endif ! imfdeepcnv, cal_re, random_clds

!--- o3 interpolation
if (Model%ntoz > 0) then
call ozinterpol (Model%me, Model%blksz(Tbd%blkno), Model%idate, Model%fhour, &
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(Tbd%blkno), Model%idate, Model%fhour, &
call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, &
Grid%jindx1_h, Grid%jindx2_h, Tbd%h2opl, Grid%ddy_h)
endif

Expand Down
34 changes: 12 additions & 22 deletions physics/GFS_rad_time_vary.scm.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ module GFS_rad_time_vary

contains

!>\defgroup GFS_rad_time_vary GFS RRTMG Update
!>\defgroup GFS_rad_time_vary GFS RRTMG Update
!!\ingroup RRTMG
!! @{
!! \section arg_table_GFS_rad_time_vary_init Argument Table
Expand Down Expand Up @@ -55,6 +55,8 @@ subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg)
errmsg = ''
errflg = 0

nb = 1

if (Model%lsswr .or. Model%lslwr) then

!--- call to GFS_radupdate_run is now in GFS_rrtmg_setup_run
Expand All @@ -64,30 +66,18 @@ subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg)
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
ix = 0
nb = 1
! DH* TODO - this could be sped up by saving jsc, jec, isc, iec in Tbd (for example)
! and looping just over them; ix would then run from 1 to blksz(nb); one could also
! use OpenMP to speed up this loop *DH
do j = 1,Model%ny
do i = 1,Model%nx
ix = ix + 1
if (ix .gt. Model%blksz(nb)) then
ix = 1
nb = nb + 1
endif
if (nb == Tbd%blkno) then
!--- 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)
endif
enddo
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%num_p3d == 4) then
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))
Expand All @@ -101,7 +91,7 @@ subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg)
endif

end subroutine GFS_rad_time_vary_run

!> \section arg_table_GFS_rad_time_vary_finalize Argument Table
!!
subroutine GFS_rad_time_vary_finalize()
Expand Down
95 changes: 54 additions & 41 deletions physics/GFS_time_vary_pre.scm.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,8 @@ module GFS_time_vary_pre

public GFS_time_vary_pre_init, GFS_time_vary_pre_run, GFS_time_vary_pre_finalize

logical :: is_initialized = .false.

contains

!> \section arg_table_GFS_time_vary_pre_init Argument Table
Expand All @@ -30,9 +32,13 @@ subroutine GFS_time_vary_pre_init (errmsg, errflg)
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


Expand All @@ -49,32 +55,34 @@ subroutine GFS_time_vary_pre_finalize(errmsg, errflg)
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! DH* this is the place to deallocate whatever is allocated by gfuncphys() in GFS_time_vary_pre_init

! 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_run Argument Table
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------|
!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F |
!! | Tbd | GFS_tbd_type_instance | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_tbd_type | | in | F |
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!!
subroutine GFS_time_vary_pre_run (Model, Tbd, errmsg, errflg)
subroutine GFS_time_vary_pre_run (Model, errmsg, errflg)

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

implicit none

type(GFS_control_type), intent(inout) :: Model
type(GFS_tbd_type), intent(in) :: Tbd
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

Expand All @@ -86,41 +94,46 @@ subroutine GFS_time_vary_pre_run (Model, Tbd, errmsg, errflg)
errmsg = ''
errflg = 0

if (Tbd%blkno==1) then
!--- Model%jdat is being updated directly inside of FV3GFS_cap.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
!--- 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.

!--- radiation triggers
Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1)
Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1)

!--- 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
endif
! 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"
errflg = 1
return
end if

!--- Model%jdat is being updated directly inside of FV3GFS_cap.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
!--- 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.

!--- radiation triggers
Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1)
Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1)

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

end subroutine GFS_time_vary_pre_run
Expand Down

0 comments on commit 207e4c9

Please sign in to comment.