Skip to content

Commit

Permalink
Merge pull request #133 from climbfuji/gcycle-and-time-vary-steps-dom…
Browse files Browse the repository at this point in the history 
…-20180724

GFS_time_vary CCPP compliant, part 1
  • Loading branch information
@climbfuji
climbfuji authored Jul 27, 2018
2 parents c30620b + 126e154 commit b926ac2
Show file tree
Hide file tree
Showing 11 changed files with 424 additions and 565 deletions.
2 changes: 0 additions & 2 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,4 @@

This repository contains the GFS Physics scheme.

It is a replication of the gfsphysics directory below the FV3 (version 0)
directory in [VLAB](https://vlab.ncep.noaa.gov/git/fv3-ext).

128 changes: 24 additions & 104 deletions physics/GFS_phys_time_vary.fv3.f90
View file
Original file line number Diff line number Diff line change
@@ -1,124 +1,44 @@
!> \file GFS_phys_time_vary.f90
!! Contains code related to GFS physics suite setup (physics part of time_vary_step)

module GFS_phys_time_vary_1
module GFS_phys_time_vary

contains

subroutine GFS_phys_time_vary_1_init ()
end subroutine GFS_phys_time_vary_1_init

subroutine GFS_phys_time_vary_1_finalize()
end subroutine GFS_phys_time_vary_1_finalize

!> \section arg_table_GFS_phys_time_vary_1_run Argument Table
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------|
!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | 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_phys_time_vary_1_run (Model, errmsg, errflg)

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

implicit none

type(GFS_control_type), intent(inout) :: Model
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)

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

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

end module GFS_phys_time_vary_1
private

module GFS_phys_time_vary_2
public GFS_phys_time_vary_init, GFS_phys_time_vary_run, GFS_phys_time_vary_finalize

contains

subroutine GFS_phys_time_vary_2_init ()
end subroutine GFS_phys_time_vary_2_init
subroutine GFS_phys_time_vary_init ()
end subroutine GFS_phys_time_vary_init

subroutine GFS_phys_time_vary_2_finalize()
end subroutine GFS_phys_time_vary_2_finalize
subroutine GFS_phys_time_vary_finalize()
end subroutine GFS_phys_time_vary_finalize

!> \section arg_table_GFS_phys_time_vary_2_run Argument Table
!> \section arg_table_GFS_phys_time_vary_run Argument Table
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|----------|------|-----------------------|-----------|--------|----------|
!! | Grid | FV3-GFS_Grid_type_all_blocks | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 1 | GFS_grid_type | | in | F |
!! | Data | FV3-GFS_Data_type_all_blocks | Fortran DDT containing FV3-GFS data | DDT | 1 | GFS_data_type | | inout | F |
!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F |
!! | Tbd | FV3-GFS_Tbd_type_all_blocks | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 1 | GFS_tbd_type | | inout | F |
!! | Sfcprop | FV3-GFS_Sfcprop_type_all_blocks | Fortran DDT containing FV3-GFS surface fields | DDT | 1 | GFS_sfcprop_type | | inout | F |
!! | Cldprop | FV3-GFS_Cldprop_type_all_blocks | Fortran DDT containing FV3-GFS cloud fields | DDT | 1 | GFS_cldprop_type | | inout | F |
!! | Diag | FV3-GFS_Diag_type_all_blocks | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 1 | GFS_diag_type | | inout | 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_phys_time_vary_2_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, errmsg, errflg)
subroutine GFS_phys_time_vary_run (Data, Model, errmsg, errflg)

use mersenne_twister, only: random_setseed, random_number
use machine, only: kind_phys
use physcons, only: dxmin, dxinv
use GFS_typedefs, only: GFS_control_type, GFS_grid_type, &
GFS_tbd_type, GFS_sfcprop_type, &
GFS_cldprop_type, GFS_diag_type
use GFS_typedefs, only: GFS_control_type, GFS_data_type

implicit none

type(GFS_grid_type), intent(in) :: Grid(:)
! Interface variables
type(GFS_data_type), intent(in) :: Data(:)
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(:)
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

