[Dart-dev] [6435] DART/trunk: change allow_missing_in_state to be allow_missing_in_clm because

nancy at ucar.edu nancy at ucar.edu
Tue Aug 27 15:54:57 MDT 2013


Revision: 6435
Author:   nancy
Date:     2013-08-27 15:54:57 -0600 (Tue, 27 Aug 2013)
Log Message:
-----------
change allow_missing_in_state to be allow_missing_in_clm because
there are still outstanding questions for what the 'right thing'
is to do when some state vector items have less than a full ensemble
of values.  

Modified Paths:
--------------
    DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90
    DART/trunk/assim_tools/assim_tools_mod.f90
    DART/trunk/assim_tools/assim_tools_mod.html
    DART/trunk/assim_tools/assim_tools_mod.nml
    DART/trunk/filter/filter.dopplerfold.f90
    DART/trunk/filter/filter.f90
    DART/trunk/models/clm/work/input.nml
    DART/trunk/obs_sequence/obs_sequence_mod.f90
    DART/trunk/smoother/smoother_mod.f90

-------------- next part --------------
Modified: DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90
===================================================================
--- DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90	2013-08-27 21:11:01 UTC (rev 6434)
+++ DART/trunk/adaptive_inflate/adaptive_inflate_mod.f90	2013-08-27 21:54:57 UTC (rev 6435)
@@ -51,6 +51,7 @@
    real(r8)              :: inflate, sd, sd_lower_bound, inf_lower_bound, inf_upper_bound
    ! Include a random sequence type in case non-deterministic inflation is used
    type(random_seq_type) :: ran_seq
+   logical               :: allow_missing_in_clm
 end type adaptive_inflate_type
 
 ! Module storage for writing error messages
@@ -68,7 +69,7 @@
 subroutine adaptive_inflate_init(inflate_handle, inf_flavor, mean_from_restart, &
    sd_from_restart, output_restart, deterministic, in_file_name, out_file_name, &
    diag_file_name, inf_initial, sd_initial, inf_lower_bound, inf_upper_bound, &
-   sd_lower_bound, ens_handle, ss_inflate_index, ss_inflate_sd_index, label)
+   sd_lower_bound, ens_handle, ss_inflate_index, ss_inflate_sd_index, missing_ok, label)
 
 ! Initializes an adaptive_inflate_type 
 
@@ -86,6 +87,7 @@
 real(r8),                    intent(in)    :: sd_lower_bound
 type(ensemble_type),         intent(inout) :: ens_handle
 integer,                     intent(in)    :: ss_inflate_index, ss_inflate_sd_index
+logical,                     intent(in)    :: missing_ok
 character(len = *),          intent(in)    :: label
 
 character(len = 128) :: det, tadapt, sadapt, akind, rsread, nmread
@@ -148,6 +150,7 @@
 inflate_handle%inf_lower_bound    = inf_lower_bound
 inflate_handle%inf_upper_bound    = inf_upper_bound
 inflate_handle%sd_lower_bound     = sd_lower_bound
+inflate_handle%allow_missing_in_clm = missing_ok
 
 ! Set obs_diag unit to -1 indicating it has not been opened yet
 inflate_handle%obs_diag_unit = -1
@@ -614,6 +617,13 @@
 integer  :: i, ens_size
 real(r8) :: rand_sd, var, sd_inflate
 
+! it's possible to have MISSING_R8s in the state
+! vector now.  so we need to be able to avoid changing
+! MISSING_R8 values by inflation here.
+if (inflate_handle%allow_missing_in_clm) then
+   if (any(ens == MISSING_R8)) return
+endif
+
 if(inflate_handle%deterministic) then
    ! Just spread the ensemble out linearly for deterministic
    ! Following line can lead to inflation of 1.0 changing ens on some compilers

Modified: DART/trunk/assim_tools/assim_tools_mod.f90
===================================================================
--- DART/trunk/assim_tools/assim_tools_mod.f90	2013-08-27 21:11:01 UTC (rev 6434)
+++ DART/trunk/assim_tools/assim_tools_mod.f90	2013-08-27 21:54:57 UTC (rev 6435)
@@ -57,7 +57,7 @@
 implicit none
 private
 
