FV3: this commit #refs 50223

atmos_cubed_sphere/model/fv_mapz.F90

@@ -87,11 +87,15 @@ module fv_mapz_mod
   use fv_grid_utils_mod, only: g_sum, ptop_min
   use fv_fill_mod,       only: fillz
   use mpp_domains_mod,   only: mpp_update_domains, domain2d
-  use mpp_mod,           only: NOTE, mpp_error, get_unit, mpp_root_pe, mpp_pe
+  use mpp_mod,           only: NOTE, FATAL, mpp_error, get_unit, mpp_root_pe, mpp_pe
   use fv_arrays_mod,     only: fv_grid_type
   use fv_timing_mod,     only: timing_on, timing_off
   use fv_mp_mod,         only: is_master
   use fv_cmp_mod,        only: qs_init, fv_sat_adj
+#ifdef CCPP
+  use ccpp_api,          only: ccpp_initialized, ccpp_physics_run
+  use IPD_CCPP_driver,   only: ccpp_cdata => cdata
+#endif
 
   implicit none
   real, parameter:: consv_min= 0.001         !< below which no correction applies
@@ -198,6 +202,9 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk,   &
   logical:: fast_mp_consv
   integer:: i,j,k 
   integer:: nt, liq_wat, ice_wat, rainwat, snowwat, cld_amt, graupel, iq, n, kmp, kp, k_next
+#ifdef CCPP
+  integer :: ccpp_ierr
+#endif
 
        k1k = rdgas/cv_air   ! akap / (1.-akap) = rg/Cv=0.4
         rg = rdgas
@@ -551,8 +558,13 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk,   &
 !$OMP                               do_adiabatic_init,zsum1,zsum0,te0_2d,domain,        &
 !$OMP                               ng,gridstruct,E_Flux,pdt,dtmp,reproduce_sum,q,      &
 !$OMP                               mdt,cld_amt,cappa,dtdt,out_dt,rrg,akap,do_sat_adj,  &
+#ifdef CCPP
+!$OMP                               fast_mp_consv,kord_tm,ccpp_cdata) &
+!$OMP                       private(pe0,pe1,pe2,pe3,qv,cvm,gz,phis,dpln,ccpp_ierr)
+#else
 !$OMP                               fast_mp_consv,kord_tm) &
 !$OMP                       private(pe0,pe1,pe2,pe3,qv,cvm,gz,phis,dpln)
+#endif
 
 !$OMP do
   do k=2,km
