New functionality that runs all scheme _init routines as part of ccpp_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.

Author: DomHeinzeller

src/CMakeLists.txt

@@ -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

src/ccpp_dl.F90

@@ -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
 

src/ccpp_dl.c

@@ -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;
@@ -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);

src/ccpp_fcall.F90

@@ -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,                                    &
@@ -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
 
@@ -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
@@ -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
 
@@ -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
 
@@ -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
@@ -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
 
@@ -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
@@ -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
@@ -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
@@ -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