-public :: filter_assim, set_assim_tools_trace
+public :: filter_assim, set_assim_tools_trace, get_missing_ok_status
 
 ! Indicates if module initialization subroutine has been called yet
 logical :: module_initialized = .false.
@@ -125,8 +125,8 @@
 ! Some models are allowed to have MISSING_R8 values in the DART state vector.
 ! If they are encountered, it is not necessarily a FATAL error.
 ! Most of the time, if a MISSING_R8 is encountered, DART should die.
-! CLM and POP (more?) should have allow_missing_in_state = .true.
-logical  :: allow_missing_in_state = .false.
+! CLM and POP (more?) should have allow_missing_in_clm = .true.
+logical  :: allow_missing_in_clm = .false.
 
 ! Not in the namelist; this var disables the experimental
 ! linear and spherical case code in the adaptive localization 
@@ -139,7 +139,7 @@
    print_every_nth_obs, rectangular_quadrature, gaussian_likelihood_tails, &
    output_localization_diagnostics, localization_diagnostics_file,         &
    special_localization_obs_types, special_localization_cutoffs,           &
-   allow_missing_in_state
+   allow_missing_in_clm
 
 !============================================================================
 
@@ -155,6 +155,9 @@
 
 call register_module(source, revision, revdate)
 
+! do this up front
+module_initialized = .true.
+
 ! give these guys initial values at runtime *before* we read
 ! in the namelist.  this is to help detect how many items are
 ! actually given in the namelist.
@@ -346,10 +349,7 @@
 call prepare_to_update_copies(obs_ens_handle)
 
 ! Initialize assim_tools_module if needed
-if(.not. module_initialized) then
-   call assim_tools_init
-   module_initialized = .true.
-endif
+if (.not. module_initialized) call assim_tools_init()
 
 ! filter kinds 1 and 8 return sorted increments, however non-deterministic
 ! inflation can scramble these. the sort is expensive, so help users get better 
@@ -778,7 +778,7 @@
       !! or this, for performance reasons?  it won't warn you if there are missing
       ! values when you don't expect them, but it also won't do the any() unless
       ! the namelist says you might expect to see them.
-      !if ( allow_missing_in_state ) then
+      !if ( allow_missing_in_clm ) then
       !   ! Some models can take evasive action if one or more of the ensembles have
       !   ! a missing value. Generally means 'do nothing' (as opposed to DIE) 
       !   missing_in_state = any(ens_handle%copies(1:ens_size, state_index) == MISSING_R8)
@@ -791,12 +791,12 @@
       missing_in_state = any(ens_handle%copies(1:ens_size, state_index) == MISSING_R8)
       
       if ( missing_in_state ) then
-         if ( allow_missing_in_state ) then
+         if ( allow_missing_in_clm ) then
             cycle STATE_UPDATE
          else
             ! FIXME ... at some point ... convey which instances are missing
             write(msgstring,*)'Encountered a MISSING_R8 in DART at state index ',state_index
-            write(msgstring2,*)'namelist value of allow_missing_in_state (.false.) &
+            write(msgstring2,*)'namelist value of allow_missing_in_clm (.false.) &
                             &implies a fatal error.'
             call error_handler(E_ERR, 'filter_assim', msgstring, &
                source, revision, revdate, text2=msgstring2)
@@ -2454,12 +2454,29 @@
 ! (right now, only > 0 prints anything and it doesn't matter how
 ! large the value is.)
 
+! Initialize assim_tools_module if needed
+if (.not. module_initialized) call assim_tools_init()
 
 print_trace_details = execution_level
 print_timestamps    = timestamp_level
 
 end subroutine set_assim_tools_trace
 
+!------------------------------------------------------------------------
+
+function get_missing_ok_status()
+ logical :: get_missing_ok_status
+
+! see if the namelist variable allows missing values in the
+! model state or not.
+
+! Initialize assim_tools_module if needed
+if (.not. module_initialized) call assim_tools_init()
+
+get_missing_ok_status = allow_missing_in_clm
+
+end function get_missing_ok_status
+
 !--------------------------------------------------------------------
 
 function revised_distance(orig_dist, newcount, oldcount, base, cutfloor)

