gmtb-gfsphysics optimization: speedup of ccpp init

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

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,25 +174,52 @@ 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
       if (ierr/=0) return
 
     ! 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

physics/GFS_MP_generic_pre.f90

@@ -44,24 +44,22 @@ 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) ::   &
                                           save_t, save_qv, save_qcw
       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,14 +70,18 @@ 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)
                 enddo
                enddo
           endif
         enddo
+      else
+          save_t = 0.0
+          save_qv = 0.0
+          save_qcw = 0.0
       endif
 
       end subroutine GFS_MP_generic_pre_run

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)