[Dart-dev] [4320] DART/trunk/location: Add error checks to be sure the number of obs passed to get_close_obs()

[nancy at ucar.edu]

Revision: 4320
Author:   nancy
Date:     2010-03-15 15:26:31 -0600 (Mon, 15 Mar 2010)
Log Message:
-----------
Add error checks to be sure the number of obs passed to get_close_obs()
is the same number as was passed into get_close_obs_init().
The rules are they need to be identical lists; we can't cheaply test for
that but at least we can be sure the sizes match.  If they aren't the
same the 3d sphere code isn't going to return the right thing.
For all the other types of locations it would have just iterated
past the end of a list or not done the whole list.  At least this
check completely fixes that latter possibility.

Modified Paths:
--------------
    DART/trunk/location/annulus/location_mod.f90
    DART/trunk/location/column/location_mod.f90
    DART/trunk/location/oned/location_mod.f90
    DART/trunk/location/threed_sphere/location_mod.f90
    DART/trunk/location/twod/location_mod.f90
    DART/trunk/location/twod_sphere/location_mod.f90

-------------- next part --------------
Modified: DART/trunk/location/annulus/location_mod.f90
===================================================================
--- DART/trunk/location/annulus/location_mod.f90	2010-03-15 20:01:43 UTC (rev 4319)
+++ DART/trunk/location/annulus/location_mod.f90	2010-03-15 21:26:31 UTC (rev 4320)
@@ -744,9 +744,17 @@
 integer :: i
 real(r8) :: this_dist
 
+! the list of locations in the obs() argument must be the same
+! as the list of locations passed into get_close_obs_init(), so
+! gc%num and size(obs) better be the same.   if the list changes,
+! you have to destroy the old gc and init a new one.
+if (size(obs) /= gc%num) then
+   write(errstring,*)'obs() array must match one passed to get_close_obs_init()'
+   call error_handler(E_ERR, 'get_close_obs', errstring, source, revision, revdate)
+endif
+
 ! Return list of obs that are within maxdist and their distances
 num_close = 0
-!do i = 1, size(obs)  ! i believe this is right
 do i = 1, gc%num
    this_dist = get_dist(base_obs_loc, obs(i), base_obs_kind, obs_kind(i))
    if(this_dist <= gc%maxdist) then

Modified: DART/trunk/location/column/location_mod.f90
===================================================================
--- DART/trunk/location/column/location_mod.f90	2010-03-15 20:01:43 UTC (rev 4319)
+++ DART/trunk/location/column/location_mod.f90	2010-03-15 21:26:31 UTC (rev 4320)
@@ -601,9 +601,17 @@
 integer :: i
 real(r8) :: this_dist
 
+! the list of locations in the obs() argument must be the same
+! as the list of locations passed into get_close_obs_init(), so
+! gc%num and size(obs) better be the same.   if the list changes,
+! you have to destroy the old gc and init a new one.
+if (size(obs) /= gc%num) then
+   write(errstring,*)'obs() array must match one passed to get_close_obs_init()'
+   call error_handler(E_ERR, 'get_close_obs', errstring, source, revision, revdate)
+endif
+
 ! Return list of obs that are within maxdist and their distances
 num_close = 0
-!do i = 1, size(obs)  ! i believe this is right
 do i = 1, gc%num
    this_dist = get_dist(base_obs_loc, obs(i), base_obs_kind, obs_kind(i))
    if(this_dist <= gc%maxdist) then

Modified: DART/trunk/location/oned/location_mod.f90
===================================================================
--- DART/trunk/location/oned/location_mod.f90	2010-03-15 20:01:43 UTC (rev 4319)
+++ DART/trunk/location/oned/location_mod.f90	2010-03-15 21:26:31 UTC (rev 4320)
@@ -540,9 +540,17 @@
 integer :: i
 real(r8) :: this_dist
 
+! the list of locations in the obs() argument must be the same
+! as the list of locations passed into get_close_obs_init(), so
+! gc%num and size(obs) better be the same.   if the list changes,
+! you have to destroy the old gc and init a new one.
+if (size(obs) /= gc%num) then
+   write(errstring,*)'obs() array must match one passed to get_close_obs_init()'
+   call error_handler(E_ERR, 'get_close_obs', errstring, source, revision, revdate)
+endif
+
 ! Return list of obs that are within maxdist and their distances
 num_close = 0
-!do i = 1, size(obs)  ! i believe this is right
 do i = 1, gc%num
    this_dist = get_dist(base_obs_loc, obs(i), base_obs_kind, obs_kind(i))
    if(this_dist <= gc%maxdist) then

