[Dart-dev] [4809] DART/trunk/obs_sequence: Add option to obs_sequence_tool to insert new copies or qcs into existing obs ,

nancy at ucar.edu nancy at ucar.edu
Wed Mar 23 15:00:32 MDT 2011


Revision: 4809
Author:   nancy
Date:     2011-03-23 15:00:32 -0600 (Wed, 23 Mar 2011)
Log Message:
-----------
Add option to obs_sequence_tool to insert new copies or qcs into existing obs,
along with setting a data value.  Could be used to set an incoming data QC in
an obs_seq file that's missing one, for example.  Also added some more error
checks to the copy_partial_obs() routine, and added initial values to the
add_copies() and add_qc() routines (before, new copies or qcs had uninitialized
values).  Updated the obs_sequence_tool docs to add examples of using the new
functions.

Modified Paths:
--------------
    DART/trunk/obs_sequence/obs_sequence_mod.f90
    DART/trunk/obs_sequence/obs_sequence_tool.f90
    DART/trunk/obs_sequence/obs_sequence_tool.html
    DART/trunk/obs_sequence/obs_sequence_tool.nml

-------------- next part --------------
Modified: DART/trunk/obs_sequence/obs_sequence_mod.f90
===================================================================
--- DART/trunk/obs_sequence/obs_sequence_mod.f90	2011-03-23 20:49:38 UTC (rev 4808)
+++ DART/trunk/obs_sequence/obs_sequence_mod.f90	2011-03-23 21:00:32 UTC (rev 4809)
@@ -1052,18 +1052,16 @@
 seq%copy_meta_data(old_num+1 : old_num + num_to_add) = 'Copy metadata not initialized'
 
 ! Loop through all the observations, copy and increase size
-!??? WHAT IS THE STORY WITH NUM_OBS WHEN A DELETION IS DONE???
 do i = 1, seq%max_num_obs
 
 ! Copy the existing values
-   if(old_num > 0 .and. i < seq%num_obs) then
-      values_temp = seq%obs(i)%values
-   end if
+   if(old_num > 0) values_temp = seq%obs(i)%values
 
 ! Deallocate, reallocate and copy
    deallocate(seq%obs(i)%values)
    allocate(seq%obs(i)%values(old_num + num_to_add))
    seq%obs(i)%values(1:old_num) = values_temp
+   seq%obs(i)%values(old_num+1:old_num+num_to_add) = MISSING_r8
 
 end do
 
@@ -1101,18 +1099,16 @@
 seq%qc_meta_data(old_num+1 : old_num + num_to_add) = 'QC metadata not initialized'
 
 ! Loop through all the observations, copy and increase size
-!??? WHAT IS THE STORY WITH NUM_OBS WHEN A DELETION IS DONE???
 do i = 1, seq%max_num_obs
 
 ! Copy the existing values
-   if(old_num > 0 .and. i < seq%num_obs) then
-      values_temp = seq%obs(i)%qc
-   end if
+   if(old_num > 0) values_temp = seq%obs(i)%qc
 
 ! Deallocate, reallocate and copy
    deallocate(seq%obs(i)%qc)
    allocate(seq%obs(i)%qc(old_num + num_to_add))
    seq%obs(i)%qc(1:old_num) = values_temp
+   seq%obs(i)%qc(old_num+1:old_num+num_to_add) = 0.0_r8
 
 end do
 
@@ -2218,17 +2214,44 @@
                             numqc, qclist)
 
 ! Copy from obs2 to obs1, the entire contents of the
-! obs def, but only the copies and qcs listed (in order)
+! obs def, but only the copies and qcs as listed (in order)
+! Special value (0) means leave space but there is
+! no existing value to copy.
 
 type(obs_type), intent(inout) :: obs1
 type(obs_type), intent(in) :: obs2
 integer, intent(in) :: numcopies, copylist(:), numqc, qclist(:)
 
-integer :: i
+integer :: i, ival
 
-! this needs idiotproofing - e.g. bad indices in the copylist
-! or qc list -- without too much expense in time.
+! only basic idiotproofing - detect bad indices in the lists
+! without too much expense in time.  no checks here that length
+! of lists are >= num sizes.
 
+! numcopies and numqc are the new outgoing sizes in obs1.
+! check the index lists to be sure they are >= 0 and <= size
+! of existing data in obs2.  
+ival = min(minval(copylist(1:numcopies)), minval(qclist(1:numqc)))
+if (ival < 0) then
+   write(msgstring, '(A,I8,A)') 'index list value, ', ival, ' must be >= 0'
+   call error_handler(E_ERR, 'copy_partial_obs:', msgstring, &
+               source, revision, revdate)
+endif
+ival = maxval(copylist(1:numcopies))
+if (ival > size(obs2%values)) then
+   write(msgstring, '(A,I8,A,I8)') 'index list value, ', ival, &
+      ' is larger than copies length, ', size(obs2%values)
+   call error_handler(E_ERR, 'copy_partial_obs:', msgstring, &
+               source, revision, revdate)
+endif
+ival = maxval(qclist(1:numqc))
+if (ival > size(obs2%qc)) then
+   write(msgstring, '(A,I8,A,I8)') 'index list value, ', ival, &
+      ' is larger than qc length, ', size(obs2%qc)
+   call error_handler(E_ERR, 'copy_partial_obs:', msgstring, &
+               source, revision, revdate)
+endif
+
 obs1%key = obs2%key
 call copy_obs_def(obs1%def, obs2%def)
 