@@ -686,6 +698,15 @@ subroutine Lagrangian_to_Eulerian(last_step, consv, ps, pe, delp, pkz, pk,   &
 ! Note: pt at this stage is T_v
 ! if ( (.not.do_adiabatic_init) .and. do_sat_adj ) then
   if ( do_sat_adj ) then
+#ifdef CCPP
+    if (ccpp_initialized(ccpp_cdata)) then
+      call ccpp_physics_run(ccpp_cdata, group_name='fast_physics', ierr=ccpp_ierr)
+      if (ccpp_ierr/=0) call mpp_error(FATAL, "Call to IPD-CCPP step 'fast_physics' failed")
+    else
+      call mpp_error (NOTE, 'fv_mapz::skip ccpp fast physics because cdata not initialized')
+    endif
+#endif
+
                                            call timing_on('sat_adj2')
 !$OMP do
            do k=kmp,km

atmos_cubed_sphere/tools/external_ic.F90

@@ -418,7 +418,11 @@ subroutine get_nggps_ic (Atm, fv_domain)
 !>       Q   -  prognostic tracer fields
 !> Namelist variables 
 !>       filtered_terrain  -  use orography maker filtered terrain mapping
+#ifdef __PGI
+      use GFS_restart, only : GFS_restart_type
 
+      implicit none
+#endif
 
       type(fv_atmos_type), intent(inout) :: Atm(:)
       type(domain2d),      intent(inout) :: fv_domain
@@ -1269,6 +1273,13 @@ end subroutine get_ncep_ic
 !! (EXPERIMENTAL: contact Jan-Huey Chen [email protected] for support)
 !>@authors Jan-Huey Chen, Xi Chen, Shian-Jiann Lin
   subroutine get_ecmwf_ic( Atm, fv_domain )
+
+#ifdef __PGI
+      use GFS_restart, only : GFS_restart_type
+
+      implicit none
+#endif
+
       type(fv_atmos_type), intent(inout) :: Atm(:)
       type(domain2d),      intent(inout) :: fv_domain
 ! local:

atmos_model.F90

@@ -44,7 +44,7 @@ module atmos_model_mod
 
 use mpp_mod,            only: mpp_pe, mpp_root_pe, mpp_clock_id, mpp_clock_begin
 use mpp_mod,            only: mpp_clock_end, CLOCK_COMPONENT, MPP_CLOCK_SYNC
-use mpp_mod,            only: mpp_min, mpp_max, mpp_error, mpp_chksum, FATAL
+use mpp_mod,            only: FATAL, mpp_min, mpp_max, mpp_error, mpp_chksum
 use mpp_domains_mod,    only: domain2d
 use mpp_mod,            only: mpp_get_current_pelist_name
 #ifdef INTERNAL_FILE_NML
@@ -84,8 +84,16 @@ module atmos_model_mod
 use IPD_typedefs,       only: IPD_init_type, IPD_control_type, &
                               IPD_data_type, IPD_diag_type,    &
                               IPD_restart_type, IPD_kind_phys, &
+#ifdef CCPP
+                              IPD_func0d_proc, IPD_func1d_proc,&
+                              IPD_fastphys_type
+#else
                               IPD_func0d_proc, IPD_func1d_proc
+#endif
 use IPD_driver,         only: IPD_initialize, IPD_step
+#ifdef CCPP
+use IPD_CCPP_driver,    only: IPD_CCPP_step
+#endif
 use physics_abstraction_layer, only: time_vary_step, radiation_step1, physics_step1, physics_step2
 use FV3GFS_io_mod,      only: FV3GFS_restart_read, FV3GFS_restart_write, &
                               FV3GFS_IPD_checksum,                       &
@@ -145,6 +153,13 @@ module atmos_model_mod
 real, dimension(maxhr) :: fdiag = 0.
 real                   :: fhmax=240.0, fhmaxhf=120.0, fhout=3.0, fhouthf=1.0
 namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, fdiag, fhmax, fhmaxhf, fhout, fhouthf
+#ifdef CCPP
+character(len=256)     :: ccpp_suite='undefined.xml'
+namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, fdiag, fhmax, fhmaxhf, fhout, fhouthf, ccpp_suite
+#else
+namelist /atmos_model_nml/ blocksize, chksum_debug, dycore_only, debug, sync, fdiag, fhmax, fhmaxhf, fhout, fhouthf
+#endif
+
 type (time_type) :: diag_time
 
 !--- concurrent and decoupled radiation and physics variables
@@ -161,6 +176,9 @@ module atmos_model_mod
 type(IPD_data_type),    allocatable :: IPD_Data(:)  ! number of blocks
 type(IPD_diag_type),    target      :: IPD_Diag(DIAG_SIZE)
 type(IPD_restart_type)              :: IPD_Restart
+#ifdef CCPP
+type(IPD_fastphys_type)             :: IPD_Fastphys
+#endif
 
 !--------------
 ! IAU container
@@ -459,6 +477,14 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
    endif
 #endif
 
+#ifdef CCPP
+! DH* for testing of CCPP integration
+  ! Fast physics runs over all blocks, initialize here to avoid changing all the interfaces down to GFS_driver
+   call IPD_Fastphys%create()
+   call IPD_CCPP_step (step="init", IPD_Control=IPD_Control, IPD_Fastphys=IPD_Fastphys, ccpp_suite=trim(ccpp_suite), ierr=ierr)
+   if (ierr/=0)  call mpp_error(FATAL, 'Call to IPD-CCPP init step failed')
+#endif
+
    call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm)
    Atmos%Diag => IPD_Diag
 
@@ -716,6 +742,9 @@ subroutine atmos_model_end (Atmos)
   type (atmos_data_type), intent(inout) :: Atmos
 !---local variables
   integer :: idx
+#ifdef CCPP
+  integer :: ierr
+#endif
 
 !-----------------------------------------------------------------------
 !---- termination routine for atmospheric model ----
@@ -724,6 +753,11 @@ subroutine atmos_model_end (Atmos)
     call FV3GFS_restart_write (IPD_Data, IPD_Restart, Atm_block, &
                                IPD_Control, Atmos%domain)
 
