Skip to content
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.

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

CCPP API and SDF update #74

Merged
merged 5 commits into from
Apr 25, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
2 changes: 2 additions & 0 deletions CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -110,6 +110,7 @@ set(SOURCES
./physics/num_parthds.F
./physics/gocart_tracer_config_stub.f
./GFS_layer/GFS_initialize_scm.F90
./GFS_layer/GFS_finalize_scm.F90
./physics/cldwat2m_micro.F
./physics/wv_saturation.F
./physics/aer_cloud.F
Expand Down Expand Up @@ -223,6 +224,7 @@ set(CAPS
./physics/zhaocarr_precpd_cap.F90
./physics/sasas_deep_cap.F90
./physics/GFS_initialize_scm_cap.F90
./physics/GFS_finalize_scm_cap.F90
./physics/GFS_DCNV_generic_pre_cap.F90
./physics/gwdc_pre_cap.F90
./physics/zhaocarr_gscond_cap.F90
Expand Down
7 changes: 5 additions & 2 deletions GFS_layer/GFS_abstraction_layer.F90
Original file line number Diff line number Diff line change
Expand Up @@ -15,13 +15,15 @@ module physics_abstraction_layer

#ifdef CCPP
use GFS_driver, only: initialize => GFS_initialize, &
time_vary_step => GFS_time_vary_step
time_vary_step => GFS_time_vary_step, &
finalize => GFS_finalize
#else
use GFS_driver, only: initialize => GFS_initialize, &
time_vary_step => GFS_time_vary_step, &
radiation_step1 => GFS_radiation_driver, &
physics_step1 => GFS_physics_driver, &
physics_step2 => GFS_stochastic_driver
physics_step2 => GFS_stochastic_driver,&
finalize => GFS_finalize
#endif

!----------------------
Expand Down Expand Up @@ -50,6 +52,7 @@ module physics_abstraction_layer
public physics_step1
public physics_step2
#endif
public finalize

CONTAINS

Expand Down
14 changes: 11 additions & 3 deletions GFS_layer/GFS_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -91,14 +91,15 @@ module GFS_driver
public GFS_physics_driver !< physics_driver (was gbphys)
public GFS_stochastic_driver !< stochastic physics
#endif
public GFS_finalize

CONTAINS
!*******************************************************************************************


!--------------
! GFS initialze
!--------------
!---------------
! GFS initialize
!---------------
subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, &
Coupling, Grid, Tbd, Cldprop, Radtend, &
Diag, Interstitial, Init_parm)
Expand Down Expand Up @@ -378,4 +379,11 @@ subroutine GFS_grid_populate (Grid, xlon, xlat, area)

end subroutine GFS_grid_populate


!-------------
! GFS finalize
!-------------
subroutine GFS_finalize ()
end subroutine GFS_finalize

end module GFS_driver
42 changes: 42 additions & 0 deletions GFS_layer/GFS_finalize_scm.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,42 @@
module GFS_finalize_scm

implicit none

private

!----------------
! Public entities
!----------------
public GFS_finalize_scm_init, GFS_finalize_scm_run, GFS_finalize_scm_finalize

CONTAINS
!*******************************************************************************************

!--------------
! GFS initialze
!--------------

subroutine GFS_finalize_scm_init()
end subroutine GFS_finalize_scm_init

subroutine GFS_finalize_scm_finalize()
end subroutine GFS_finalize_scm_finalize

!> \section arg_table_GFS_finalize_scm_run Argument Table
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |----------------------|-------------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------|
!! | errmsg | error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!!
subroutine GFS_finalize_scm_run (errmsg, errflg)

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

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

end subroutine GFS_finalize_scm_run

end module GFS_finalize_scm
88 changes: 61 additions & 27 deletions IPD_layer/IPD_CCPP_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -5,12 +5,16 @@ module IPD_CCPP_driver
IPD_diag_type, IPD_restart_type, &
IPD_interstitial_type

use ccpp_types, only: ccpp_t
use ccpp_errors, only: ccpp_error, ccpp_debug
use ccpp, only: ccpp_init, ccpp_finalize
use ccpp_fcall, only: ccpp_run
use ccpp_fields, only: ccpp_field_add

use ccpp_api, only: ccpp_t, &
ccpp_error, &
ccpp_debug, &
ccpp_init, &
ccpp_finalize, &
ccpp_physics_init, &
ccpp_physics_run, &
ccpp_physics_finalize, &
ccpp_field_add

! Begin include auto-generated list of modules for ccpp
#include "ccpp_modules.inc"
! End include auto-generated list of modules for ccpp
Expand Down Expand Up @@ -59,7 +63,7 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit
real(kind=kind_phys), intent(inout), optional :: l_salp_data
real(kind=kind_phys), intent(inout), optional :: l_snupx(max_vegtyp)
character(len=256), intent(in), optional :: ccpp_suite
integer, intent(in) :: step
character(len=*), intent(in) :: step
integer, intent(out) :: ierr
! Local variables
integer :: nb
Expand All @@ -73,7 +77,7 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit
nThreads = 1
#endif

if (step==0) then
if (trim(step)=="init") then

if (.not. present(Init_parm)) then
call ccpp_error('Error, IPD init step called without mandatory Init_parm argument')
Expand All @@ -88,13 +92,17 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit
ierr = 1
return
else if (.not. present(ccpp_suite)) then
call ccpp_error('Error, IPD init step called without mandatory ccpp_suite argument')
call ccpp_error('Error, IPD init step called without mandatory ccpp_suite argument')
ierr = 1
return
end if

!--- Initialize CCPP framework
call ccpp_init(ccpp_suite, cdata, ierr)
if (ierr/=0) return
if (ierr/=0) then
call ccpp_error('An error occurred in ccpp_init')
return
end if

!--- Add the DDTs to the CCPP data structure for IPD initialization
call ccpp_field_add(cdata, 'IPD_Control', '', c_loc(IPD_Control), ierr=ierr)
Expand All @@ -114,8 +122,12 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit
call ccpp_field_add(cdata, 'snupx', l_snupx, ierr=ierr)
if (ierr/=0) return

call ccpp_run(cdata%suite%init, cdata, ierr)
if (ierr/=0) return
!--- Initialize CCPP physics
call ccpp_physics_init(cdata, ierr)
if (ierr/=0) then
call ccpp_error('An error occurred in ccpp_physics_init')
return
end if

! Allocate cdata structures
allocate(cdata_block(1:nBlocks,1:nThreads))
Expand All @@ -136,14 +148,14 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit
#endif
do nb = 1,nBlocks
#ifndef __PGI
!--- Initialize CCPP, use suite from scalar cdata to avoid reading the SDF multiple times
!--- Initialize CCPP framework for blocks/threads, use suite from scalar cdata to avoid reading the SDF multiple times
call ccpp_init(ccpp_suite, cdata_block(nb,nt), ierr, suite=cdata%suite)
#else
!--- Initialize CCPP, cannot use suite from scalar cdata with PGI (crashes)
!--- Initialize CCPP framework for blocks/threads, cannot use suite from scalar cdata with PGI (crashes)
call ccpp_init(ccpp_suite, cdata_block(nb,nt), ierr)
#endif
if (ierr/=0) then
write(0,'(2(a,i4))') "An error occurred in IPD_step 0 for block ", nb, " and thread ", nt
write(0,'(2(a,i4))') "An error occurred in ccpp_init for block ", nb, " and thread ", nt
exit
end if
! Begin include auto-generated list of calls to ccpp_field_add
Expand All @@ -158,13 +170,17 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit
if (ierr/=0) return

! Time vary steps
else if (step==1) then
else if (trim(step)=="time_vary") then

call ccpp_run(cdata%suite%ipds(step), cdata, ierr)
if (ierr/=0) return
call ccpp_physics_run(cdata, group_name="time_vary", ierr=ierr)
if (ierr/=0) then
write(0,'(a,a)') "An error occurred in IPD time_vary step", &
& "; error message from ccpp_physics_run: ", &
& trim(IPD_Interstitial(nt)%errmsg)
end if

! Radiation, physics and stochastics
else if (step==2 .or. step==3 .or. step==4) then
else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then

!$OMP parallel do num_threads (nThreads) &
!$OMP default (none) &
Expand All @@ -178,17 +194,19 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit
#else
nt = 1
#endif
call ccpp_run(cdata_block(nb,nt)%suite%ipds(step), cdata_block(nb,nt), ierr)
call ccpp_physics_run(cdata_block(nb,nt), group_name=trim(step), ierr=ierr)
if (ierr/=0) then
write(0,'(3(a,i4),a)') "An error occurred in IPD_step ", step, " for block ", nb, " and thread ", nt, &
& "; error message: '" // trim(IPD_Interstitial(nt)%errmsg) // "'"
write(0,'(3a,i0,a,i0,2a)') "An error occurred in IPD ", trim(step), &
& " step for block ", nb, " and thread ", nt, &
& "; error message from ccpp_physics_run: ", &
& trim(IPD_Interstitial(nt)%errmsg)
end if
end do
!$OMP end parallel do
if (ierr/=0) return

! Finalize
else if (step==5) then
else if (trim(step)=="finalize") then

!$OMP parallel num_threads (nThreads) &
!$OMP default (shared) &
Expand All @@ -200,10 +218,18 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit
nt = 1
#endif
do nb = 1,nBlocks
!--- Initialize CCPP
!--- Finalize CCPP physics for blocks/threads
call ccpp_physics_finalize(cdata_block(nb,nt), ierr)
if (ierr/=0) then
write(0,'(a,i4,a,i4)') "An error occurred in ccpp_physics_finalize for block ", nb, " and thread ", nt
exit
end if
end do
do nb = 1,nBlocks
!--- Finalize CCPP framework for blocks/threads
call ccpp_finalize(cdata_block(nb,nt), ierr)
if (ierr/=0) then
write(0,'(a,i4,a,i4)') "An error occurred in IPD_step 5 for block ", nb, " and thread ", nt
write(0,'(a,i4,a,i4)') "An error occurred in ccpp_finalize for block ", nb, " and thread ", nt
exit
end if
end do
Expand All @@ -213,14 +239,22 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit
! Deallocate cdata structure for blocks and threads
deallocate(cdata_block)

!--- Finalize CCPP physics
call ccpp_physics_finalize(cdata, ierr)
if (ierr/=0) then
write(0,'(a)') "An error occurred in ccpp_physics_finalize"
return
end if
!--- Finalize CCPP framework
call ccpp_finalize(cdata, ierr)
if (ierr/=0) then
write(0,'(a)') "An error occurred in IPD_step 5"
write(0,'(a)') "An error occurred in ccpp_finalize"
return
end if

else

call ccpp_error('Error, undefined step for ccpp_run')
write(0,'(2a)') 'Error, undefined IPD step ', trim(step)
ierr = 1
return

Expand Down
16 changes: 13 additions & 3 deletions IPD_layer/IPD_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -5,11 +5,12 @@ module IPD_driver
IPD_diag_type, IPD_restart_type, &
IPD_interstitial_type
#ifdef CCPP
use physics_abstraction_layer, only: initialize, time_vary_step
use physics_abstraction_layer, only: initialize, time_vary_step, &
finalize
#else
use physics_abstraction_layer, only: initialize, time_vary_step, &
radiation_step1, physics_step1, &
physics_step2
physics_step2, finalize
#endif

use physics_diag_layer, only: diag_populate
Expand Down Expand Up @@ -38,13 +39,14 @@ module IPD_driver
public IPD_physics_step1
public IPD_physics_step2
#endif
public IPD_finalize

CONTAINS
!*******************************************************************************************


!----------------
! IPD Initialize
! IPD initialize
!----------------
subroutine IPD_initialize (IPD_control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstitial, IPD_init_parm)
type(IPD_control_type), intent(inout) :: IPD_Control
Expand Down Expand Up @@ -147,4 +149,12 @@ subroutine IPD_physics_step2 (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart)
end subroutine IPD_physics_step2
#endif

!----------------
! IPD finalize
!----------------
subroutine IPD_finalize ()
!--- finalize the physics suite
call finalize ()
end subroutine IPD_finalize

end module IPD_driver
27 changes: 19 additions & 8 deletions IPD_layer/IPD_driver_cap.F90
Original file line number Diff line number Diff line change
Expand Up @@ -19,12 +19,10 @@ module IPD_driver_cap

use, intrinsic :: iso_c_binding, &
only: c_f_pointer, c_ptr, c_int32_t
use :: ccpp_types, &
only: ccpp_t
use :: ccpp_fields, &
only: ccpp_field_get
use :: ccpp_errors, &
only: ccpp_error
use :: ccpp_api, &
only: ccpp_t, &
ccpp_field_get, &
ccpp_error
use :: IPD_typedefs, &
only: IPD_init_type, &
IPD_control_type, &
Expand All @@ -34,7 +32,8 @@ module IPD_driver_cap
IPD_interstitial_type
use :: IPD_driver, &
only: IPD_initialize, &
IPD_setup_step
IPD_setup_step, &
IPD_finalize
use :: machine, &
only: kind_phys
use :: namelist_soilveg, &
Expand All @@ -44,7 +43,8 @@ module IPD_driver_cap
private

public :: ipd_initialize_cap, &
ipd_setup_step_cap
ipd_setup_step_cap, &
ipd_finalize_cap

contains

Expand Down Expand Up @@ -173,4 +173,15 @@ function ipd_setup_step_cap(ptr) bind(c) result(ierr)

end function IPD_setup_step_cap

function ipd_finalize_cap(ptr) bind(c) result(ierr)

integer(c_int32_t) :: ierr
type(c_ptr), intent(inout) :: ptr

ierr = 0

call IPD_finalize()

end function ipd_finalize_cap

end module IPD_driver_cap