@@ -2251,12 +2274,18 @@
 endif
 
 do i = 1, numcopies
-   ! error checks here?  if copylist(i) > numcopies or < 1, err out
-   obs1%values(i) = obs2%values(copylist(i))
+   if (copylist(i) == 0) then
+       obs1%values(i) = MISSING_R8
+   else
+       obs1%values(i) = obs2%values(copylist(i))
+   endif
 enddo
 do i = 1, numqc
-   ! and here?  if qclist(i) > numqc or < 1, err out
-   obs1%qc(i) = obs2%qc(qclist(i))
+   if (qclist(i) == 0) then
+      obs1%qc(i) = 0.0_r8
+   else
+      obs1%qc(i) = obs2%qc(qclist(i))
+   endif
 enddo
 
 obs1%prev_time = obs2%prev_time

Modified: DART/trunk/obs_sequence/obs_sequence_tool.f90
===================================================================
--- DART/trunk/obs_sequence/obs_sequence_tool.f90	2011-03-23 20:49:38 UTC (rev 4808)
+++ DART/trunk/obs_sequence/obs_sequence_tool.f90	2011-03-23 21:00:32 UTC (rev 4809)
@@ -38,7 +38,7 @@
                              get_obs_key, copy_partial_obs, &
                              delete_obs_from_seq, get_next_obs_from_key, &
                              delete_obs_by_qc, delete_obs_by_copy, &
-                             select_obs_by_location 
+                             select_obs_by_location, set_obs_values, set_qc
 
 implicit none
 
@@ -89,6 +89,9 @@
 character(len = 129) :: filename_out  = 'obs_seq.processed'
 logical              :: process_file(max_num_input_files)
 
+! 256 is an arb max of number of copies for data and qc
+integer, parameter :: long_lists = 256
+
 ! Time of first and last observations to be used from obs_sequence
 ! If negative, these are not used
 integer  :: first_obs_days    = -1
@@ -111,19 +114,22 @@
 character(len = obstypelength) :: copy_type = ''
 character(len=metadatalength)  :: copy_metadata = ''
 character(len=metadatalength)  :: qc_metadata = ''
-! 256 is an arb max of number of copies for data and qc
 logical  :: edit_copy_metadata = .false.
-character(len=metadatalength) :: new_copy_metadata(256) = ''
+character(len=metadatalength) :: new_copy_metadata(long_lists) = ''
 logical  :: edit_copies = .false.
-integer  :: new_copy_index(256) = -1
+integer  :: new_copy_index(long_lists) = -1
 integer  :: copy_index_len = 0
+real(r8) :: new_copy_data(long_lists) = MISSING_R8
+integer  :: copy_data_len = 0
 logical  :: edit_qc_metadata = .false.
-character(len=metadatalength) :: new_qc_metadata(256)   = ''
+character(len=metadatalength) :: new_qc_metadata(long_lists)   = ''
 logical  :: edit_qcs = .false.
-integer  :: new_qc_index(256) = -1
+integer  :: new_qc_index(long_lists) = -1
 integer  :: qc_index_len = 0
-character(len=metadatalength) :: synonymous_copy_list(256) = ''
-character(len=metadatalength) :: synonymous_qc_list(256)   = ''
+real(r8) :: new_qc_data(long_lists) = MISSING_R8
+integer  :: qc_data_len = 0
+character(len=metadatalength) :: synonymous_copy_list(long_lists) = ''
+character(len=metadatalength) :: synonymous_qc_list(long_lists)   = ''
 logical  :: keep_types = .true.
 logical  :: print_only = .false.
 logical  :: gregorian_cal = .true.
@@ -139,7 +145,7 @@
          min_gps_height, edit_copy_metadata, new_copy_index,                 &
          edit_qc_metadata, new_qc_index, synonymous_copy_list,               &
          synonymous_qc_list, edit_copies, edit_qcs, new_copy_metadata,       &
-         new_qc_metadata
+         new_qc_metadata, new_copy_data, new_qc_data
 
 !----------------------------------------------------------------
 ! Start of the program:
@@ -218,9 +224,10 @@
                          source,revision,revdate)
    endif
    restrict_by_location = .true.
-   if (trim(LocationName) /= 'loc3Dsphere') then
+   if ((trim(LocationName) /= 'loc3Dsphere') .and.  &
+       (trim(LocationName) /= 'loc2Dsphere')) then  
       call error_handler(E_ERR,'obs_sequence_tool', &
-                         'can only use lat/lon box with 3d sphere locations', &
+                         'can only use lat/lon box with 2d/3d sphere locations', &
                          source,revision,revdate)
    endif
    ! simple err checks before going on; try to catch radians vs degrees or