+#ifdef CCPP
+   call IPD_CCPP_step (step="finalize", ierr=ierr)
+   if (ierr/=0)  call mpp_error(FATAL, 'Call to IPD-CCPP finalize step failed')
+#endif
+
 end subroutine atmos_model_end
 
 ! </SUBROUTINE>

gfsphysics/GFS_layer/GFS_abstraction_layer.F90

@@ -11,7 +11,13 @@ module physics_abstraction_layer
                              tbd_type         =>  GFS_tbd_type,      &
                              cldprop_type     =>  GFS_cldprop_type,  &
                              radtend_type     =>  GFS_radtend_type,  &
+#ifdef CCPP
+                             intdiag_type     =>  GFS_diag_type,     &
+                             fastphys_type    =>  GFS_fastphys_type
+#else
                              intdiag_type     =>  GFS_diag_type
+#endif
+
 
   use GFS_restart,     only: restart_type     =>  GFS_restart_type,    &
                              restart_populate =>  GFS_restart_populate
@@ -50,6 +56,9 @@ module physics_abstraction_layer
   public  intdiag_type
   public  restart_type
   public  diagnostic_type
+#ifdef CCPP
+  public  fastphys_type
+#endif
 
 !------------------
 !  public variables 

gfsphysics/GFS_layer/GFS_typedefs.F90

@@ -333,6 +333,14 @@ module GFS_typedefs
   end type GFS_coupling_type
 
 
+#ifdef CCPP
+! DH* for testing of CCPP integration
+!! \section arg_table_GFS_control_type
+!! | local_name          | standard_name              | long_name                                      | units | rank | type      | kind    | intent | optional |
+!! |---------------------|----------------------------|------------------------------------------------|-------|------|-----------|---------|--------|----------|
+!! | IPD_Control%me      | mpi_rank                   | current MPI-rank                               | index |    0 | integer   |         | none   | F        |
+!!
+#endif
 !----------------------------------------------------------------------------------
 ! GFS_control_type
 !   model control parameters input from a namelist and/or derived from others
@@ -932,6 +940,30 @@ module GFS_typedefs
       procedure :: phys_zero => diag_phys_zero
   end type GFS_diag_type
 
+#ifdef CCPP
+! DH* for testing of CCPP integration
+!! \section arg_table_GFS_fastphys_type
+!! | local_name          | standard_name              | long_name                                      | units | rank | type      | kind    | intent | optional |
+!! |---------------------|----------------------------|------------------------------------------------|-------|------|-----------|---------|--------|----------|
+!! | IPD_fastphys%dummy  | FV3_ccpp_integration_dummy | dummy variable to test CCPP integration in FV3 | none  |    0 | integer   |         | none   | F        |
+!! | IPD_fastphys%errmsg | error_message              | error message for error handling in CCPP       | none  |    0 | character | len=512 | none   | F        |
+!! | IPD_fastphys%errflg | error_flag                 | error flag for error handling in CCPP          | flag  |    0 | integer   |         | none   | F        |
+!!
+!----------------------------------------------------------------
+! GFS_fastphys_type
+!  data type holding interstitial variables for fast physics
+!----------------------------------------------------------------
+  type GFS_fastphys_type
+
+    integer                             :: dummy
+    character(len=512)                  :: errmsg
+    integer                             :: errflg
+
+  contains
+    procedure :: create => fastphys_create
+  end type GFS_fastphys_type
+#endif
+
 !----------------
 ! PUBLIC ENTITIES
 !----------------
@@ -3048,4 +3080,22 @@ subroutine diag_phys_zero (Diag, Model, linit)
     endif
   end subroutine diag_phys_zero
 
+#ifdef CCPP
+! DH* for testing of CCPP integration
+!--------------------
+! GFS_fastphys_type%create
+!--------------------
+  subroutine fastphys_create (Fastphys)
+
+    implicit none
+
+    class(GFS_fastphys_type)           :: Fastphys
+
+    Fastphys%dummy  = 0
+    Fastphys%errmsg = ''
+    Fastphys%errflg = 0
+
+    end subroutine fastphys_create
+#endif
+
 end module GFS_typedefs

gfsphysics/makefile

@@ -19,7 +19,7 @@ LIBRARY  = libgfsphys.a
 
 FFLAGS   += -I../fms -I../fms/include -I../cpl
 
