[Dart-dev] DART/branches Revision: 12323

[dart at ucar.edu]

thoar at ucar.edu
2018-01-12 11:42:47 -0700 (Fri, 12 Jan 2018)
62
Adding Nancy's widget to selectively thin observations sets.




Added: DART/branches/coamps/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.f90
===================================================================
--- DART/branches/coamps/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.f90	                        (rev 0)
+++ DART/branches/coamps/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.f90	2018-01-12 18:42:47 UTC (rev 12323)
@@ -0,0 +1,587 @@
+! DART software - Copyright UCAR. This open source software is provided
+! by UCAR, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/DAReS/DART/DART_download
+!
+! $Id$
+
+program obs_keep_a_few
+
+!> open an obs_seq file and copy over the first N of each obs type to
+!> the output file. the value of N is namelist-settable.  intended
+!> to subset a large obs_seq file for testing or other purposes but
+!> still keep examples of each type of obs from the input.
+
+use        types_mod, only : r8, missing_r8, metadatalength
+use    utilities_mod, only : register_module, initialize_utilities,            &
+                             find_namelist_in_file, check_namelist_read,       &
+                             error_handler, E_ERR, E_MSG, nmlfileunit,         &
+                             do_nml_file, do_nml_term, get_next_filename,      &
+                             open_file, close_file, finalize_utilities
+use     location_mod, only : location_type, get_location, set_location,        &
+                             LocationName, read_location, operator(/=),        &
+                             write_location
+use      obs_def_mod, only : obs_def_type, get_obs_def_time, get_obs_def_type_of_obs, &
+                             get_obs_def_location, read_obs_def,               &
+                             set_obs_def_time
+use     obs_kind_mod, only : max_defined_types_of_obs, get_name_for_type_of_obs, &
+                             get_index_for_type_of_obs, read_type_of_obs_table,  &
+                             get_num_types_of_obs
+use time_manager_mod, only : time_type, operator(>), print_time, set_time,     &
+                             print_date, set_calendar_type,                    &
+                             operator(/=), get_calendar_type, NO_CALENDAR,     &
+                             operator(-)
+use obs_sequence_mod, only : obs_sequence_type, obs_type, write_obs_seq,       &
+                             init_obs, assignment(=), get_obs_def,             &
+                             init_obs_sequence, static_init_obs_sequence,      &
+                             read_obs_seq_header, read_obs_seq, get_num_obs,   &
+                             get_first_obs, get_last_obs, get_next_obs,        &
+                             insert_obs_in_seq, get_num_copies, get_num_qc,    &
+                             get_copy_meta_data, get_qc_meta_data,             &
+                             set_copy_meta_data, set_qc_meta_data,             &
+                             destroy_obs, destroy_obs_sequence,                &
+                             delete_seq_head, delete_seq_tail,                 &
+                             get_num_key_range, get_obs_key, get_qc,           &
+                             copy_partial_obs, get_next_obs_from_key,          &
+                             get_obs_def, set_obs_def
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=256), parameter :: source   = &
+   "$URL$"
+character(len=32 ), parameter :: revision = "$Revision$"
+character(len=128), parameter :: revdate  = "$Date$"
+
+type(obs_sequence_type) :: seq_in, seq_out
+type(obs_type)          :: obs_in, next_obs_in
+type(obs_type)          :: obs_out, prev_obs_out
+logical                 :: is_this_last
+integer                 :: size_seq_in, size_seq_out
+integer                 :: num_copies_in, num_qc_in
+integer                 :: num_inserted, iunit, io, i, j
+integer                 :: max_num_obs, file_id
+integer                 :: num_rejected_badqc, num_rejected_diffqc
+integer                 :: num_rejected_other
+character(len=129)      :: read_format
+logical                 :: pre_I_format, cal
+character(len=512)      :: msgstring, msgstring1, msgstring2, msgstring3
+type(obs_def_type)      :: this_obs_def
+
+integer, allocatable    :: n_this_type(:)
+integer                 :: this_type
+
+character(len=metadatalength) :: meta_data
+
+! could go into namelist if you wanted more control
+integer, parameter      :: print_every = 5000
+
+! lazy, pick big number.  make it bigger if too small.
+integer, parameter :: max_obs_input_types = 500
+
+!----------------------------------------------------------------
+! Namelist input with default values
+
+
+character(len=256)   :: filename_in = ''
+character(len=256)   :: filename_out = ''
+
+integer              :: keep_N_of_each  = 10
+integer              :: max_all_obs_out = -1
+
+logical              :: print_only    = .false.
+character(len=32)    :: calendar      = 'Gregorian'
+
+
+namelist /obs_keep_a_few_nml/ &
+         filename_in, filename_out, &