Merge remote-tracking branch 'gfdl/dev/gfdl' into esmg_work

ac/Makefile.in

@@ -19,7 +19,6 @@ SRC_DIRS = @SRC_DIRS@
 
 -include Makefile.dep
 
-
 # Generate Makefile from template
 Makefile: @srcdir@/ac/Makefile.in config.status
 	./config.status
@@ -33,7 +32,7 @@ rwildcard=$(foreach d,$(wildcard $(1:=/*)),$(call rwildcard,$d,$2) $(filter $(su
 .PHONY: depend
 depend: Makefile.dep
 Makefile.dep: $(MAKEDEP) $(call rwildcard,$(SRC_DIRS),*.h *.c *.inc *.F90)
-	$(PYTHON) $(MAKEDEP) -o Makefile.dep -e $(SRC_DIRS)
+	$(PYTHON) $(MAKEDEP) $(DEFS) -o Makefile.dep -e $(SRC_DIRS)
 
 
 # Delete any files associated with configuration (including the Makefile).

ac/makedep

@@ -13,9 +13,16 @@ import sys
 # Pre-compile re searches
 re_module = re.compile(r"^ *module +([a-z_0-9]+)")
 re_use = re.compile(r"^ *use +([a-z_0-9]+)")
+re_cpp_define = re.compile(r"^ *# *define +[_a-zA-Z][_a-zA-Z0-9]")
+re_cpp_undef = re.compile(r"^ *# *undef +[_a-zA-Z][_a-zA-Z0-9]")
+re_cpp_ifdef = re.compile(r"^ *# *ifdef +[_a-zA-Z][_a-zA-Z0-9]")
+re_cpp_ifndef = re.compile(r"^ *# *ifndef +[_a-zA-Z][_a-zA-Z0-9]")
+re_cpp_if = re.compile(r"^ *# *if +")
+re_cpp_else = re.compile(r"^ *# *else")
+re_cpp_endif = re.compile(r"^ *# *endif")
 re_cpp_include = re.compile(r"^ *# *include *[<\"']([a-zA-Z_0-9\.]+)[>\"']")
 re_f90_include = re.compile(r"^ *include +[\"']([a-zA-Z_0-9\.]+)[\"']")
-re_program = re.compile(r"^ *[pP][rR][oO][gG][rR][aA][mM] +([a-zA-Z_0-9]+)")
+re_program = re.compile(r"^ *program +([a-z_0-9]+)", re.IGNORECASE)
 re_end = re.compile(r"^ *end *(module|procedure) ", re.IGNORECASE)
 # NOTE: This excludes comments and tokens with substrings containing `function`
 # or `subroutine`, but will fail if the keywords appear in other contexts.
@@ -26,7 +33,7 @@ re_procedure = re.compile(
 
 
 def create_deps(src_dirs, skip_dirs, makefile, debug, exec_target, fc_rule,
-                link_externals, script_path):
+                link_externals, defines):
     """Create "makefile" after scanning "src_dis"."""
 
     # Scan everything Fortran related
@@ -66,7 +73,7 @@ def create_deps(src_dirs, skip_dirs, makefile, debug, exec_target, fc_rule,
     o2mods, o2uses, o2h, o2inc, o2prg, prg2o, mod2o = {}, {}, {}, {}, {}, {}, {}
     externals, all_modules = [], []
     for f in F90_files:
-        mods, used, cpp, inc, prg, has_externals = scan_fortran_file(f)
+        mods, used, cpp, inc, prg, has_externals = scan_fortran_file(f, defines)
         # maps object file to modules produced
         o2mods[object_file(f)] = mods
         # maps module produced to object file
@@ -272,10 +279,16 @@ def nested_inc(inc_files, f2F):
     return inc_files + sorted(set(hlst)), used_mods
 
 
-def scan_fortran_file(src_file):
+def scan_fortran_file(src_file, defines=None):
     """Scan the Fortran file "src_file" and return lists of module defined,
     module used, and files included."""
     module_decl, used_modules, cpp_includes, f90_includes, programs = [], [], [], [], []
+
+    cpp_defines = defines if defines is not None else []
+
+    cpp_macros = [define.split('=')[0] for define in cpp_defines]
+    cpp_group_stack = []
+
     with io.open(src_file, 'r', errors='replace') as file:
         lines = file.readlines()
 
@@ -285,7 +298,72 @@ def scan_fortran_file(src_file):
         file_has_externals = False
             # True if the file contains any external objects
 
+        cpp_exclude = False
+            # True if the parser excludes the subsequent lines
+
+        cpp_group_stack = []
+            # Stack of condition group exclusion states
+
         for line in lines:
+            # Start of #ifdef condition group
+            match = re_cpp_ifdef.match(line)
+            if match:
+                cpp_group_stack.append(cpp_exclude)
+
+                # If outer group is excluding or macro is missing, then exclude
+                macro = line.lstrip()[1:].split()[1]
+                cpp_exclude = cpp_exclude or macro not in cpp_macros
+
+            # Start of #ifndef condition group
+            match = re_cpp_ifndef.match(line)
+            if match:
+                cpp_group_stack.append(cpp_exclude)
+
+                # If outer group is excluding or macro is present, then exclude
+                macro = line.lstrip()[1:].split()[1]
+                cpp_exclude = cpp_exclude or macro in cpp_macros
+
+            # Start of #if condition group
+            match = re_cpp_if.match(line)
+            if match:
+                cpp_group_stack.append(cpp_exclude)
+
+                # XXX: Don't attempt to parse #if statements, but store the state.
+                # if/endif stack.  For now, assume that these always fail.
+                cpp_exclude = False
+
+            # Complement #else condition group
+            match = re_cpp_else.match(line)
+            if match:
+                # Reverse the exclude state, if there is no outer exclude state
+                outer_grp_exclude = cpp_group_stack and cpp_group_stack[-1]
+                cpp_exclude = not cpp_exclude or outer_grp_exclude
+
+            # Restore exclude state when exiting conditional block
+            match = re_cpp_endif.match(line)
+            if match:
+                cpp_exclude = cpp_group_stack.pop()
+
+            # Skip lines inside of false condition blocks
+            if cpp_exclude:
+                continue
+
+            # Activate a new macro (ignoring the value)
+            match = re_cpp_define.match(line)
+            if match:
+                new_macro = line.lstrip()[1:].split()[1]
+                cpp_macros.append(new_macro)
+
+            # Deactivate a macro
+            match = re_cpp_undef.match(line)
+            if match:
+                new_macro = line.lstrip()[1:].split()[1]
+                try:
+                    cpp_macros.remove(new_macro)
+                except:
+                    # Ignore missing macros (for now?)
+                    continue
+
             match = re_module.match(line.lower())
             if match:
                 if match.group(1) not in 'procedure':   # avoid "module procedure" statements
@@ -404,8 +482,13 @@ parser.add_argument(
     action='append',
     help="Skip directory in source code search."
 )
+parser.add_argument(
+    '-D', '--define',
+    action='append',
+    help="Apply preprocessor define macros (of the form -DMACRO[=value])",
+)
 args = parser.parse_args()
 
 # Do the thing
 create_deps(args.path, args.skip, args.makefile, args.debug, args.exec_target,
-            args.fc_rule, args.link_externals, sys.argv[0])
+            args.fc_rule, args.link_externals, args.define)

config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90

@@ -137,7 +137,7 @@ module MOM_surface_forcing_gfdl
                                 !! gustiness calculations.  Values below 20190101 recover the answers
                                 !! from the end of 2018, while higher values use a simpler expression
                                 !! to calculate gustiness.
-  logical :: fix_ustar_gustless_bug         !< If true correct a bug in the time-averaging of the
+  logical :: ustar_gustless_bug             !< If true, include a bug in the time-averaging of the
                                             !! gustless wind friction velocity.
   logical :: check_no_land_fluxes           !< Return warning if IOB flux over land is non-zero
 
@@ -284,7 +284,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
   ! flux type has been used.
   if (fluxes%dt_buoy_accum < 0) then
     call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.not.CS%nonBous, press=.true., &
-                               fix_accum_bug=CS%fix_ustar_gustless_bug, tau_mag=CS%nonBous)
+                               fix_accum_bug=.not.CS%ustar_gustless_bug, tau_mag=CS%nonBous)
 
     call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed)
     call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed)
@@ -1298,6 +1298,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
   logical :: new_sim              ! False if this simulation was started from a restart file
                                   ! or other equivalent files.
   logical :: iceberg_flux_diags   ! If true, diagnostics of fluxes from icebergs are available.
+  logical :: fix_ustar_gustless_bug  ! If false, include a bug using an older run-time parameter.
+  logical :: test_value  ! This is used to determine whether a logical parameter is being set explicitly.
+  logical :: explicit_bug, explicit_fix ! These indicate which parameters are set explicitly.
   integer :: default_answer_date  ! The default setting for the various ANSWER_DATE flags.
   type(time_type)    :: Time_frc
   type(directories)  :: dirs      ! A structure containing relevant directory paths and input filenames.
@@ -1522,7 +1525,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
   endif
   call get_param(param_file, mdl, "SPEAR_DTFREEZE_DS", CS%SPEAR_dTf_dS, &
                  "The derivative of the freezing temperature with salinity.", &
-                 units="deg C PSU-1", default=-0.054, scale=US%degC_to_C*US%S_to_ppt, &
+                 units="degC ppt-1", default=-0.054, scale=US%degC_to_C*US%S_to_ppt, &
                  do_not_log=.not.CS%trestore_SPEAR_ECDA)
   call get_param(param_file, mdl, "RESTORE_FLUX_RHO", CS%rho_restore, &
                  "The density that is used to convert piston velocities into salt or heat "//&
@@ -1611,9 +1614,32 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger)
                  "of 2018, while higher values use a simpler expression to calculate gustiness.", &
                  default=default_answer_date)
 
-  call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, &
+  call get_param(param_file, mdl, "USTAR_GUSTLESS_BUG", CS%ustar_gustless_bug, &
+                 "If true include a bug in the time-averaging of the gustless wind friction velocity", &
+                 default=.false., do_not_log=.true.)
+  ! This is used to test whether USTAR_GUSTLESS_BUG is being actively set.
+  call get_param(param_file, mdl, "USTAR_GUSTLESS_BUG", test_value, default=.true., do_not_log=.true.)
+  explicit_bug = CS%ustar_gustless_bug .eqv. test_value
+  call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", fix_ustar_gustless_bug, &
                  "If true correct a bug in the time-averaging of the gustless wind friction velocity", &
-                 default=.true.)
+                 default=.true., do_not_log=.true.)
+  call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", test_value, default=.false., do_not_log=.true.)
+  explicit_fix = fix_ustar_gustless_bug .eqv. test_value
+
+  if (explicit_bug .and. explicit_fix .and. (fix_ustar_gustless_bug .eqv. CS%ustar_gustless_bug)) then
+    ! USTAR_GUSTLESS_BUG is being explicitly set, and should not be changed.
+    call MOM_error(FATAL, "USTAR_GUSTLESS_BUG and FIX_USTAR_GUSTLESS_BUG are both being set "//&
+                   "with inconsistent values.  FIX_USTAR_GUSTLESS_BUG is an obsolete "//&
+                   "parameter and should be removed.")
+  elseif (explicit_fix) then
+    call MOM_error(WARNING, "FIX_USTAR_GUSTLESS_BUG is an obsolete parameter.  "//&
+                   "Use USTAR_GUSTLESS_BUG instead (noting that it has the opposite sense).")
+    CS%ustar_gustless_bug = .not.fix_ustar_gustless_bug
+  endif
+  call log_param(param_file, mdl, "USTAR_GUSTLESS_BUG", CS%ustar_gustless_bug, &
+                 "If true include a bug in the time-averaging of the gustless wind friction velocity", &
+                 default=.false.)
+
 
 ! See whether sufficiently thick sea ice should be treated as rigid.
   call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, &

config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90

@@ -16,7 +16,7 @@ module MOM_surface_forcing_mct
 use MOM_domains,          only : AGRID, BGRID_NE, CGRID_NE, To_All
 use MOM_domains,          only : To_North, To_East, Omit_Corners
 use MOM_error_handler,    only : MOM_error, WARNING, FATAL, is_root_pe, MOM_mesg
-use MOM_file_parser,      only : get_param, log_version, param_file_type
+use MOM_file_parser,      only : get_param, log_param, log_version, param_file_type
 use MOM_forcing_type,     only : forcing, mech_forcing
 use MOM_forcing_type,     only : forcing_diags, mech_forcing_diags, register_forcing_type_diags
 use MOM_forcing_type,     only : allocate_forcing_type, deallocate_forcing_type
@@ -117,7 +117,7 @@ module MOM_surface_forcing_mct
   real    :: max_delta_srestore             !< maximum delta salinity used for restoring [S ~> ppt]
   real    :: max_delta_trestore             !< maximum delta sst used for restoring [C ~> degC]
   real, pointer, dimension(:,:) :: basin_mask => NULL() !< mask for SSS restoring by basin
-  logical :: fix_ustar_gustless_bug         !< If true correct a bug in the time-averaging of the
+  logical :: ustar_gustless_bug             !< If true, include a bug in the time-averaging of the
                                             !! gustless wind friction velocity.
   type(diag_ctrl), pointer :: diag          !< structure to regulate diagnostic output timing
   character(len=200)       :: inputdir      !< directory where NetCDF input files are
@@ -276,7 +276,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
   ! flux type has been used.
   if (fluxes%dt_buoy_accum < 0) then
     call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., &
-                               press=.true., fix_accum_bug=CS%fix_ustar_gustless_bug, tau_mag=.true.)
+                               press=.true., fix_accum_bug=.not.CS%ustar_gustless_bug, tau_mag=.true.)
 
     call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed)
     call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed)
@@ -1025,11 +1025,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
   ! Local variables
   real :: utide  ! The RMS tidal velocity [Z T-1 ~> m s-1].
   type(directories)  :: dirs
-  logical            :: new_sim, iceberg_flux_diags
+  logical            :: new_sim, iceberg_flux_diags, fix_ustar_gustless_bug
+  logical :: test_value  ! This is used to determine whether a logical parameter is being set explicitly.
+  logical :: explicit_bug, explicit_fix ! These indicate which parameters are set explicitly.
   type(time_type)    :: Time_frc
   character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names.
-! This include declares and sets the variable "version".
-#include "version_variable.h"
+  ! This include declares and sets the variable "version".
+# include "version_variable.h"
   character(len=40)  :: mdl = "MOM_surface_forcing_mct"  ! This module's name.
   character(len=48)  :: stagger
   character(len=48)  :: flnam
@@ -1257,9 +1259,32 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
     call MOM_read_data(gust_file, 'gustiness', CS%gust, G%domain, timelevel=1, &
                scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa
   endif
-  call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", CS%fix_ustar_gustless_bug, &
+
+  call get_param(param_file, mdl, "USTAR_GUSTLESS_BUG", CS%ustar_gustless_bug, &
+                 "If true include a bug in the time-averaging of the gustless wind friction velocity", &
+                 default=.false., do_not_log=.true.)
+  ! This is used to test whether USTAR_GUSTLESS_BUG is being actively set.
+  call get_param(param_file, mdl, "USTAR_GUSTLESS_BUG", test_value, default=.true., do_not_log=.true.)
+  explicit_bug = CS%ustar_gustless_bug .eqv. test_value
+  call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", fix_ustar_gustless_bug, &
                  "If true correct a bug in the time-averaging of the gustless wind friction velocity", &
-                 default=.true.)
+                 default=.true., do_not_log=.true.)
+  call get_param(param_file, mdl, "FIX_USTAR_GUSTLESS_BUG", test_value, default=.false., do_not_log=.true.)
+  explicit_fix = fix_ustar_gustless_bug .eqv. test_value
+
+  if (explicit_bug .and. explicit_fix .and. (fix_ustar_gustless_bug .eqv. CS%ustar_gustless_bug)) then
+    ! USTAR_GUSTLESS_BUG is being explicitly set, and should not be changed.
+    call MOM_error(FATAL, "USTAR_GUSTLESS_BUG and FIX_USTAR_GUSTLESS_BUG are both being set "//&
+                   "with inconsistent values.  FIX_USTAR_GUSTLESS_BUG is an obsolete "//&
+                   "parameter and should be removed.")
+  elseif (explicit_fix) then
+    call MOM_error(WARNING, "FIX_USTAR_GUSTLESS_BUG is an obsolete parameter.  "//&
+                   "Use USTAR_GUSTLESS_BUG instead (noting that it has the opposite sense).")
+    CS%ustar_gustless_bug = .not.fix_ustar_gustless_bug
+  endif
+  call log_param(param_file, mdl, "USTAR_GUSTLESS_BUG", CS%ustar_gustless_bug, &
+                 "If true include a bug in the time-averaging of the gustless wind friction velocity", &
+                 default=.false.)
 
 ! See whether sufficiently thick sea ice should be treated as rigid.
   call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, &