@@ -444,8 +451,8 @@
          ! do a tiny bit of sanity checking here.
          do j = 1, copy_index_len
             if ((new_copy_index(j) > num_copies_in) .or. &
-                (new_copy_index(j) < 1)) then
-               write(msgstring,*)'new_copy_index values must be between 1 and ', num_copies_in
+                (new_copy_index(j) < 0)) then   ! was < 1 here and below
+               write(msgstring,*)'new_copy_index values must be between 0 and ', num_copies_in
                call error_handler(E_ERR,'obs_sequence_tool', msgstring, &
                                   source,revision,revdate)
 
@@ -465,8 +472,8 @@
       if (edit_qcs) then
          do j = 1, qc_index_len
             if ((new_qc_index(j) > num_qc_in) .or. &
-                (new_qc_index(j) < 1)) then
-               write(msgstring,*)'new_qc_index values must be between 1 and ', num_qc_in
+                (new_qc_index(j) < 0)) then  ! was < 1 here and below
+               write(msgstring,*)'new_qc_index values must be between 0 and ', num_qc_in
                call error_handler(E_ERR,'obs_sequence_tool', msgstring, &
                                   source,revision,revdate)
 
@@ -539,8 +546,13 @@
       do j=1, num_copies_out
          if (edit_copy_metadata) then
             meta_data = new_copy_metadata(j)
-            write(msgstring, *)'replacing original copy meta_data: ' // &
-                                trim(get_copy_meta_data(seq_in, new_copy_index(j)))
+            if (new_copy_index(j) > 0) then
+               write(msgstring, *)'replacing original copy meta_data: ' // &
+                                   trim(get_copy_meta_data(seq_in, new_copy_index(j)))
+            else
+               write(msgstring, *)'replacing original copy meta_data: ' // &
+                                   trim(get_copy_meta_data(seq_out, j))
+            endif
             call error_handler(E_MSG,'obs_sequence_tool',msgstring)
             write(msgstring, *)' with: ' // trim(meta_data)
             call error_handler(E_MSG,'obs_sequence_tool',msgstring)
@@ -549,7 +561,11 @@
                call error_handler(E_MSG,'obs_sequence_tool',msgstring)
             endif
          else
-            meta_data = get_copy_meta_data(seq_in, new_copy_index(j)) 
+            if (new_copy_index(j) > 0) then
+               meta_data = get_copy_meta_data(seq_in, new_copy_index(j)) 
+            else
+               meta_data = get_copy_meta_data(seq_out, j) 
+            endif
             if (new_copy_index(j) /= j) then
                write(msgstring, *)'copy with meta_data: ' // trim(meta_data)
                call error_handler(E_MSG,'obs_sequence_tool',msgstring)
@@ -562,8 +578,13 @@
       do j=1, num_qc_out
          if (edit_qc_metadata) then
             meta_data = new_qc_metadata(j)
-            write(msgstring, *)'replacing original qc meta_data: ' // &
-                                trim(get_qc_meta_data(seq_in, new_qc_index(j)))
+            if (new_qc_index(j) > 0) then
+               write(msgstring, *)'replacing original qc meta_data: ' // &
+                                   trim(get_qc_meta_data(seq_in, new_qc_index(j)))
+            else
+               write(msgstring, *)'replacing original qc meta_data: ' // &
+                                   trim(get_qc_meta_data(seq_out, j))
+            endif
             call error_handler(E_MSG,'obs_sequence_tool',msgstring)
             write(msgstring, *)' with: ' // trim(meta_data)
             call error_handler(E_MSG,'obs_sequence_tool',msgstring)
@@ -572,7 +593,11 @@
                call error_handler(E_MSG,'obs_sequence_tool',msgstring)
             endif
          else
-            meta_data = get_qc_meta_data(seq_in, new_qc_index(j)) 
+            if (new_qc_index(j) > 0) then
+               meta_data = get_qc_meta_data(seq_in, new_qc_index(j)) 
+            else
+               meta_data = get_qc_meta_data(seq_out, j) 
+            endif
             if (new_qc_index(j) /= j) then
                write(msgstring, *)'qc with meta_data: ' // trim(meta_data)
                call error_handler(E_MSG,'obs_sequence_tool',msgstring)
@@ -616,6 +641,10 @@
          call copy_partial_obs(obs_out, obs_in,                &
                                num_copies_out, new_copy_index, &
                                num_qc_out, new_qc_index) 
+
+         ! if new copies or qcs were added, set the initial data values
+         call set_new_data(obs_out, edit_copies, new_copy_index, new_copy_data, &
+                                    edit_qcs,    new_qc_index,   new_qc_data)
       else
          obs_out = obs_in
       endif
@@ -643,6 +672,10 @@
             call copy_partial_obs(obs_out, obs_in,                &
                                   num_copies_out, new_copy_index, &
                                   num_qc_out, new_qc_index) 
+
+            ! if new copies or qcs were added, set the initial data values
+            call set_new_data(obs_out, edit_copies, new_copy_index, new_copy_data, &
+                                       edit_qcs,    new_qc_index,   new_qc_data)
          else
             obs_out = obs_in
          endif