Modified: DART/trunk/assim_tools/assim_tools_mod.html
===================================================================
--- DART/trunk/assim_tools/assim_tools_mod.html	2013-08-27 21:11:01 UTC (rev 6434)
+++ DART/trunk/assim_tools/assim_tools_mod.html	2013-08-27 21:54:57 UTC (rev 6435)
@@ -303,7 +303,7 @@
    rectangular_quadrature          = .true.,
    gaussian_likelihood_tails       = .false.,
    close_obs_caching               = .true.,
-   allow_missing_in_state          = .false.
+   allow_missing_in_clm            = .false.
    special_localization_obs_types  = "",
    special_localization_cutoffs    = -1,
 /
@@ -470,14 +470,18 @@
 
 
 <TR>
- <TD> allow_missing_in_state </TD>
+ <TD> allow_missing_in_clm </TD>
  <TD> logical </TD>
  <TD> If true, missing values (MISSING_R8 as defined in the types_mod.f90
 file) are allowed in the state vector.  Model interpolation routines
 must be written to recognize this value and fail the interpolation. 
 During assimilation any state vector items where one or more of the 
 ensemble members are missing will be skipped and their values will 
-be unchanged by the assimilation.
+be unchanged by the assimilation.  The system currently has limited
+support for this option; the CLM model has been tested and is known
+to work.  Other users with models which would benefit from setting missing
+values in the state vector are encouraged to contact
+<a href="mailto:dart at ucar.edu">dart at ucar.edu</a>.
  </TD> </TR>
 
 </TBODY>

Modified: DART/trunk/assim_tools/assim_tools_mod.nml
===================================================================
--- DART/trunk/assim_tools/assim_tools_mod.nml	2013-08-27 21:11:01 UTC (rev 6434)
+++ DART/trunk/assim_tools/assim_tools_mod.nml	2013-08-27 21:54:57 UTC (rev 6435)
@@ -17,7 +17,7 @@
    rectangular_quadrature          = .true.,
    gaussian_likelihood_tails       = .false.,
    close_obs_caching               = .true.,
-   allow_missing_in_state          = .false.
+   allow_missing_in_clm            = .false.
 /
 
 # specify these in the same order, the same number of items

Modified: DART/trunk/filter/filter.dopplerfold.f90
===================================================================
--- DART/trunk/filter/filter.dopplerfold.f90	2013-08-27 21:11:01 UTC (rev 6434)
+++ DART/trunk/filter/filter.dopplerfold.f90	2013-08-27 21:54:57 UTC (rev 6435)
@@ -29,7 +29,7 @@
 use assim_model_mod,      only : static_init_assim_model, get_model_size,                    &
                                  netcdf_file_type, init_diag_output, finalize_diag_output,   & 
                                  aoutput_diagnostics, ens_mean_for_model, end_assim_model
-use assim_tools_mod,      only : filter_assim, set_assim_tools_trace
+use assim_tools_mod,      only : filter_assim, set_assim_tools_trace, get_missing_ok_status
 use obs_model_mod,        only : move_ahead, advance_state, set_obs_model_trace
 use ensemble_manager_mod, only : init_ensemble_manager, end_ensemble_manager,                &
                                  ensemble_type, get_copy, get_my_num_copies, put_copy,       &
@@ -191,7 +191,7 @@
 ! in the long run
 real(r8), allocatable   :: ens_mean(:)
 
-logical                 :: ds, all_gone
+logical                 :: ds, all_gone, allow_missing
 
 
 call filter_initialize_modules_used()
@@ -306,6 +306,9 @@
 call timestamp_message('After  reading in ensemble restart files')
 call     trace_message('After  reading in ensemble restart files')
 
+! see what our stance is on missing values in the state vector
+allow_missing = get_missing_ok_status()
+
 call trace_message('Before initializing inflation')
 
 ! Initialize the adaptive inflation module
