module CCPP_driver
#ifdef STATIC
! For static builds, the ccpp_physics_{init,run,finalize} calls
! are not pointing to code in the CCPP framework, but to auto-generated
! ccpp_suite_cap and ccpp_group_*_cap modules behind a ccpp_static_api
use ccpp_api, only: ccpp_t, &
ccpp_init, &
ccpp_finalize, &
ccpp_initialized
use ccpp_static_api, only: ccpp_physics_init, &
ccpp_physics_run, &
ccpp_physics_finalize
#else
use ccpp_api, only: ccpp_t, &
ccpp_init, &
ccpp_finalize, &
ccpp_physics_init, &
ccpp_physics_run, &
ccpp_physics_finalize, &
ccpp_field_add, &
ccpp_initialized, &
ccpp_error
#endif
use CCPP_data, only: cdata_tile, &
cdata_domain, &
cdata_block, &
ccpp_suite, &
GFS_control
#ifndef STATIC
! Begin include auto-generated list of modules for ccpp
#include "ccpp_modules_slow_physics.inc"
! End include auto-generated list of modules for ccpp
use iso_c_binding, only: c_loc
#endif
implicit none
!--------------------------------------------------------!
! Pointer to CCPP containers defined in CCPP_data !
!--------------------------------------------------------!
type(ccpp_t), pointer :: cdata => null()
!--------------------------------------------------------!
! Flag for non-uniform block sizes (last block smaller) !
! and number of OpenMP threads (with special thread !
! number nthrdsX in case of non-uniform block sizes) !
!--------------------------------------------------------!
logical :: non_uniform_blocks
integer :: nthrds, nthrdsX
!----------------
! Public Entities
!----------------
! functions
public CCPP_step
! module variables
public non_uniform_blocks
CONTAINS
!*******************************************************************************************
!-------------------------------
! CCPP step
!-------------------------------
subroutine CCPP_step (step, nblks, ierr)
#ifdef OPENMP
use omp_lib
#endif
implicit none
character(len=*), intent(in) :: step
integer, target, intent(in) :: nblks
integer, intent(out) :: ierr
! Local variables
integer :: nb, nt, ntX
integer :: ierr2
ierr = 0
if (trim(step)=="init") then
! Get and set number of OpenMP threads (module
! variable) that are available to run physics
#ifdef OPENMP
nthrds = omp_get_max_threads()
#else
nthrds = 1
#endif
! For non-uniform blocksizes, we use index nthrds+1
! for the interstitial data type with different length
if (non_uniform_blocks) then
nthrdsX = nthrds+1
else
nthrdsX = nthrds
end if
!--- Initialize CCPP framework, if cdata_tile for fast physics
! is already initialized, use its suite to avoid reading the
! SDF multiple times. Initialize cdata for the entire domain:
if (ccpp_initialized(cdata_tile)) then
call ccpp_init(trim(ccpp_suite), cdata_domain, ierr=ierr, cdata_target=cdata_tile)
else
call ccpp_init(trim(ccpp_suite), cdata_domain, ierr=ierr)
end if
if (ierr/=0) then
write(0,*) 'An error occurred in ccpp_init'
return
end if
! For physics running over the entire domain, block and thread
! number are not used; set to safe values
cdata_domain%blk_no = 1
cdata_domain%thrd_no = 1
#ifndef STATIC
! Associate cdata with the global/domain cdata structure;
! this is needed because ccpp_fields.inc uses 'cdata' in
! its ccpp_field_add statements.
associate_domain: associate (cdata => cdata_domain)
! Begin include auto-generated list of calls to ccpp_field_add
#include "ccpp_fields_slow_physics.inc"
! End include auto-generated list of calls to ccpp_field_add
end associate associate_domain
#endif
! Allocate cdata structures for blocks and threads
allocate(cdata_block(1:nblks,1:nthrdsX))
! Loop over all blocks and threads
do nt=1,nthrdsX
do nb=1,nblks
!--- Initialize CCPP framework for blocks/threads, use suite from scalar cdata
! to avoid reading the SDF multiple times. If cdata_tile is initialized, use
! this version (since cdata_domain is just a copy), otherwise use cdata_domain
if (ccpp_initialized(cdata_tile)) then
call ccpp_init(trim(ccpp_suite), cdata_block(nb,nt), ierr=ierr, cdata_target=cdata_tile)
else
call ccpp_init(trim(ccpp_suite), cdata_block(nb,nt), ierr=ierr, cdata_target=cdata_domain)
end if
if (ierr/=0) then
write(0,'(2(a,i4))') "An error occurred in ccpp_init for block ", nb, " and thread ", nt
return
end if
! Assign the correct block and thread numbers
cdata_block(nb,nt)%blk_no = nb
cdata_block(nb,nt)%thrd_no = nt
#ifndef STATIC
! Associate cdata with the cdata structure for this block
! and thread; this is needed because ccpp_fields.inc uses
! 'cdata' in its ccpp_field_add statements.
associate_block: associate (cdata => cdata_block(nb,nt))
! Begin include auto-generated list of calls to ccpp_field_add
#include "ccpp_fields_slow_physics.inc"
! End include auto-generated list of calls to ccpp_field_add
end associate associate_block
#endif
end do
end do
else if (trim(step)=="physics_init") then
! Since the physics init steps are independent of the blocking structure,
! we can use cdata_domain here. Since we don't use threading on the outside,
! we can allow threading inside the time_vary routines.
GFS_control%nthreads = nthrds
#ifdef STATIC
call ccpp_physics_init(cdata_domain, suite_name=trim(ccpp_suite), ierr=ierr)
#else
call ccpp_physics_init(cdata_domain, ierr=ierr)
#endif
if (ierr/=0) then
write(0,'(a)') "An error occurred in ccpp_physics_init"
write(0,'(a)') trim(cdata_domain%errmsg)
return
end if
else if (trim(step)=="time_vary") then
! Since the time_vary steps only use data structures for all blocks (except the
! CCPP-internal variables ccpp_error_flag and ccpp_error_message, which are defined
! for all cdata structures independently), we can use cdata_domain here.
! Since we don't use threading on the outside, we can allow threading
! inside the time_vary routines.
GFS_control%nthreads = nthrds
#ifdef STATIC
call ccpp_physics_run(cdata_domain, suite_name=trim(ccpp_suite), group_name="time_vary", ierr=ierr)
#else
call ccpp_physics_run(cdata_domain, group_name="time_vary", ierr=ierr)
#endif
if (ierr/=0) then
write(0,'(a)') "An error occurred in ccpp_physics_run for group time_vary"
write(0,'(a)') trim(cdata_domain%errmsg)
return
end if
! Radiation and stochastic physics
else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then
! Set number of threads available to physics schemes to one,
! because threads are used on the outside for blocking
GFS_control%nthreads = 1
!$OMP parallel num_threads (nthrds) &
!$OMP default (shared) &
!$OMP private (nb,nt,ntX,ierr2) &
!$OMP reduction (+:ierr)
#ifdef OPENMP
nt = omp_get_thread_num()+1
#else
nt = 1
#endif
!$OMP do schedule (dynamic,1)
do nb = 1,nblks
! For non-uniform blocks, the last block has a different (shorter)
! length than the other blocks; use special CCPP_Interstitial(nthrdsX)
if (non_uniform_blocks .and. nb==nblks) then
ntX = nthrdsX
else
ntX = nt
end if
!--- Call CCPP radiation/physics/stochastics group
#ifdef STATIC
call ccpp_physics_run(cdata_block(nb,ntX), suite_name=trim(ccpp_suite), group_name=trim(step), ierr=ierr2)
#else
call ccpp_physics_run(cdata_block(nb,ntX), group_name=trim(step), ierr=ierr2)
#endif
if (ierr2/=0) then
write(0,'(2a,3(a,i4),a)') "An error occurred in ccpp_physics_run for group ", trim(step), &
", block ", nb, " and thread ", nt, " (ntX=", ntX, ")"
write(0,'(a)') trim(cdata_block(nb,nt)%errmsg)
ierr = ierr + ierr2
end if
end do
!$OMP end do
!$OMP end parallel
if (ierr/=0) return
! Finalize
else if (trim(step)=="finalize") then
! Loop over blocks, don't use threading on the outside but allowing threading
! inside the finalization, similar to what is done for the initialization
GFS_control%nthreads = nthrds
! Fast physics are finalized in atmosphere_end, loop over
! all blocks and threads to finalize all other physics
do nt=1,nthrdsX
do nb=1,nblks
!--- Finalize CCPP physics
#ifdef STATIC
call ccpp_physics_finalize(cdata_block(nb,nt), suite_name=trim(ccpp_suite), ierr=ierr)
#else
call ccpp_physics_finalize(cdata_block(nb,nt), ierr=ierr)
#endif
if (ierr/=0) then
write(0,'(a,i4,a,i4)') "An error occurred in ccpp_physics_finalize for block ", nb, " and thread ", nt
write(0,'(a)') trim(cdata_block(nb,nt)%errmsg)
return
end if
!--- Finalize CCPP framework for blocks/threads
call ccpp_finalize(cdata_block(nb,nt), ierr=ierr)
if (ierr/=0) then
write(0,'(a,i4,a,i4)') "An error occurred in ccpp_finalize for block ", nb, " and thread ", nt
return
end if
end do
end do
! Deallocate cdata structure for blocks and threads
deallocate(cdata_block)
!--- Finalize CCPP framework for domain
call ccpp_finalize(cdata_domain, ierr=ierr)
if (ierr/=0) then
write(0,'(a)') "An error occurred in ccpp_finalize"
return
end if
!--- Finalize CCPP framework for fast physics last (all other frameworks point to cdata_tile's suite)
if (ccpp_initialized(cdata_tile)) then
call ccpp_finalize(cdata_tile, ierr)
if (ierr/=0) then
write(0,'(a)') "An error occurred in ccpp_finalize"
return
end if
end if
else
write(0,'(2a)') 'Error, undefined CCPP step ', trim(step)
ierr = 1
return
end if
end subroutine CCPP_step
end module CCPP_driver