@@ -682,6 +715,7 @@
 
 enddo
 
+
 write(msgstring,*) 'Starting to process output sequence file ', trim(filename_out)
 call error_handler(E_MSG,'obs_sequence_tool',msgstring)
 
@@ -733,7 +767,8 @@
 ! In order to be merged, the two observation sequences must have the same
 ! number of qc values, the same number of copies ... 
 !
-! The messages might be a bit misleading 'warning', 'warning', 'error' ...
+! change the error to use the 2 additional text lines rather than
+! making some warnings and the last one an error.
 !
 ! FIXME:  this routine uses several globals now from the namelist that
 ! should be arguments to this routine.  i'm being lazy (or expedient) here
@@ -742,6 +777,9 @@
 ! and now there is an additional restriction -- if editing the copies or
 ! qc entries, seq1 has already been edited and only 2 needs the editing
 ! applied.  before they were completely symmetric.
+!
+! in this case, seq1 must be the new out sequence, and seq2 is one
+! of the input sequences
 
  type(obs_sequence_type), intent(IN) :: seq1, seq2
  character(len=*), optional :: fname1, fname2
@@ -751,7 +789,7 @@
 integer :: num_copies , num_qc, i, j
 logical :: have_match1, have_match2
 character(len=metadatalength) :: str1, str2
-character(len=255) :: msgstring1, msgstring2
+character(len=255) :: msgstring1, msgstring2, msgstring3
 
 num_copies1 = get_num_copies(seq1)
 num_qc1     = get_num_qc(    seq1)
@@ -776,17 +814,21 @@
 if ( num_copies1 /= num_copies2 ) then
    write(msgstring2,*)'Different numbers of data copies found: ', &
                       num_copies1, ' vs ', num_copies2 
-   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
    num_copies = -1
+else
+   write(msgstring2,*)'Number of data copies match'
 endif
 if ( num_qc1 /= num_qc2 ) then
-   write(msgstring2,*)'Different different numbers of QCs found: ', &
+   write(msgstring3,*)'Different different numbers of QCs found: ', &
                       num_qc1, ' vs ', num_qc2
-   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
    num_qc = -1
+else
+   write(msgstring3,*)'Number of qc copies match'
 endif
 if ( num_copies < 0 .or. num_qc < 0 ) then
-   call error_handler(E_ERR, 'obs_sequence_tool', msgstring1, source, revision, revdate)
+   call error_handler(E_ERR, 'obs_sequence_tool', msgstring1, &
+                             source, revision, revdate, &
+                             text2=msgstring2, text3=msgstring3)
 endif
 
 ! watch the code flow in this loop and the one below it.
@@ -800,7 +842,11 @@
    if (edit_copy_metadata) then
       str2 = new_copy_metadata(i)
    else
-      str2 = get_copy_meta_data(seq2, new_copy_index(i)) 
+      if (new_copy_index(i) > 0) then
+         str2 = get_copy_meta_data(seq2, new_copy_index(i)) 
+      else
+         str2 = get_copy_meta_data(seq1, i) 
+      endif
    endif
 
    ! easy case - they match.  cycle to next copy.
@@ -832,39 +878,24 @@
       ! if both are true, you found both strings in the list and
       ! it is ok to proceed.
       if (have_match1 .and. have_match2) then
-         write(msgstring2,*)'different copy metadata strings ok because both on synonymous list'
-         call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
          write(msgstring2,*)'one is: ', trim(str1)
-         call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-         write(msgstring2,*)'one is: ', trim(str2)
-         call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
+         write(msgstring3,*)'one is: ', trim(str2)
+         call error_handler(E_MSG, 'obs_sequence_tool', &
+                              'different copy metadata strings ok because both on synonymous list', &
+                              text2=msgstring2, text3=msgstring3)
          cycle CopyMetaData
       endif
 
       ! if no match, fall out of the if.
    endif
     
-   !! FIXME: this could be dangerous - it allows any metadata string with
-   !! the substring 'observation' to match any other.  if there are multiple
-   !! strings with 'observation', it will allow them to match.  for now it
-   !! allows 'NCEP BUFR observations' to match 'observation', for example,
-   !! but it's dangerous.
-   !if ((index(str1, 'observation') > 0) .and. &
-   !    (index(str2, 'observation') > 0)) then
-   !   write(msgstring2,*)'observation metadata in both ',trim(str1), ' and ', trim(str2)
-   !   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-   !   write(msgstring2,*)'ALLOWING NON-EXACT MATCH'
-   !   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-   !   cycle CopyMetaData
-   !! end FIXME
-
    ! if you get here, the metadata is not the same and the user has not
    ! given us strings that are ok to match.  fail.
-   write(msgstring2,*)'metadata value mismatch. seq1: ', trim(str1)
-   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-   write(msgstring2,*)'metadata value mismatch. seq2: ', trim(str2)
-   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-   call error_handler(E_ERR, 'obs_sequence_tool', msgstring1, source, revision, revdate)
+   write(msgstring2,*)'copy metadata mismatch, file 1: ', trim(str1)
+   write(msgstring3,*)'copy metadata mismatch, file 2: ', trim(str2)
+   call error_handler(E_ERR, 'obs_sequence_tool', msgstring1, &
+                              source, revision, revdate, &
+                              text2=msgstring2, text3=msgstring3)
 
 enddo CopyMetaData
 