@@ -313,12 +316,12 @@
    inf_sd_initial_from_restart(1), inf_output_restart(1), inf_deterministic(1),       &
    inf_in_file_name(1), inf_out_file_name(1), inf_diag_file_name(1), inf_initial(1),  &
    inf_sd_initial(1), inf_lower_bound(1), inf_upper_bound(1), inf_sd_lower_bound(1),  &
-   ens_handle, PRIOR_INF_COPY, PRIOR_INF_SD_COPY, 'Prior')
+   ens_handle, PRIOR_INF_COPY, PRIOR_INF_SD_COPY, allow_missing, 'Prior')
 call adaptive_inflate_init(post_inflate, inf_flavor(2), inf_initial_from_restart(2),  &
    inf_sd_initial_from_restart(2), inf_output_restart(2), inf_deterministic(2),       &
    inf_in_file_name(2), inf_out_file_name(2), inf_diag_file_name(2), inf_initial(2),  &
    inf_sd_initial(2), inf_lower_bound(2), inf_upper_bound(2), inf_sd_lower_bound(2),  &
-   ens_handle, POST_INF_COPY, POST_INF_SD_COPY, 'Posterior')
+   ens_handle, POST_INF_COPY, POST_INF_SD_COPY, allow_missing, 'Posterior')
 
 if (do_output()) then
    if (inf_flavor(1) > 0 .and. inf_damping(1) < 1.0_r8) then

Modified: DART/trunk/filter/filter.f90
===================================================================
--- DART/trunk/filter/filter.f90	2013-08-27 21:11:01 UTC (rev 6434)
+++ DART/trunk/filter/filter.f90	2013-08-27 21:54:57 UTC (rev 6435)
@@ -29,7 +29,7 @@
 use assim_model_mod,      only : static_init_assim_model, get_model_size,                    &
                                  netcdf_file_type, init_diag_output, finalize_diag_output,   & 
                                  aoutput_diagnostics, ens_mean_for_model, end_assim_model
-use assim_tools_mod,      only : filter_assim, set_assim_tools_trace
+use assim_tools_mod,      only : filter_assim, set_assim_tools_trace, get_missing_ok_status
 use obs_model_mod,        only : move_ahead, advance_state, set_obs_model_trace
 use ensemble_manager_mod, only : init_ensemble_manager, end_ensemble_manager,                &
                                  ensemble_type, get_copy, get_my_num_copies, put_copy,       &
@@ -187,7 +187,7 @@
 ! in the long run
 real(r8), allocatable   :: ens_mean(:)
 
-logical                 :: ds, all_gone
+logical                 :: ds, all_gone, allow_missing
 
 
 call filter_initialize_modules_used()
@@ -302,6 +302,9 @@
 call timestamp_message('After  reading in ensemble restart files')
 call     trace_message('After  reading in ensemble restart files')
 
+! see what our stance is on missing values in the state vector
+allow_missing = get_missing_ok_status()
+
 call trace_message('Before initializing inflation')
 
 ! Initialize the adaptive inflation module
@@ -309,12 +312,12 @@
    inf_sd_initial_from_restart(1), inf_output_restart(1), inf_deterministic(1),       &
    inf_in_file_name(1), inf_out_file_name(1), inf_diag_file_name(1), inf_initial(1),  &
    inf_sd_initial(1), inf_lower_bound(1), inf_upper_bound(1), inf_sd_lower_bound(1),  &
-   ens_handle, PRIOR_INF_COPY, PRIOR_INF_SD_COPY, 'Prior')
+   ens_handle, PRIOR_INF_COPY, PRIOR_INF_SD_COPY, allow_missing, 'Prior')
 call adaptive_inflate_init(post_inflate, inf_flavor(2), inf_initial_from_restart(2),  &
    inf_sd_initial_from_restart(2), inf_output_restart(2), inf_deterministic(2),       &
    inf_in_file_name(2), inf_out_file_name(2), inf_diag_file_name(2), inf_initial(2),  &
    inf_sd_initial(2), inf_lower_bound(2), inf_upper_bound(2), inf_sd_lower_bound(2),  &
-   ens_handle, POST_INF_COPY, POST_INF_SD_COPY, 'Posterior')
+   ens_handle, POST_INF_COPY, POST_INF_SD_COPY, allow_missing, 'Posterior')
 
 if (do_output()) then
    if (inf_flavor(1) > 0 .and. inf_damping(1) < 1.0_r8) then

