Remove FMS from UFS MPAS Atmosphere + More MPAS infrastructure in UFS

CMakeLists.txt

@@ -89,6 +89,9 @@ list(APPEND fv3_io_srcs
   io/fv3atm_history_io.F90
   io/fv3atm_restart_io.F90)
 
+list(APPEND ufs_srcs
+   ${PROJECT_SOURCE_DIR}/CDEPS-interface/ufs/cdeps_share/shr_is_restart_fh_mod.F90)
+
 ###############################################################################
 ### UFSATM with FV3 dynamical core
 ###############################################################################
@@ -186,6 +189,7 @@ if (FV3)
     ${moving_nest_srcs}
     ${cdeps_inline_srcs}
     ${POST_SRC}
+    ${ufs_srcs}
     )
   add_dependencies(${DYCORE_TARGET} fv3 fv3ccpp stochastic_physics)
 
@@ -248,6 +252,7 @@ if (MPAS)
     mpas/ufs_mpas_constituents.F90
     ${coupling_srcs}
     ${io_srcs}
+    ${ufs_srcs}
     ccpp/data/MPAS_typedefs.F90
     ccpp/driver/MPAS_init.F90
     )

ccpp/CMakeLists.txt

@@ -133,7 +133,10 @@ endif()
 if(NOT HYDRO)
   add_definitions(-DMOIST_CAPPA -DUSE_COND -DNEMS_GSM)
 endif()
-add_definitions(-DINTERNAL_FILE_NML -DNEMS_GSM)
+add_definitions(-DNEMS_GSM)
+if (FV3)
+  add_definitions(-DINTERNAL_FILE_NML)
+endif()
 
 if(MULTI_GASES)
   add_definitions(-DMULTI_GASES)

ccpp/data/GFS_typedefs.F90

@@ -43,6 +43,7 @@ module GFS_typedefs
 
    integer, parameter :: physics_no_tracer = -99
 
+
 !> \section arg_table_GFS_typedefs
 !! \htmlinclude GFS_typedefs.html
 !!
@@ -8805,10 +8806,34 @@ function get_physics_tracer_index (name, Model)
     !--- local variables
     integer :: get_physics_tracer_index
 
-    get_physics_tracer_index = get_tracer_index(MODEL_ATMOS, name, verbose = (Model%me == Model%master) .and. Model%debug)
+    ! UFS-FV3 uses FMS
+    if (Model%dycore_active == Model%dycore_fv3) then
+       get_physics_tracer_index = get_tracer_index(MODEL_ATMOS, name, verbose = (Model%me == Model%master) .and. Model%debug)
+    endif
+
+    ! UFS-MPAS does not use FMS
+    if (Model%dycore_active == Model%dycore_mpas) then
+       get_physics_tracer_index = get_constituent_index(name, Model%tracer_names)
+    endif
 
     if (get_physics_tracer_index == NO_TRACER) get_physics_tracer_index = physics_no_tracer
 
   end function get_physics_tracer_index
 
+  ! We don't use FMS when using the MPAS dynamical core. Here we simply grab the
+  ! index from the input tracer list. This is the same as FMS get_tracer_index().
+  function get_constituent_index(const_name, tracer_names)
+    character(len=*),  intent(in) :: const_name
+    character(len=*),  intent(in) :: tracer_names(:)
+    integer :: itracer
+    integer :: get_constituent_index
+
+    get_constituent_index = 0
+    do itracer=1,size(tracer_names)
+       if (trim(const_name) == trim(tracer_names(itracer))) then
+          get_constituent_index = itracer
+       endif
+    enddo
+  end function get_constituent_index
+
 end module GFS_typedefs

mpas/atmos_coupling.F90

@@ -489,8 +489,7 @@ subroutine ufs_mpas_grid_to_physics(physics_grid)
     use mpas_kind_types,      only : RKIND
     use mpas_constants,       only : pii
     use mpas_log,             only : mpas_log_write
-    use mpas_derived_types,   only : MPAS_LOG_ERR, MPAS_LOG_WARN
-    use mpp_mod,              only : mpp_error, FATAL
+    use mpas_derived_types,   only : MPAS_LOG_ERR, MPAS_LOG_WARN, MPAS_LOG_CRIT
     ! Arguments
     type(GFS_grid_type),      intent(inout) :: physics_grid
     ! Locals
@@ -502,6 +501,7 @@ subroutine ufs_mpas_grid_to_physics(physics_grid)
     real(RKIND), pointer :: nominalMinDc
     real(RKIND), pointer :: config_len_disp
     real(RKIND)          :: rad2deg
+    character(len=*), parameter :: subname = 'atmos_coupling::ufs_mpas_grid_to_physics'
 
     ierr = 0
     rad2deg = 180.0_RKIND/pii
@@ -528,10 +528,10 @@ subroutine ufs_mpas_grid_to_physics(physics_grid)
     if (config_len_disp > 0.0_RKIND) then
       ! But if nominalMinDc was available in the input file and is different, print a warning
       if (nominalMinDc > 0.0_RKIND .and. abs(nominalMinDc - config_len_disp) > 1.0e-6_RKIND * config_len_disp) then
-        call mpas_log_write('nominalMinDc was read from input file as a positive value ($r) that differs', &
-                                realArgs=[nominalMinDc], messageType=MPAS_LOG_WARN)
-        call mpas_log_write('from the specified config_len_disp value ($r)', &
-                                realArgs=[config_len_disp], messageType=MPAS_LOG_WARN)
+        call mpas_log_write(subname // ' WARNING: nominalMinDc was read from input file as a positive value ($r) that differs', &
+                            realArgs=[nominalMinDc], messageType=MPAS_LOG_WARN)
+        call mpas_log_write(subname // ' WARNING: from the specified config_len_disp value ($r)', &
+                            realArgs=[config_len_disp], messageType=MPAS_LOG_WARN)
       end if
       nominalMinDc = config_len_disp
     ! Otherwise, try to use nominalMinDc
@@ -540,15 +540,16 @@ subroutine ufs_mpas_grid_to_physics(physics_grid)
         call mpas_log_write('Setting config_len_disp to $r based on nominalMinDc value in input file', realArgs=[nominalMinDc])
           config_len_disp = nominalMinDc
       else
-        call mpas_log_write('Both config_len_disp and nominalMinDc are <= 0.0.', messageType=MPAS_LOG_ERR)
-        call mpas_log_write('Please either specify config_len_disp in the &nhyd_model namelist group,', &
-                                messageType=MPAS_LOG_ERR)
-        call mpas_log_write('or use an input file that provides a valid value for the nominalMinDc variable.', &
-                                messageType=MPAS_LOG_ERR)
+         call mpas_log_write(subname // ' ERROR: Both config_len_disp and nominalMinDc are <= 0.0.', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write(subname // ' ERROR: Please either specify config_len_disp in the &nhyd_model namelist group,', &
+                             messageType=MPAS_LOG_ERR)
+         call mpas_log_write(subname // ' ERROR: or use an input file that provides a valid value for the nominalMinDc variable.', &
+                             messageType=MPAS_LOG_ERR)
         ierr = 1
       end if
     end if
-    if (ierr/=0)  call mpp_error(FATAL, 'Call to ufs_mpas_grid_to_physics() failed')  
+    if (ierr/=0)  call mpas_log_write(subname // ' ERROR: Call to ufs_mpas_grid_to_physics() failed', messageType=MPAS_LOG_CRIT)
 
     do i=1, nCellsSolve
       physics_grid % xlat(i)   = lat(i)