Skip to content

Commit

Permalink
New functionality that runs all scheme _init routines as part of ccpp…
Browse files Browse the repository at this point in the history 
…_physics_init after an optional/additional init routine XXX specified as <init>XXX</init> in the SDF. For XXX, only the XXX_run function is used. Similarly, all scheme _finalize routines are run as part of ccpp_physics_finalize, before an optional/additional finalize routine YYY specified as <finalize>YYY</finalize> in the SDF. For YYY, only the YYY_run function is used.
  • Loading branch information
@DomHeinzeller
DomHeinzeller committed May 25, 2018
1 parent dea4995 commit 9f2e0f7
Show file tree
Hide file tree
Showing 7 changed files with 393 additions and 127 deletions.
1 change: 1 addition & 0 deletions src/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ set(SOURCES_F90
ccpp_fields.F90
ccpp_memory.F90
ccpp_strings.F90
ccpp_scheme.F90
ccpp_suite.F90
ccpp_types.F90
ccpp_xml.F90
Expand Down
4 changes: 2 additions & 2 deletions src/ccpp_dl.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,13 +20,13 @@ module ccpp_dl
interface
integer(c_int32_t) &
function ccpp_dl_open &
(name, library, version, shdl, lhdl) &
(name, library, version, fhdl, lhdl) &
bind(c, name='ccpp_dl_open')
import :: c_char, c_int32_t, c_ptr
character(kind=c_char), dimension(*) :: name
character(kind=c_char), dimension(*) :: library
character(kind=c_char), dimension(*) :: version
type(c_ptr) :: shdl
type(c_ptr) :: fhdl
type(c_ptr) :: lhdl
end function ccpp_dl_open

Expand Down
6 changes: 3 additions & 3 deletions src/ccpp_dl.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -51,14 +51,14 @@ static const char suffix[] = ".so";
* @param[in] scheme The scheme name to call.
* @param[in] lib The library continaing the physics scheme.
* @param[in] ver The library version number.
* @param[out] shdl The scheme function pointer handle.
* @param[out] fhdl The scheme function pointer handle.
* @param[out] lhdl The library handle.
* @retval 0 If it was sucessful
* @retval 1 If there was an error
**/
int
ccpp_dl_open(const char *scheme, const char *lib, const char *ver,
void **shdl, void **lhdl)
void **fhdl, void **lhdl)
{
int i = 0;
int n = 0;
Expand Down Expand Up @@ -115,7 +115,7 @@ ccpp_dl_open(const char *scheme, const char *lib, const char *ver,
}

dlerror();
*(void **)shdl = dlsym(*lhdl, scheme_cap);
*(void **)fhdl = dlsym(*lhdl, scheme_cap);
if ((error = dlerror()) != NULL) {
warnx("%s", error);
return(EXIT_FAILURE);
Expand Down
131 changes: 94 additions & 37 deletions src/ccpp_fcall.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,8 @@ module ccpp_fcall
only: c_int32_t, c_char, c_ptr, c_loc, c_funptr
use :: ccpp_types, &
only: ccpp_t, ccpp_suite_t, ccpp_group_t, &
ccpp_subcycle_t, ccpp_scheme_t
ccpp_subcycle_t, ccpp_scheme_t, &
CCPP_STAGES, CCPP_DEFAULT_STAGE
use :: ccpp_errors, &
only: ccpp_error, ccpp_debug
use :: ccpp_strings, &
Expand Down Expand Up @@ -46,8 +47,13 @@ subroutine ccpp_physics_init(cdata, ierr)
ierr = 0
call ccpp_debug('Called ccpp_physics_init')

scheme = cdata%suite%init
call ccpp_run_scheme(scheme, cdata, ierr)
! The extra init scheme uses the 'run' stage for the init call
if (allocated(cdata%suite%init%name)) then
scheme = cdata%suite%init
call ccpp_run_scheme(scheme, cdata, stage='run', ierr=ierr)
end if

call ccpp_run_suite(cdata%suite, cdata, stage='init', ierr=ierr)

end subroutine ccpp_physics_init

Expand Down Expand Up @@ -99,24 +105,24 @@ subroutine ccpp_physics_run(cdata, group_name, subcycle_count, scheme_name, ierr

if (present(group_name)) then
! Find the group to run from the suite
group => ccpp_find_group(suite, group_name, ierr)
group => ccpp_find_group(suite, group_name, ierr=ierr)
if (ierr/=0) return
if (present(subcycle_count)) then
! Find the subcycle to run in the current group
subcycle => ccpp_find_subcycle(group, subcycle_count, ierr)
subcycle => ccpp_find_subcycle(group, subcycle_count, ierr=ierr)
if (ierr/=0) return
call ccpp_run_subcycle(subcycle, cdata, ierr)
call ccpp_run_subcycle(subcycle, cdata, ierr=ierr)
else
call ccpp_run_group(group, cdata, ierr)
call ccpp_run_group(group, cdata, ierr=ierr)
end if
else if (present(scheme_name)) then
! Find the scheme to run from the suite
scheme => ccpp_find_scheme(suite, scheme_name, ierr)
scheme => ccpp_find_scheme(suite, scheme_name, ierr=ierr)
if (ierr/=0) return
call ccpp_run_scheme(scheme, cdata, ierr)
call ccpp_run_scheme(scheme, cdata, ierr=ierr)
else
! If none of the optional arguments is present, run the entire suite
call ccpp_run_suite(suite, cdata, ierr)
call ccpp_run_suite(suite, cdata, ierr=ierr)
end if

end subroutine ccpp_physics_run
Expand All @@ -138,8 +144,13 @@ subroutine ccpp_physics_finalize(cdata, ierr)
ierr = 0
call ccpp_debug('Called ccpp_physics_finalize')

scheme = cdata%suite%finalize
call ccpp_run_scheme(scheme, cdata, ierr)
call ccpp_run_suite(cdata%suite, cdata, stage='finalize', ierr=ierr)

! The extra finalize scheme uses the 'run' stage for the finalize call
if (allocated(cdata%suite%finalize%name)) then
scheme = cdata%suite%finalize
call ccpp_run_scheme(scheme, cdata, stage='run', ierr=ierr)
end if

end subroutine ccpp_physics_finalize

Expand All @@ -153,13 +164,15 @@ end subroutine ccpp_physics_finalize
!!
!! @param[in ] suite The suite to run
!! @param[in,out] cdata The CCPP data of type ccpp_t
!! @param[in ] stage The stage for which to run the suite
!! @param[ out] ierr Integer error flag
!
subroutine ccpp_run_suite(suite, cdata, ierr)
subroutine ccpp_run_suite(suite, cdata, stage, ierr)

type(ccpp_suite_t), intent(inout) :: suite
type(ccpp_t), target, intent(inout) :: cdata
integer, intent( out) :: ierr
type(ccpp_suite_t), intent(inout) :: suite
type(ccpp_t), target, intent(inout) :: cdata
character(len=*), intent(in), optional :: stage
integer, intent( out) :: ierr

integer :: i

Expand All @@ -168,7 +181,7 @@ subroutine ccpp_run_suite(suite, cdata, ierr)
call ccpp_debug('Called ccpp_run_suite')

do i=1,suite%groups_max
call ccpp_run_group(suite%groups(i), cdata, ierr)
call ccpp_run_group(suite%groups(i), cdata, stage=stage, ierr=ierr)
if (ierr /= 0) then
return
end if
Expand Down Expand Up @@ -216,13 +229,15 @@ end function ccpp_find_group
!!
!! @param[in ] group The group to run
!! @param[in,out] cdata The CCPP data of type ccpp_t
!! @param[in ] stage The stage for which to run the group
!! @param[ out] ierr Integer error flag
!
subroutine ccpp_run_group(group, cdata, ierr)
subroutine ccpp_run_group(group, cdata, stage, ierr)

type(ccpp_group_t), intent(inout) :: group
type(ccpp_t), target, intent(inout) :: cdata
integer, intent( out) :: ierr
type(ccpp_group_t), intent(inout) :: group
type(ccpp_t), target, intent(inout) :: cdata
character(len=*), intent(in), optional :: stage
integer, intent( out) :: ierr

integer :: i

Expand All @@ -231,7 +246,7 @@ subroutine ccpp_run_group(group, cdata, ierr)
call ccpp_debug('Called ccpp_run_group')

do i=1,group%subcycles_max
call ccpp_run_subcycle(group%subcycles(i), cdata, ierr)
call ccpp_run_subcycle(group%subcycles(i), cdata, stage=stage, ierr=ierr)
if (ierr /= 0) then
return
end if
Expand Down Expand Up @@ -277,13 +292,15 @@ end function ccpp_find_subcycle
!!
!! @param[in ] subcycle The subcycle to run
!! @param[in,out] cdata The CCPP data of type ccpp_t
!! @param[in ] stage The stage for which to run the subcycle
!! @param[ out] ierr Integer error flag
!
subroutine ccpp_run_subcycle(subcycle, cdata, ierr)
subroutine ccpp_run_subcycle(subcycle, cdata, stage, ierr)

type(ccpp_subcycle_t), intent(inout) :: subcycle
type(ccpp_t), target, intent(inout) :: cdata
integer, intent( out) :: ierr
type(ccpp_subcycle_t), intent(inout) :: subcycle
type(ccpp_t), target, intent(inout) :: cdata
character(len=*), intent(in), optional :: stage
integer, intent( out) :: ierr

integer :: i
integer :: j
Expand All @@ -294,7 +311,7 @@ subroutine ccpp_run_subcycle(subcycle, cdata, ierr)

do i=1,subcycle%loop
do j=1,subcycle%schemes_max
call ccpp_run_scheme(subcycle%schemes(j), cdata, ierr)
call ccpp_run_scheme(subcycle%schemes(j), cdata, stage=stage, ierr=ierr)
if (ierr /= 0) then
return
end if
Expand Down Expand Up @@ -348,24 +365,64 @@ end function ccpp_find_scheme
!!
!! @param[in ] scheme The scheme to run
!! @param[in,out] cdata The CCPP data of type ccpp_t
!! @param[in ] stage The stage for which to run the scheme
!! @param[ out] ierr Integer error flag
!
subroutine ccpp_run_scheme(scheme, cdata, ierr)
subroutine ccpp_run_scheme(scheme, cdata, stage, ierr)

type(ccpp_scheme_t), intent(in ) :: scheme
type(ccpp_t), target, intent(inout) :: cdata
integer, intent( out) :: ierr
type(ccpp_scheme_t), intent(in ) :: scheme
type(ccpp_t), target, intent(inout) :: cdata
character(len=*), intent(in), optional :: stage
integer, intent( out) :: ierr

ierr = 0
character(:), allocatable :: stage_local
character(:), allocatable :: function_name
integer :: l

call ccpp_debug('Called ccpp_run_scheme for "' // trim(scheme%name) // '"')
ierr = 0

ierr = ccpp_dl_call(scheme%scheme_hdl, c_loc(cdata))
if (ierr /= 0) then
call ccpp_error('A problem occured calling '// &
trim(scheme%name) //' scheme')
if (present(stage)) then
stage_local = trim(stage)
else
stage_local = trim(CCPP_DEFAULT_STAGE)
end if

call ccpp_debug('Called ccpp_run_scheme for ' // trim(scheme%name) &
//' in stage ' // trim(stage_local))

function_name = trim(scheme%get_function_name(stage_local))

do l=1,scheme%functions_max
associate (f=>scheme%functions(l))
if (trim(function_name) == trim(f%name)) then
ierr = ccpp_dl_call(f%function_hdl, c_loc(cdata))
if (ierr /= 0) then
call ccpp_error('A problem occured calling '// trim(f%name) &
//' of scheme ' // trim(scheme%name) &
//' in stage ' // trim(stage_local))
end if
! Return after calling the scheme, with or without error
return
end if
end associate
end do

! If we reach this point, the required function was not found
ierr = 1
do l=1,size(CCPP_STAGES)
if (trim(stage_local) == trim(CCPP_STAGES(l))) then
! Stage is valid --> problem with the scheme
call ccpp_error('Function ' // trim(function_name) &
//' of scheme ' // trim(scheme%name) &
//' for stage ' // trim(stage_local) &
//' not found in suite')
return
end if
end do
! Stage is invalid
call ccpp_error('Invalid stage ' // trim(stage_local) &
//' requested in ccpp_run_scheme')

end subroutine ccpp_run_scheme

#if 0
Expand Down
Loading

0 comments on commit 9f2e0f7

Please sign in to comment.