! Local variables
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
Expand Down Expand Up @@ -176,7 +96,7 @@ subroutine GFS_phys_time_vary_2_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, e
ix = 1
nb = nb + 1
endif
Tbd(nb)%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip)
Data(nb)%Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip)
enddo
enddo
enddo
Expand All @@ -187,8 +107,8 @@ subroutine GFS_phys_time_vary_2_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, e
! DH* OpenMP?
do nb = 1, nblks
call ozinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, &
Grid(nb)%jindx1_o3, Grid(nb)%jindx2_o3, &
Tbd(nb)%ozpl, Grid(nb)%ddy_o3)
Data(nb)%Grid%jindx1_o3, Data(nb)%Grid%jindx2_o3, &
Data(nb)%Tbd%ozpl, Data(nb)%Grid%ddy_o3)
enddo
endif

Expand All @@ -197,28 +117,28 @@ subroutine GFS_phys_time_vary_2_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, e
! DH* OpenMP?
do nb = 1, nblks
call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, &
Grid(nb)%jindx1_h, Grid(nb)%jindx2_h, &
Tbd(nb)%h2opl, Grid(nb)%ddy_h)
Data(nb)%Grid%jindx1_h, Data(nb)%Grid%jindx2_h, &
Data(nb)%Tbd%h2opl, Data(nb)%Grid%ddy_h)
enddo
endif

!--- 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(:))
call gcycle (nblks, Model, Data(:)%Grid, Data(:)%Sfcprop, Data(:)%Cldprop)
endif
endif

!--- determine if diagnostics buckets need to be cleared
if (mod(Model%kdt,Model%nszero) == 1) then
! DH* OpenMP?
do nb = 1,nblks
call Diag(nb)%rad_zero (Model)
call Diag(nb)%phys_zero (Model)
call Data(nb)%Intdiag%rad_zero (Model)
call Data(nb)%Intdiag%phys_zero (Model)
!!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED
enddo
endif

end subroutine GFS_phys_time_vary_2_run
end subroutine GFS_phys_time_vary_run

end module GFS_phys_time_vary_2
end module GFS_phys_time_vary
98 changes: 11 additions & 87 deletions physics/GFS_phys_time_vary.scm.f90
View file
Original file line number Diff line number Diff line change
@@ -1,97 +1,21 @@
!> \file GFS_phys_time_vary.f90
!! Contains code related to GFS physics suite setup (physics part of time_vary_step)

module GFS_phys_time_vary_1
module GFS_phys_time_vary

contains

subroutine GFS_phys_time_vary_1_init ()
end subroutine GFS_phys_time_vary_1_init

subroutine GFS_phys_time_vary_1_finalize()
end subroutine GFS_phys_time_vary_1_finalize

!> \section arg_table_GFS_phys_time_vary_1_run Argument Table
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-----------------------|-----------|--------|----------|
!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | inout | F |
!! | Tbd | FV3-GFS_Tbd_type | 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_phys_time_vary_1_run (Model, Tbd, errmsg, errflg)

use machine, only: kind_phys
use GFS_typedefs, only: GFS_control_type, GFS_tbd_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

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)

! Initialize CCPP error handling variables
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
endif

end subroutine GFS_phys_time_vary_1_run

end module GFS_phys_time_vary_1
private

module GFS_phys_time_vary_2
public GFS_phys_time_vary_init, GFS_phys_time_vary_run, GFS_phys_time_vary_finalize

contains

subroutine GFS_phys_time_vary_2_init ()
end subroutine GFS_phys_time_vary_2_init
subroutine GFS_phys_time_vary_init ()
end subroutine GFS_phys_time_vary_init

subroutine GFS_phys_time_vary_2_finalize()
end subroutine GFS_phys_time_vary_2_finalize
subroutine GFS_phys_time_vary_finalize()
end subroutine GFS_phys_time_vary_finalize

!> \section arg_table_GFS_phys_time_vary_2_run Argument Table
!> \section arg_table_GFS_phys_time_vary_run Argument Table
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |----------------|--------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------|
!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_grid_type | | in | F |
Expand All @@ -103,7 +27,7 @@ end subroutine GFS_phys_time_vary_2_finalize
!! | 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_phys_time_vary_2_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, errmsg, errflg)
subroutine GFS_phys_time_vary_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, errmsg, errflg)

use mersenne_twister, only: random_setseed, random_number
use machine, only: kind_phys
Expand Down Expand Up @@ -216,6 +140,6 @@ subroutine GFS_phys_time_vary_2_run (Grid, Model, Tbd, Sfcprop, Cldprop, Diag, e
!!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED
endif

end subroutine GFS_phys_time_vary_2_run
end subroutine GFS_phys_time_vary_run

end module GFS_phys_time_vary_2
end module GFS_phys_time_vary
Loading

0 comments on commit b926ac2

Please sign in to comment.