diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index ec1bf5486..6e58b6452 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -175,14 +175,22 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & enddo #ifdef CCPP + #ifdef OPENMP nthreads = omp_get_max_threads() #else nthreads = 1 #endif + +! Initialize the Interstitial data type in parallel so that +! each thread creates (touches) its Interstitial(nt) first +!$OMP parallel do default (shared) & +!$OMP schedule (static,1) & +!$OMP private (nt) do nt=1,nthreads call Interstitial (nt)%create (blkszmax, Model) enddo +!$OMP end parallel do #endif !--- populate the grid components diff --git a/IPD_layer/IPD_CCPP_driver.F90 b/IPD_layer/IPD_CCPP_driver.F90 index 29295189d..0d05fdc65 100644 --- a/IPD_layer/IPD_CCPP_driver.F90 +++ b/IPD_layer/IPD_CCPP_driver.F90 @@ -4,9 +4,10 @@ module IPD_CCPP_driver IPD_control_type, IPD_data_type, & 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 + use ccpp, only: ccpp_init, ccpp_finalize use ccpp_fcall, only: ccpp_run use ccpp_fields, only: ccpp_field_add @@ -119,34 +120,40 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit ! Allocate cdata structures allocate(cdata_block(1:nBlocks,1:nThreads)) - ! Loop over blocks - in general, cannot use OpenMP for this step; - ! however, threading may be implemented inside the ccpp_init, - ! suite_init and scheme_init routines. - ! DH* is this true? can't we do this in parallel for each thread? + ! Loop over blocks for each of the threads +!$OMP parallel default (shared) & +!$OMP private (nb,nt) & +!$OMP reduction (+:ierr) +#ifdef OPENMP + nt = omp_get_thread_num()+1 +#else + nt = 1 +#endif do nb = 1,nBlocks - do nt = 1,nThreads - !--- Initialize CCPP - call ccpp_init(ccpp_suite, cdata_block(nb,nt), ierr) - if (ierr/=0) return - + !--- Initialize CCPP, 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) + if (ierr/=0) then + write(0,'(2(a,i4))') "An error occurred in IPD_step 0 for block ", nb, " and thread ", nt + exit + end if ! Begin include auto-generated list of calls to ccpp_field_add #include "ccpp_fields.inc" ! End include auto-generated list of calls to ccpp_field_add - - end do end do +!$OMP end parallel + if (ierr/=0) return ! Time vary steps else if (step==1) then - ! Loop over blocks; cannot use OpenMP for this step; however, - ! threading may be implemented inside the IPD_setup_step + ! Loop over blocks; cannot use OpenMP for this step (sfcsub.F!); + ! however, threading may be implemented inside the IPD_setup_step do nb = 1,nBlocks nt = 1 call ccpp_run(cdata_block(nb,nt)%suite%ipds(step), cdata_block(nb,nt), ierr) if (ierr/=0) then - write(0,'(a,i4,a,i4,a)') "An error occurred in IPD_step 1 for block ", nb, " and thread ", nt, & - & "; error message: '" // trim(IPD_Interstitial(nt)%errmsg) // "'" + write(0,'(2(a,i4),a)') "An error occurred in IPD_step 1 for block ", nb, " and thread ", nt, & + & "; error message: '" // trim(IPD_Interstitial(nt)%errmsg) // "'" return end if end do @@ -155,7 +162,7 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit else if (step==2 .or. step==3 .or. step==4) then !$OMP parallel do default (none) & -!$OMP schedule (dynamic,1), & +!$OMP schedule (dynamic,1) & !$OMP shared (nBlocks, cdata_block, step, IPD_Interstitial) & !$OMP private (nb, nt) & !$OMP reduction (+:ierr) @@ -167,8 +174,8 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit #endif call ccpp_run(cdata_block(nb,nt)%suite%ipds(step), cdata_block(nb,nt), ierr) if (ierr/=0) then - write(0,'(a,i4,a,i4,a)') "An error occurred in IPD_step 1 for block ", nb, " and thread ", nt, & - & "; error message: '" // trim(IPD_Interstitial(nt)%errmsg) // "'" + 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) // "'" end if end do !$OMP end parallel do @@ -176,16 +183,43 @@ subroutine IPD_step (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, IPD_Interstit ! Finalize else if (step==5) then - ! DH* ccpp_run(cdata%suite%finalize, ...) not yet implemented + +!$OMP parallel default (shared) & +!$OMP private (nb,nt) & +!$OMP reduction (+:ierr) +#ifdef OPENMP + nt = omp_get_thread_num()+1 +#else + nt = 1 +#endif + do nb = 1,nBlocks + !--- Initialize CCPP + 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 + exit + end if + end do +!$OMP end parallel + if (ierr/=0) return + + ! Deallocate cdata structure for blocks and threads deallocate(cdata_block) + call ccpp_finalize(cdata, ierr) + if (ierr/=0) then + write(0,'(a)') "An error occurred in IPD_step 5" + end if + else + call ccpp_error('Error, undefined step for ccpp_run') ierr = 1 return end if + ! DH* TODO CLEAN UP STDIO (USE FV3 MESSAGING? WRITE STATEMENTS? BE CONSISTENT!) *DH end subroutine IPD_step end module IPD_CCPP_driver diff --git a/physics/GFS_MP_generic_pre.f90 b/physics/GFS_MP_generic_pre.f90 index c37873957..10d872651 100644 --- a/physics/GFS_MP_generic_pre.f90 +++ b/physics/GFS_MP_generic_pre.f90 @@ -44,9 +44,9 @@ subroutine GFS_MP_generic_pre_run(im, ix, levs, clw1, clw2, & ! ! declare variables. ! - integer,intent(in) :: im, ix, levs, ntcw, ncld , num_p3d + integer,intent(in) :: im, ix, levs, ntcw, ncld, num_p3d integer :: n,i,k - logical :: ldiag3d + logical :: ldiag3d real(kind=kind_phys),dimension(ix,levs), intent(in) :: t,q, & clw1,clw2 real(kind=kind_phys),dimension(ix,levs), intent(out) :: & @@ -54,14 +54,12 @@ subroutine GFS_MP_generic_pre_run(im, ix, levs, clw1, clw2, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! DH* MISSING TEST INITIALIZING save_t, save_qv, save_qcw, fix ix/im, array assignment? - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (ldiag3d) then - do i = 1, im + do i = 1, ix do k = 1, levs !CCPP dtdt(i,k) = t(i,k) !CCPP dqdt1(i,k) = q(i,k) @@ -72,7 +70,7 @@ subroutine GFS_MP_generic_pre_run(im, ix, levs, clw1, clw2, & !in FV3GFS v0 OP: ntcw=3, ncld=1, num_p3d=4, ntrac=3 do n=ntcw,ntcw+ncld-1 if (n == ntcw .and. num_p3d == 4 ) then - do i = 1, im + do i = 1, ix do k = 1, levs !CCPP dqdt3(i,k) = clw1(i,k)+clw2(i,k) ! save_qcw(i,k) = clw1(i,k)+clw2(i,k) @@ -80,6 +78,10 @@ subroutine GFS_MP_generic_pre_run(im, ix, levs, clw1, clw2, & enddo endif enddo + else + save_t = 0.0 + save_qv = 0.0 + save_qcw = 0.0 endif end subroutine GFS_MP_generic_pre_run diff --git a/physics/GFS_calpreciptype.f90 b/physics/GFS_calpreciptype.f90 index 23de1972f..6b34ca47e 100644 --- a/physics/GFS_calpreciptype.f90 +++ b/physics/GFS_calpreciptype.f90 @@ -306,6 +306,10 @@ subroutine GFS_calpreciptype_run(kdt,nrcm,im,ix,lm,lp1,randomno, & tprcp(:) = max(0.0, prec(:)) ! clu: rain -> tprcp else + domr = 0. + domzr = 0. + domip = 0. + doms = 0. do i = 1, im tprcp(i) = max(0.0,prec(i)) ! clu: rain -> tprcp srflag(i) = 0. ! clu: default srflag as 'rain' (i.e. 0)