@@ -874,7 +905,11 @@
    if (edit_qc_metadata) then
       str2 = new_qc_metadata(i)
    else
-      str2 = get_qc_meta_data(seq2, new_qc_index(i)) 
+      if (new_qc_index(i) > 0) then
+         str2 = get_qc_meta_data(seq2, new_qc_index(i)) 
+      else
+         str2 = get_qc_meta_data(seq1, i) 
+      endif
    endif
 
 
@@ -887,7 +922,7 @@
 
    ! see if user provided a list of metadata strings that are
    ! the same values and can be considered a match.
-   if (matching_copy_metadata) then
+   if (matching_qc_metadata) then
       have_match1 = .false.
       do j=1, matching_qc_limit
          if (trim(str1) == trim(synonymous_qc_list(j))) then
@@ -907,38 +942,24 @@
       ! if both are true, you found both strings in the list and
       ! it is ok to proceed.
       if (have_match1 .and. have_match2) then
-         write(msgstring2,*)'different qc metadata strings ok because both on synonymous list'
-         call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
          write(msgstring2,*)'one is: ', trim(str1)
-         call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-         write(msgstring2,*)'one is: ', trim(str2)
-         call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
+         write(msgstring3,*)'one is: ', trim(str2)
+         call error_handler(E_MSG, 'obs_sequence_tool', &
+                              'different qc metadata strings ok because both on synonymous list', &
+                              text2=msgstring2, text3=msgstring3)
          cycle QCMetaData
       endif
 
       ! if no match, fall out of the if.
    endif
     
-   !! FIXME: this is even more dangerous than the obs - better to make the
-   !! user give an explicit list of strings that are ok to match.  but here
-   !! is the code if you wanted to make it more mindless.
-   !if (((index(str1, 'QC') > 0).or.(index(str1, 'quality control') > 0)).and. &
-   !    ((index(str2, 'QC') > 0).or.(index(str2, 'quality control') > 0))) then
-   !   write(msgstring2,*)'QC metadata in both ',trim(str1), ' and ', trim(str2)
-   !   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-   !   write(msgstring2,*)'ALLOWING NON-EXACT MATCH'
-   !   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-   !   cycle QCMetaData
-   !endif
-   !! end FIXME
-
    ! if you get here, the metadata is not the same and the user has not
    ! given us strings that are ok to match.  fail.
-   write(msgstring2,*)'qc metadata value mismatch. seq1: ', trim(str1)
-   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-   write(msgstring2,*)'qc metadata value mismatch. seq2: ', trim(str2)
-   call error_handler(E_MSG, 'obs_sequence_tool', msgstring2)
-   call error_handler(E_ERR, 'obs_sequence_tool', msgstring1, source, revision, revdate)
+   write(msgstring2,*)'qc metadata mismatch, file 1: ', trim(str1)
+   write(msgstring3,*)'qc metadata mismatch, file 2: ', trim(str2)
+   call error_handler(E_ERR, 'obs_sequence_tool', msgstring1, &
+                             source, revision, revdate, &
+                             text2=msgstring2, text3=msgstring3)
 
 enddo QCMetaData
 
@@ -1344,7 +1365,45 @@
 
 end subroutine print_metadata
 
+!---------------------------------------------------------------------
+subroutine set_new_data(obs, edit_copies, new_copy_index, new_copy_data, &
+                             edit_qcs,    new_qc_index,   new_qc_data)
 
+! if new copies or qcs were added, set the initial data values
+
+type(obs_type), intent(inout) :: obs
+logical,        intent(in)    :: edit_copies
+integer,        intent(in)    :: new_copy_index(:)
+real(r8),       intent(in)    :: new_copy_data(:)
+logical,        intent(in)    :: edit_qcs
+integer,        intent(in)    :: new_qc_index(:)
+real(r8),       intent(in)    :: new_qc_data(:)
+
+integer :: i, j
+character(len=129) :: msgstring1
+
+if (edit_copies) then     
+   j = 1
+   copy_loop: do i = 1, size(new_copy_index)
+      if (new_copy_index(i) == -1) exit copy_loop
+      if (new_copy_index(i) /= 0) cycle copy_loop
+      call set_obs_values(obs, new_copy_data(j:j), i)
+      j = j + 1
+   enddo copy_loop
+endif
+
+if (edit_qcs) then     
+   j = 1
+   qc_loop: do i = 1, size(new_qc_index)
+      if (new_qc_index(i) == -1) exit qc_loop
+      if (new_qc_index(i) /= 0) cycle qc_loop
+      call set_qc(obs, new_qc_data(j:j), i)
+      j = j + 1
+   enddo qc_loop
+endif
+
+end subroutine set_new_data
+
 !---------------------------------------------------------------------
 subroutine select_gps_by_height(min_height, seq, all_gone)
 