Modified: DART/trunk/models/clm/work/input.nml
===================================================================
--- DART/trunk/models/clm/work/input.nml	2013-08-27 21:11:01 UTC (rev 6434)
+++ DART/trunk/models/clm/work/input.nml	2013-08-27 21:54:57 UTC (rev 6435)
@@ -81,7 +81,7 @@
 &assim_tools_nml
    filter_kind                     = 1,
    cutoff                          = 0.05,
-   allow_missing_in_state          = .true.,
+   allow_missing_in_clm            = .true.,
    sort_obs_inc                    = .false.,
    spread_restoration              = .false.,
    sampling_error_correction       = .false.,

Modified: DART/trunk/obs_sequence/obs_sequence_mod.f90
===================================================================
--- DART/trunk/obs_sequence/obs_sequence_mod.f90	2013-08-27 21:11:01 UTC (rev 6434)
+++ DART/trunk/obs_sequence/obs_sequence_mod.f90	2013-08-27 21:54:57 UTC (rev 6435)
@@ -360,7 +360,10 @@
          'identity obs is outside of state vector ', &
          source, revision, revdate)
       obs_vals(i) = state(-1 * obs_kind_ind)
+      ! fixme: we currently have no option to eval only identity obs,
+      ! or select to skip their assimilation via namelist.
       assimilate_this_ob = .true.; evaluate_this_ob = .false.
+     if (obs_vals(i) == missing_r8) istatus = 1
 ! Otherwise do forward operator for this kind
    else
       call get_expected_obs_from_def(keys(i), obs_def, obs_kind_ind, &

Modified: DART/trunk/smoother/smoother_mod.f90
===================================================================
--- DART/trunk/smoother/smoother_mod.f90	2013-08-27 21:11:01 UTC (rev 6434)
+++ DART/trunk/smoother/smoother_mod.f90	2013-08-27 21:54:57 UTC (rev 6435)
@@ -22,7 +22,7 @@
 use assim_model_mod,      only : static_init_assim_model, get_model_size,                    &
                                  netcdf_file_type, init_diag_output, finalize_diag_output,   &
                                  aoutput_diagnostics
-use assim_tools_mod,      only : filter_assim
+use assim_tools_mod,      only : filter_assim, get_missing_ok_status
 use obs_sequence_mod,     only : obs_sequence_type
 use adaptive_inflate_mod, only : adaptive_inflate_type, adaptive_inflate_init, &
                                  do_varying_ss_inflate, do_single_ss_inflate
@@ -109,14 +109,19 @@
 type(ensemble_type), intent(inout) :: ens_handle
 integer,             intent(in) :: POST_INF_COPY, POST_INF_SD_COPY
 
+logical :: allow_missing
+
 ! static_init_smoother initializes module and read namelist
 if ( .not. module_initialized ) call static_init_smoother()
 
+! find out if it is ok to have missing values in the state vector
+allow_missing = get_missing_ok_status()
+
 ! Initialize a null adaptive_inflate type since inflation is not done at lags
 ! NOTE: Using ens_handle here (not lag_handle) so it doesn't die for 0 lag choice
 if(num_lags > 0) call adaptive_inflate_init(lag_inflate, 0, .false., .false., .false., &
    .true., 'no_lag_inflate', 'no_lag_inflate', 'no_lag_inflate', 1.0_r8, 0.0_r8,       &
-   1.0_r8, 1.0_r8, 0.0_r8, ens_handle, POST_INF_COPY, POST_INF_SD_COPY, "Lag")
+   1.0_r8, 1.0_r8, 0.0_r8, ens_handle, POST_INF_COPY, POST_INF_SD_COPY, allow_missing, "Lag")
 
 end subroutine init_smoother
 


More information about the Dart-dev mailing list