-CPPDEFS = -DNEW_TAUCTMAX -DSMALL_PE -DNEMS_GSM -DINTERNAL_FILE_NML
+CPPDEFS += -DNEW_TAUCTMAX -DSMALL_PE -DNEMS_GSM -DINTERNAL_FILE_NML
 
 SRCS_f   =  \
 	   ./physics/cnvc90.f                                                        \

ipd/IPD_CCPP_driver.F90

@@ -0,0 +1,126 @@
+module IPD_CCPP_driver
+
+  use IPD_typedefs,       only: IPD_control_type, IPD_fastphys_type
+
+  use ccpp_api,           only: ccpp_t,                              &
+                                ccpp_init,                           &
+                                ccpp_finalize,                       &
+                                ccpp_physics_init,                   &
+                                ccpp_physics_run,                    &
+                                ccpp_physics_finalize,               &
+                                ccpp_field_add
+
+! Begin include auto-generated list of modules for ccpp
+#include "ccpp_modules.inc"
+! End include auto-generated list of modules for ccpp
+
+  use iso_c_binding,      only: c_loc
+
+  implicit none
+
+!------------------------------------------------------!
+!  CCPP container                                      !
+!------------------------------------------------------!
+  type(ccpp_t), save, target :: cdata
+
+!----------------
+! Public Entities
+!----------------
+! functions
+  public IPD_CCPP_step
+
+  CONTAINS
+!*******************************************************************************************
+
+!-------------------------------
+!  IPD step generalized for CCPP
+!-------------------------------
+  subroutine IPD_CCPP_step (step, IPD_Control, IPD_Fastphys, ccpp_suite, ierr)
+
+#ifdef OPENMP
+    use omp_lib
+#endif
+
+    implicit none
+
+    character(len=*),                intent(in)              :: step
+    type(IPD_control_type),  target, intent(inout), optional :: IPD_Control
+    type(IPD_fastphys_type), target, intent(inout), optional :: IPD_Fastphys
+    character(len=*),                intent(in),    optional :: ccpp_suite
+    integer,                         intent(out)             :: ierr
+
+    ierr = 0
+
+    if (trim(step)=="init") then
+
+      if (.not.present(IPD_Control)) then
+          write(0,*) 'Optional argument IPD_Control required for IPD-CCPP init step'
+          ierr = 1
+          return
+        end if
+
+      if (.not.present(IPD_Fastphys)) then
+          write(0,*) 'Optional argument IPD_Fastphys required for IPD-CCPP init step'
+          ierr = 1
+          return
+        end if
+
+      if (.not.present(ccpp_suite)) then
+        write(0,*) 'Optional argument ccpp_suite required for IPD-CCPP init step'
+        ierr = 1
+        return
+      end if
+
+      !--- Initialize CCPP framework
+      call ccpp_init(trim(ccpp_suite), cdata, ierr)
+      if (ierr/=0) then
+        write(0,*) 'An error occurred in ccpp_init'
+        return
+      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
+
+      !--- Initialize CCPP physics
+      call ccpp_physics_init(cdata, ierr)
+      if (ierr/=0) then
+        write(0,*) 'An error occurred in ccpp_physics_init'
+        return
+      end if
+
+    else if (trim(step)=="fast_physics") then
+
+      call ccpp_physics_run(cdata, group_name='fast_physics', ierr=ierr)
+      if (ierr/=0) then
+         write(0,'(a)') "An error occurred in ccpp_physics_run for group fast_physics"
+         return
+      end if
+
+    ! Finalize
+    else if (trim(step)=="finalize") then
+
+      !--- Finalize CCPP physics
+      call ccpp_physics_finalize(cdata, ierr)
+      if (ierr/=0) then
+         write(0,'(a)') "An error occurred in ccpp_physics_finalize"
+         return
+      end if
+      !--- Finalize CCPP framework
+      call ccpp_finalize(cdata, ierr)
+      if (ierr/=0) then
+         write(0,'(a)') "An error occurred in ccpp_finalize"
+         return
+      end if
+
+    else
+
+      write(0,'(2a)') 'Error, undefined IPD step ', trim(step)
+      ierr = 1
+      return
+
+    end if
+
+  end subroutine IPD_CCPP_step
+
+end module IPD_CCPP_driver