Modified: DART/trunk/obs_sequence/obs_sequence_tool.html
===================================================================
--- DART/trunk/obs_sequence/obs_sequence_tool.html	2011-03-23 20:49:38 UTC (rev 4808)
+++ DART/trunk/obs_sequence/obs_sequence_tool.html	2011-03-23 21:00:32 UTC (rev 4809)
@@ -61,12 +61,12 @@
 are controlled by a Fortran namelist, read from a file named
 <em class=file>input.nml</em> in the current directory.  A detailed
 description of each namelist item is described in the
-<a href="#Namelist">namelist section</a> of this document.
-The names used in this discussion refer to these namelist items.
+<a href="#Namelist">namelist section</a> below.
 </P>
 
 <P>
-The following section contains examples of common usages for this tool.
+The <a href="#Examples">examples section</a> of this document below
+has extensive examples of common usages for this tool.
 Below that are more details about DART observation sequence files, the
 structure of individual observations, and general background information.
 </P>
@@ -80,9 +80,6 @@
 <H2>NAMELIST</H2>
 <P>We adhere to the F90 standard of starting a namelist with an ampersand
 '&amp;' and terminating with a slash '/' for all our namelist input.
-Consider yourself forewarned that character strings that contain a '/' must be
-enclosed in quotes to prevent them from prematurely terminating the namelist.
-The namelist declaration (i.e. what follows) has a different syntax, naturally.
 </P>
 <div class=namelist>
 <pre>
@@ -96,8 +93,8 @@
         min_copy, max_copy, copy_metadata, copy_type, 
         edit_copy_metadata, new_copy_metadata,
         edit_qc_metadata, new_qc_metadata,
-        edit_copies, new_copy_index, 
-        edit_qcs, new_qc_index
+        edit_copies, new_copy_index, new_copy_data,
+        edit_qcs, new_qc_index, new_qc_data,
         synonym_copy_list, synonym_qc_list,
         print_only, 
         gregorian_cal,
@@ -283,8 +280,19 @@
 <TR><!--contents--><TD valign=top>new_copy_index</TD>
     <!--  type  --><TD>integer(:)</TD>
     <!--descript--><TD>An array of integers, which control how copies in the input are
-                       moved to the output sequence.
+                       moved to the output sequence.  The values must be between 0 and
+                       the number of copies in the input sequence.  They can be repeated
+                       to replicate an existing copy; they can be specified in any order
+                       to reorder the entries; they can include the value 0 to insert a new
+                       copy. -1 ends the list.  If -1 is specified as the first value, all
+                       copies will be deleted
                        Default: none</TD></TR>
+<TR><!--contents--><TD valign=top>new_copy_data</TD>
+    <!--  type  --><TD>real(:)</TD>
+    <!--descript--><TD>An array of reals. The length should correspond to the number of 0s
+                       in the new_copy_index list, and will be the data value for the new
+                       copies.  This value will be constant for all observations.
+                       Default: none</TD></TR>
 <TR><!--contents--><TD valign=top>edit_qc_metadata</TD>
     <!--  type  --><TD>logical</TD>
     <!--descript--><TD>If true, replace the output file metadata strings with the list
@@ -297,15 +305,26 @@
                        Default: none</TD></TR>
 <TR><!--contents--><TD valign=top>edit_qcs</TD>
     <!--  type  --><TD>logical</TD>
-    <!--descript--><TD>If true, subset or rearrange the actual data qcs in the output.
-                       The new_qc_index list controls the output order of qcs from the
+    <!--descript--><TD>If true, subset or rearrange the actual data QCs in the output.
+                       The new_qc_index list controls the output order of QCs from the
                        input files.
                        Default: .false.</TD></TR>
 <TR><!--contents--><TD valign=top>new_qc_index</TD>
     <!--  type  --><TD>integer(:)</TD>
-    <!--descript--><TD>An array of integers, which control how qcs in the input are
-                       moved to the output sequence.
+    <!--descript--><TD>An array of integers, which control how QCs in the input are
+                       moved to the output sequence.  The values must be between 0 and
+                       the number of QCs in the input sequence.  They can be repeated
+                       to replicate an existing QCs; they can be specified in any order
+                       to reorder the entries; they can include the value 0 to insert a new
+                       qc. -1 ends the list.  If -1 is specified as the first value, all
+                       QCs will be deleted
                        Default: none</TD></TR>
+<TR><!--contents--><TD valign=top>new_qc_data</TD>
+    <!--  type  --><TD>real(:)</TD>
+    <!--descript--><TD>An array of reals. The length should correspond to the number of 0s
+                       in the new_qc_index list, and will be the data value for the new
+                       QCs.  This value will be constant for all observations.
+                       Default: none</TD></TR>
 <TR><!--contents--><TD valign=top>synonym_copy_list</TD>
     <!--  type  --><TD>character(len=*)(:)</TD>
     <!--descript--><TD>An array of strings which are to be considered synonyms in the copy
@@ -512,8 +531,7 @@
 being moved to another architecture.  At this point in time, there are
 only 2 remaining incompatible platforms:  IBM systems based on PowerPC
 chips, and everything else (which is Intel or AMD).