Modified: DART/trunk/location/threed_sphere/location_mod.f90
===================================================================
--- DART/trunk/location/threed_sphere/location_mod.f90	2010-03-15 20:01:43 UTC (rev 4319)
+++ DART/trunk/location/threed_sphere/location_mod.f90	2010-03-15 21:26:31 UTC (rev 4320)
@@ -1125,9 +1125,14 @@
 if(present(dist)) dist = -99.0_r8
 this_dist = 999999.0_r8   ! something big.
 
-! FIXME:
-! shouldn't we check size(obs) as well?  if it is 0, there's also
-! no point in going on.
+! the list of locations in the obs() argument must be the same
+! as the list of locations passed into get_close_obs_init(), so
+! gc%num and size(obs) better be the same.   if the list changes,
+! you have to destroy the old gc and init a new one.
+if (size(obs) /= gc%num) then
+   write(errstring,*)'obs() array must match one passed to get_close_obs_init()'
+   call error_handler(E_ERR, 'get_close_obs', errstring, source, revision, revdate)
+endif
 
 ! If num == 0, no point in going any further. 
 if (gc%num == 0) return
@@ -1138,10 +1143,9 @@
 ! exhaustive search
 if(COMPARE_TO_CORRECT) then
    cnum_close = 0
-   !do i = 1, size(obs)  ! right, i believe
-   do i = 1, gc%num      ! wrong, i believe, but it is the existing code
+   do i = 1, gc%num 
    this_dist = get_dist(base_obs_loc, obs(i), base_obs_kind, obs_kind(i))
-      if(this_dist < gc%maxdist) then
+      if(this_dist <= gc%maxdist) then
          ! Add this obs to correct list
          cnum_close = cnum_close + 1
          cclose_ind(cnum_close) = i
@@ -1195,13 +1199,13 @@
                endif
             else
                ! Dist isn't present; add this ob to list without computing distance
-      num_close = num_close + 1
+               num_close = num_close + 1
                close_ind(num_close) = t_ind
             endif
 
             ! If dist is present and this obs' distance is less than cutoff, add it in list
             if(present(dist) .and. this_dist <= gc%maxdist) then
-      num_close = num_close + 1
+               num_close = num_close + 1
                close_ind(num_close) = t_ind
                dist(num_close) = this_dist
             endif

Modified: DART/trunk/location/twod/location_mod.f90
===================================================================
--- DART/trunk/location/twod/location_mod.f90	2010-03-15 20:01:43 UTC (rev 4319)
+++ DART/trunk/location/twod/location_mod.f90	2010-03-15 21:26:31 UTC (rev 4320)
@@ -588,9 +588,17 @@
 integer :: i
 real(r8) :: this_dist
 
+! the list of locations in the obs() argument must be the same
+! as the list of locations passed into get_close_obs_init(), so
+! gc%num and size(obs) better be the same.   if the list changes,
+! you have to destroy the old gc and init a new one.
+if (size(obs) /= gc%num) then
+   write(errstring,*)'obs() array must match one passed to get_close_obs_init()'
+   call error_handler(E_ERR, 'get_close_obs', errstring, source, revision, revdate)
+endif
+
 ! Return list of obs that are within maxdist and their distances
 num_close = 0
-!do i = 1, size(obs)  ! i believe this is right
 do i = 1, gc%num
    this_dist = get_dist(base_obs_loc, obs(i), base_obs_kind, obs_kind(i))
    if(this_dist <= gc%maxdist) then

Modified: DART/trunk/location/twod_sphere/location_mod.f90
===================================================================
--- DART/trunk/location/twod_sphere/location_mod.f90	2010-03-15 20:01:43 UTC (rev 4319)
+++ DART/trunk/location/twod_sphere/location_mod.f90	2010-03-15 21:26:31 UTC (rev 4320)
@@ -577,9 +577,17 @@
 integer :: i
 real(r8) :: this_dist
 
+! the list of locations in the obs() argument must be the same
+! as the list of locations passed into get_close_obs_init(), so
+! gc%num and size(obs) better be the same.   if the list changes,
+! you have to destroy the old gc and init a new one.
+if (size(obs) /= gc%num) then
+   write(errstring,*)'obs() array must match one passed to get_close_obs_init()'
+   call error_handler(E_ERR, 'get_close_obs', errstring, source, revision, revdate)
+endif
+
 ! Return list of obs that are within maxdist and their distances
 num_close = 0
-!do i = 1, size(obs)  ! i believe this is right
 do i = 1, gc%num
    this_dist = get_dist(base_obs_loc, obs(i), base_obs_kind, obs_kind(i))
    if(this_dist <= gc%maxdist) then