-<br>
-<br>
+</P><P>
 Any number of input files and selection options can be specified, as well,
 but for a simple conversion, leave all other input namelist items unset.
 </P>
@@ -541,12 +559,11 @@
 same with the QC values.  If the output metadata strings are not 
 specified (see below), then the actual metadata strings from the first 
 file which is used will set the output metadata strings.
-<br>
-<br>
+</P><P>
 To rename or override, with care, existing metadata strings in a file,
 set the appropriate edit strings to true, and set the same number
 of copies and/or QC values as will be in the output file.  
-Note that this will simply
+Note that this will 
 replace, without warning, whatever is originally listed as metadata.
 You can really mangle things here, so use this with caution:
 </P>
@@ -564,8 +581,7 @@
 <P>
 The log file will print out what input strings are being replaced;
 check this carefully to be sure you are doing what you expect.
-<br>
-<br>
+</P><P>
 If you use both a synonym list and the edit list, the output file will
 have the specified edit list strings for metadata.
 </P>
@@ -573,9 +589,9 @@
 <A NAME="editdata"></A>
 <h3>Altering the number of Copies or QC values</h3>
 <P>
-To delete some of the copies or qc values in each observation, specify
-the copy numbers which are to be passed through, and list them in the 
-exact order they should appear in the output:
+To delete some of the copies or QC values in each observation, specify
+the copy or QC index numbers which are to be passed through, and list 
+them in the exact order they should appear in the output:
 </P>
 <pre>
    edit_copies = .true.,
@@ -587,25 +603,87 @@
 <P>
 This will create an output sequence file with only 4 copies; the original
 first and second copies, and copies 81 and 82.  The original metadata will
-be retained.  It will have only the second QC value.
-<br>
-<br>
-If you also specify new metadata strings, specify them in the order
-and the number of strings that will appear in the output file, regardless
-of how many copies or qc values there were in the original input files.
-<br>
-<br>
-If necessary, you can simply reorder copies or qc values by
-specifying the same number of index values as currently exists,
-but list them in a different order.  Use caution here; there are
-no checks to be sure values have not been replicated.  I suppose
-there might actually be a use for this at some point, so it isn't
-prohibited.  Note that the only other thing that people might want
-to do at some point is to take the copies from an observation in
-one file and add them to the copies in another file.  This is not
-supported (yet).
+be retained.  It will have only the second QC value from the original file.
+</P><P>
+If you are editing the copies or QCs and also specifying new metadata 
+strings, use the number and order appropriate to the output file
+regardless of how many copies or QC values there were in the original 
+input files.
+</P><P>
+You can use these index lists to reorder copies or QC values by
+specifying the same number of index values as currently exist
+but list them in a different order.  Index values can be repeated
+multiple times in a list.  This will duplicate both the metadata
+string as well as the data values for the copy or QC.
+</P><P>
+To delete all copies or QCs specify -1 as the first (only) entry in 
+the new index list.
 </P>
+<pre>
+   edit_qcs = .true.,
+   new_qc_index = -1, 
+</pre>
+</P><P>
+To add copies or QCs, use 0 as the index value.
+</P>
+<pre>
+   edit_copies = .true.,
+   new_copy_index = 1, 2, 0, 81, 82, 0
+   new_copy_data = 3.0, 8.0,
 
+   edit_qcs = .true.,
+   new_qc_index = 2, 1, 3, 0,
+   new_qc_data = 1.0,
+</pre>
+<P>
+This will insert 2 new copies in each observation and give
+them values of 3.0 and 8.0 in all observations.  There is no 
+way to insert a different value on a per-obs basis.  This example
+will also reorder the 3 existing QC values and then add 1 new 
+QC value of 1 in all observations.  The 'edit_copy_metadata' and
+'edit_qc_metadata' flags with the 'new_copy_metadata' and 
+'new_qc_metadata' lists can be used to set the metadata names 
+of the new copies and QCs.
+</P>
+<pre>
+   edit_copies = .true.,
+   new_copy_index = 1, 0, 2, 0,
+   new_copy_data = 3.0, 8.0,
+   edit_copy_metadata = .true.,
+   new_copy_metadata = 'observation', 'new copy 1',
+                       'truth',       'new copy 2',
+
+   edit_qcs = .true.,
+   new_qc_index = 0, 2,
+   new_qc_data = 0.0,
+   edit_qc_metadata = .true.,
+   new_qc_metadata = 'dummy QC', 'DART QC',
+</pre>
+<P>
+To remove an existing QC value and add a QC value of 0
+for all observations, run with:
+</P>
+<pre>
+   edit_qcs = .true.,
+   new_qc_index = 0,
+   new_qc_data = 0.0,
+   edit_qc_metadata = .true.,
+   new_qc_metadata = 'dummy QC',
+</pre>
+<P>
+to add a constant QC of 0 for all observations,
+with a metadata label of 'dummy QC'.
+</P>
+<P>
+It would be useful to allow copies or QCs from one file to be
+combined, obs by obs, with those from another file.  However,
+it isn't easy to figure out how to ensure the observations in
+multiple files are in exactly the same order so data from
+the same obs are being combined.  Also how to specify what
+should be combined is a bit complicated.  So this functionality
+is NOT available in this tool.
+</P>
+
 <A NAME="print"></A>
 <h3>Printing only</h3>
 <P>
@@ -751,7 +829,7 @@
 <P>
 The tool now also allows the number of copies to be changed, but only
 to select subsets or reorder them.  It is not yet possible to merge copies
-or qcs from observations in different files into a 
+or QCs from observations in different files into a 
 single observation with more copies.
 </P>
 
@@ -882,6 +960,120 @@
     <!-- message --><TD VALIGN=top>num_input_files and filename_seq mismatch</TD>
     <!-- comment --><TD VALIGN=top>The number of filenames does not match
                         the filename count.</TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top>use either lat/lon box or min/max box but not both
+                    </TD>
+    <!-- comment --><TD VALIGN=top>When selecting a region you can specify a box by
+                     latitude/longitude namelist limits, or you can use the 
+                     min/max box namelist lists but not both.
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top> can only use lat/lon box with 2d/3d sphere locations
+                    </TD>
+    <!-- comment --><TD VALIGN=top>
+                     The lat/lon limits work only for the 2D and 3D sphere locations.
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top>min_lat must be less than max_lat 
+                    </TD>
+    <!-- comment --><TD VALIGN=top>adjust region limits so min is less than max
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top>min_lat cannot be less than -90.0 degrees<br>
+                                   max_lat cannot be greater than 90.0 degrees<br>
+                                   min_lon cannot be greater than 360.0 degrees<br>
+                                   max_lon cannot be greater than 360.0 degrees<br>
+                    </TD>
+    <!-- comment --><TD VALIGN=top>fix latitude limits to be within -90 to 90, 
+                     longitude limits to be 0 to 360.  if longitude is negative,
+                     360 will be added so values of -180 to 180 are ok.
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top> min_lon cannot exactly equal max_lon<br>
+                                    min_lat cannot exactly equal max_lat
+                    </TD>
+    <!-- comment --><TD VALIGN=top> the region select box must have a positive volume
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top> must specify the metadata name of a QC field
+                    </TD>
+    <!-- comment --><TD VALIGN=top> if selecting observations by QC value, you must 
+                      specify the metadata string for which QC field to use.
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top> must specify the metadata name of a copy field
+                    </TD>
+    <!-- comment --><TD VALIGN=top> if selecting observations by value, you must
+                      specify the metadata string for which copy field to use.
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top> first time cannot be later than last time
+                    </TD>
+    <!-- comment --><TD VALIGN=top> if selecting a time range, the interval must 
+                      be legal
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top> new_copy_index values must be between 0 and N
+                    </TD>
+    <!-- comment --><TD VALIGN=top> if reordering or selecting only certain copies
+                      the list must only include valid indices from the input sequence 
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top> new_qc_index values must be between 0 and N
+                    </TD>
+    <!-- comment --><TD VALIGN=top> if reordering or selecting only certain QCs
+                      the list must only include valid indices from the input sequence 
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top>All input files are empty or all obs excluded by time/type/location
+                    </TD>
+    <!-- comment --><TD VALIGN=top> The selection criteria has excluded all the 
+                    possible observations, or none of the input observation sequence 
+                    files contain observations.
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top>Internal error trying to process file
+                    </TD>
+    <!-- comment --><TD VALIGN=top> Shouldn't happen.  Contact the DART development
+                     team with details of how this occurred.
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top>observations must be in increasing time order
+                    </TD>
+    <!-- comment --><TD VALIGN=top> one or more of the input observation sequence files
+                     has out-of-time-order observations.  This should not happen if
+                     the input file was created with DART subroutines.
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top>cannot specify both filename_seq and filename_seq_list
+                    </TD>
+    <!-- comment --><TD VALIGN=top> in the input namelist, you can either give a file
+                     or a list of files for the 'filename_seq' item, or you can give
+                     the name of a file that contains the names in 'filename_seq_list',
+                     but you cannot specify both.  set one of these to ''.
+                    </TD>
+
+<TR><!-- routine --><TD VALIGN=top>obs_sequence_tool</TD>
+    <!-- message --><TD VALIGN=top>contains no filenames
+                    </TD>
+    <!-- comment --><TD VALIGN=top> the 'filename_seq_list' file contains no filenames
+                     to be used as input observation sequence files
+                    </TD>
+
 </TR>
 </TABLE>
 </div>
@@ -918,6 +1110,11 @@
     based on a time interval. Now with the <em>schedule</em> type,
     specifying the intervals is easy; need a way to generate the
     output filenames with a pattern.</LI>
+<LI>Eventually move to NetCDF for observation sequence files.  The
+    complication is that it's possible for observations to contain
+    additional information on a per-type basis, which means the
+    arrays of data are no longer the same size.  Perhaps features of
+    NetCDF 4 can be used in this case. </LI>
 </UL>
 

@@ Diff output truncated at 40000 characters. @@


More information about the Dart-dev mailing list