[Dart-dev] [3792] DART/trunk/location: Added a function 'is_location_in_region()' to each type of
nancy at ucar.edu
nancy at ucar.edu
Wed Mar 18 10:12:42 MDT 2009
An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20090318/efe1c58c/attachment-0001.html
-------------- next part --------------
Modified: DART/trunk/location/annulus/location_mod.f90
===================================================================
--- DART/trunk/location/annulus/location_mod.f90 2009-03-17 20:00:54 UTC (rev 3791)
+++ DART/trunk/location/annulus/location_mod.f90 2009-03-18 16:12:41 UTC (rev 3792)
@@ -21,6 +21,8 @@
! Note: in an effort to maintain consistency with the other
! location_mods, will use lon for azimuthal direction, lat for
! radial direction, and lev for depth.
+! (Note2: not clear this is a good thing - what consistency do we buy?
+! might want to use real names for the values for clarity.)
use types_mod, only : r8, PI, RAD2DEG, DEG2RAD, MISSING_R8, MISSING_I
use utilities_mod, only : register_module, error_handler, E_ERR
@@ -29,10 +31,12 @@
implicit none
private
-public :: location_type, get_dist, get_location, set_location, set_location_missing, &
+public :: location_type, get_dist, get_location, set_location, &
+ set_location2, set_location_missing, is_location_in_region, &
write_location, read_location, interactive_location, &
vert_is_pressure, vert_is_level, vert_is_height, query_location, &
- LocationDims, LocationName, LocationLName, get_close_obs, alloc_get_close_obs, &
+ LocationDims, LocationName, LocationLName, &
+ get_close_obs, alloc_get_close_obs, &
operator(==), operator(/=)
! version controlled file description for error handling, do not edit
@@ -305,7 +309,32 @@
end function set_location
+function set_location2(list)
+!----------------------------------------------------------------------------
+!
+! location semi-independent interface routine
+! given 4 float numbers, call the underlying set_location routine
+implicit none
+
+type (location_type) :: set_location2
+real(r8), intent(in) :: list(:)
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+if (size(list) /= 4) then
+ write(errstring,*)'requires 4 input values'
+ call error_handler(E_ERR, 'set_location2', errstring, source, revision, revdate)
+endif
+
+set_location2 = set_location(list(1), list(2), list(3), nint(list(4)))
+
+end function set_location2
+
+
+
function set_location_missing()
!----------------------------------------------------------------------------
!
@@ -588,8 +617,11 @@
real(r8), intent(in) :: cutoff
integer, intent(out) :: obs_box(num)
-! This does pre-computing for close obs; no function needed in one dimension
+! There might not need to be code here but if the get_close_obs() call
+! gets too slow, precomputing can be done here.
+! set this to satisfy the intent(out) directive.
+obs_box(:) = 0
return
end subroutine alloc_get_close_obs
@@ -599,7 +631,9 @@
subroutine get_close_obs(base_ob, num, obs, cutoff, obs_box, num_close, close_ind, dist)
-! Default version with no smarts; no need to be smart in 1D
+! This is the wrong code for this location module; it seems to be lifted
+! from the 1d case, which is incorrect. It does allow code to be compiled
+! but it will not compute correct values for distance.
implicit none
@@ -629,7 +663,41 @@
+function is_location_in_region(loc, minl, maxl)
!----------------------------------------------------------------------------
+!
+! Returns true if the given location is between the other two.
+
+implicit none
+
+logical :: is_location_in_region
+type(location_type), intent(in) :: loc, minl, maxl
+
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+if ((minl%which_vert /= maxl%which_vert) .or. &
+ (minl%which_vert /= loc%which_vert)) then
+ write(errstring,*)'which_vert (',loc%which_vert,') must be same in all args'
+ call error_handler(E_ERR, 'is_location_in_region', errstring, source, revision, revdate)
+endif
+
+! assume failure and return as soon as we are confirmed right.
+! set to success only at the bottom after all tests have passed.
+is_location_in_region = .false.
+
+if ((loc%lon < minl%lon) .or. (loc%lon > maxl%lon)) return
+if ((loc%lat < minl%lat) .or. (loc%lat > maxl%lat)) return
+if ((loc%vloc < minl%vloc) .or. (loc%vloc > maxl%vloc)) return
+
+is_location_in_region = .true.
+
+end function is_location_in_region
+
+
+!----------------------------------------------------------------------------
! end of location/annulus/location_mod.f90
!----------------------------------------------------------------------------
Modified: DART/trunk/location/column/location_mod.f90
===================================================================
--- DART/trunk/location/column/location_mod.f90 2009-03-17 20:00:54 UTC (rev 3791)
+++ DART/trunk/location/column/location_mod.f90 2009-03-18 16:12:41 UTC (rev 3792)
@@ -19,7 +19,8 @@
implicit none
private
-public :: location_type, get_dist, get_location, set_location, set_location_missing, &
+public :: location_type, get_dist, get_location, set_location, &
+ set_location2, set_location_missing, is_location_in_region, &
write_location, read_location, interactive_location, vert_is_undef, &
vert_is_surface, vert_is_pressure, vert_is_level, vert_is_height, &
query_location, LocationDims, LocationName, LocationLName, &
@@ -126,6 +127,32 @@
end function set_location
+function set_location2(list)
+!----------------------------------------------------------------------------
+!
+! location semi-independent interface routine
+! given 2 float numbers, call the underlying set_location routine
+
+implicit none
+
+type (location_type) :: set_location2
+real(r8), intent(in) :: list(:)
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+if (size(list) /= 2) then
+ write(errstring,*)'requires 2 input values'
+ call error_handler(E_ERR, 'set_location2', errstring, source, revision, revdate)
+endif
+
+set_location2 = set_location(list(1), nint(list(2)))
+
+end function set_location2
+
+
+
function vert_is_undef(loc)
!---------------------------------------------------------------------------
!
@@ -500,8 +527,39 @@
end subroutine get_close_obs
+function is_location_in_region(loc, minl, maxl)
!----------------------------------------------------------------------------
-! end of location/oned/location_mod.f90
+!
+! Returns true if the first arg is between the other two.
+
+implicit none
+
+logical :: is_location_in_region
+type(location_type), intent(in) :: loc, minl, maxl
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+if ((minl%which_vert /= maxl%which_vert) .or. &
+ (minl%which_vert /= loc%which_vert)) then
+ write(errstring,*)'which_vert (',loc%which_vert,') must be same in all args'
+ call error_handler(E_ERR, 'is_location_in_region', errstring, source, revision, revdate)
+endif
+
+! assume failure and return as soon as we are confirmed right.
+! set to success only at the bottom after all tests have passed.
+is_location_in_region = .false.
+
+if ((loc%vloc < minl%vloc) .or. (loc%vloc > maxl%vloc)) return
+
+is_location_in_region = .true.
+
+end function is_location_in_region
+
+
!----------------------------------------------------------------------------
+! end of location/column/location_mod.f90
+!----------------------------------------------------------------------------
end module location_mod
Modified: DART/trunk/location/oned/location_mod.f90
===================================================================
--- DART/trunk/location/oned/location_mod.f90 2009-03-17 20:00:54 UTC (rev 3791)
+++ DART/trunk/location/oned/location_mod.f90 2009-03-18 16:12:41 UTC (rev 3792)
@@ -22,7 +22,8 @@
implicit none
private
-public :: location_type, get_location, set_location, set_location_missing, &
+public :: location_type, get_location, set_location, &
+ set_location2, set_location_missing, is_location_in_region, &
write_location, read_location, interactive_location, query_location, &
LocationDims, LocationName, LocationLName, get_close_obs, &
get_close_maxdist_init, get_close_obs_init, get_close_type, &
@@ -172,7 +173,32 @@
end function set_location
+function set_location2(list)
+!----------------------------------------------------------------------------
+!
+! location semi-independent interface routine
+! given 1 float number, call the underlying set_location routine
+implicit none
+
+type (location_type) :: set_location2
+real(r8), intent(in) :: list(:)
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+if (size(list) /= 1) then
+ write(errstring,*)'requires 1 input value'
+ call error_handler(E_ERR, 'set_location2', errstring, source, revision, revdate)
+endif
+
+set_location2 = set_location(list(1))
+
+end function set_location2
+
+
+
function set_location_missing()
!----------------------------------------------------------------------------
!
@@ -415,7 +441,32 @@
end subroutine get_close_obs
+function is_location_in_region(loc, minl, maxl)
!----------------------------------------------------------------------------
+!
+! Returns true if the given location is between the other two.
+
+implicit none
+
+logical :: is_location_in_region
+type(location_type), intent(in) :: loc, minl, maxl
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+! assume failure and return as soon as we are confirmed right.
+! set to success only at the bottom after all tests have passed.
+is_location_in_region = .false.
+
+if ((loc%x < minl%x) .or. (loc%x > maxl%x)) return
+
+is_location_in_region = .true.
+
+end function is_location_in_region
+
+
+!----------------------------------------------------------------------------
! end of location/oned/location_mod.f90
!----------------------------------------------------------------------------
Modified: DART/trunk/location/simple_threed_sphere/location_mod.f90
===================================================================
--- DART/trunk/location/simple_threed_sphere/location_mod.f90 2009-03-17 20:00:54 UTC (rev 3791)
+++ DART/trunk/location/simple_threed_sphere/location_mod.f90 2009-03-18 16:12:41 UTC (rev 3792)
@@ -30,9 +30,11 @@
implicit none
private
-public :: location_type, get_dist, get_location, set_location, set_location_missing, &
+public :: location_type, get_dist, get_location, set_location, &
+ set_location2, set_location_missing, is_location_in_region, &
write_location, read_location, interactive_location, vert_is_level, &
- LocationDims, LocationName, LocationLName, alloc_get_close_obs, get_close_obs, &
+ LocationDims, LocationName, LocationLName, alloc_get_close_obs, &
+ get_close_obs, &
operator(==), operator(/=)
! version controlled file description for error handling, do not edit
@@ -275,7 +277,32 @@
end function set_location
+function set_location2(list)
+!----------------------------------------------------------------------------
+!
+! location semi-independent interface routine
+! given 3 float numbers, call the underlying set_location routine
+implicit none
+
+type (location_type) :: set_location2
+real(r8), intent(in) :: list(:)
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+if (size(list) /= 3) then
+ write(errstring,*)'requires 3 input values'
+ call error_handler(E_ERR, 'set_location2', errstring, source, revision, revdate)
+endif
+
+set_location2 = set_location(list(1), list(2), list(3))
+
+end function set_location2
+
+
+
function set_location_missing()
!----------------------------------------------------------------------------
!
@@ -532,7 +559,41 @@
+function is_location_in_region(loc, minl, maxl)
!----------------------------------------------------------------------------
+!
+! Returns true if the given location is between the other two.
+
+implicit none
+
+logical :: is_location_in_region
+type(location_type), intent(in) :: loc, minl, maxl
+
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+if ((minl%which_vert /= maxl%which_vert) .or. &
+ (minl%which_vert /= loc%which_vert)) then
+ write(errstring,*)'which_vert (',loc%which_vert,') must be same in all args'
+ call error_handler(E_ERR, 'is_location_in_region', errstring, source, revision, revdate)
+endif
+
+! assume failure and return as soon as we are confirmed right.
+! set to success only at the bottom after all tests have passed.
+is_location_in_region = .false.
+
+if ((loc%lon < minl%lon) .or. (loc%lon > maxl%lon)) return
+if ((loc%lat < minl%lat) .or. (loc%lat > maxl%lat)) return
+if ((loc%vloc < minl%vloc) .or. (loc%vloc > maxl%vloc)) return
+
+is_location_in_region = .true.
+
+end function is_location_in_region
+
+
+!----------------------------------------------------------------------------
! end of location/simple_threed_sphere/location_mod.f90
!----------------------------------------------------------------------------
Modified: DART/trunk/location/threed_sphere/location_mod.f90
===================================================================
--- DART/trunk/location/threed_sphere/location_mod.f90 2009-03-17 20:00:54 UTC (rev 3791)
+++ DART/trunk/location/threed_sphere/location_mod.f90 2009-03-18 16:12:41 UTC (rev 3792)
@@ -33,7 +33,8 @@
implicit none
private
-public :: location_type, get_location, set_location, set_location_missing, &
+public :: location_type, get_location, set_location, &
+ set_location2, set_location_missing, is_location_in_region, &
write_location, read_location, interactive_location, vert_is_undef, &
vert_is_surface, vert_is_pressure, vert_is_level, vert_is_height, &
query_location, LocationDims, LocationName, LocationLName, &
@@ -60,7 +61,7 @@
type location_type
private
- real(r8) :: lon, lat, vloc
+ real(r8) :: lon, lat, vloc ! lon, lat stored in radians
integer :: which_vert ! determines if by level, height, pressure, ...
end type location_type
@@ -465,7 +466,8 @@
function get_location_lon(loc)
!---------------------------------------------------------------------------
!
-! Given a location type, return the longitude
+! Given a location type, return the longitude. Values stored in radians but
+! returned in degrees.
implicit none
@@ -481,7 +483,8 @@
function get_location_lat(loc)
!---------------------------------------------------------------------------
!
-! Given a location type, return the latitude
+! Given a location type, return the latitude. Values stored in radians but
+! returned in degrees.
implicit none
@@ -500,7 +503,8 @@
!----------------------------------------------------------------------------
!
! Puts the given longitude, latitude, and vertical location
-! into a location datatype.
+! into a location datatype. Arguments to this function are in degrees,
+! but the values are stored as radians.
!
implicit none
@@ -536,7 +540,32 @@
end function set_location
+function set_location2(list)
+!----------------------------------------------------------------------------
+!
+! location semi-independent interface routine
+! given 4 float numbers, call the underlying set_location routine
+implicit none
+
+type (location_type) :: set_location2
+real(r8), intent(in) :: list(:)
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+if (size(list) /= 4) then
+ write(errstring,*)'requires 4 input values'
+ call error_handler(E_ERR, 'set_location2', errstring, source, revision, revdate)
+endif
+
+set_location2 = set_location(list(1), list(2), list(3), nint(list(4)))
+
+end function set_location2
+
+
+
function set_location_missing()
!----------------------------------------------------------------------------
!
@@ -1646,7 +1675,41 @@
end subroutine print_get_close_type
+function is_location_in_region(loc, minl, maxl)
!----------------------------------------------------------------------------
+!
+! Returns true if the given location is between the other two.
+
+implicit none
+
+logical :: is_location_in_region
+type(location_type), intent(in) :: loc, minl, maxl
+
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+!if ((minl%which_vert /= maxl%which_vert) .or. &
+! (minl%which_vert /= loc%which_vert)) then
+! write(errstring,*)'which_vert (',loc%which_vert,') must be same in all args'
+! call error_handler(E_ERR, 'is_location_in_region', errstring, source, revision, revdate)
+!endif
+
+! assume failure and return as soon as we are confirmed right.
+! set to success only at the bottom after all tests have passed.
+is_location_in_region = .false.
+
+if ((loc%lon < minl%lon) .or. (loc%lon > maxl%lon)) return
+if ((loc%lat < minl%lat) .or. (loc%lat > maxl%lat)) return
+!if ((loc%vloc < minl%vloc) .or. (loc%vloc > maxl%vloc)) return
+
+is_location_in_region = .true.
+
+end function is_location_in_region
+
+
+!----------------------------------------------------------------------------
! end of location/threed_sphere/location_mod.f90
!----------------------------------------------------------------------------
Modified: DART/trunk/location/twod_sphere/location_mod.f90
===================================================================
--- DART/trunk/location/twod_sphere/location_mod.f90 2009-03-17 20:00:54 UTC (rev 3791)
+++ DART/trunk/location/twod_sphere/location_mod.f90 2009-03-18 16:12:41 UTC (rev 3792)
@@ -25,7 +25,8 @@
implicit none
private
-public :: location_type, get_dist, get_location, set_location, set_location_missing, &
+public :: location_type, get_dist, get_location, set_location, &
+ set_location2, set_location_missing, is_location_in_region, &
write_location, read_location, interactive_location, &
get_close_obs, alloc_get_close_obs, &
operator(==), operator(/=)
@@ -219,7 +220,33 @@
end function set_location
+function set_location2(list)
+!----------------------------------------------------------------------------
+!
+! location semi-independent interface routine
+! given 2 float numbers, call the underlying set_location routine
+implicit none
+
+type (location_type) :: set_location2
+real(r8), intent(in) :: list(:)
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+if (size(list) /= 2) then
+ write(errstring,*)'requires 2 input values'
+ call error_handler(E_ERR, 'set_location2', errstring, source, revision, revdate)
+endif
+
+set_location2 = set_location(list(1), list(2))
+
+end function set_location2
+
+
+
+
function set_location_missing()
!----------------------------------------------------------------------------
!
@@ -431,7 +458,35 @@
+function is_location_in_region(loc, minl, maxl)
!----------------------------------------------------------------------------
+!
+! Returns true if the given location is between the other two.
+
+implicit none
+
+logical :: is_location_in_region
+type(location_type), intent(in) :: loc, minl, maxl
+
+
+character(len=129) :: errstring
+
+if ( .not. module_initialized ) call initialize_module
+
+
+! assume failure and return as soon as we are confirmed right.
+! set to success only at the bottom after all tests have passed.
+is_location_in_region = .false.
+
+if ((loc%lon < minl%lon) .or. (loc%lon > maxl%lon)) return
+if ((loc%lat < minl%lat) .or. (loc%lat > maxl%lat)) return
+
+is_location_in_region = .true.
+
+end function is_location_in_region
+
+
+!----------------------------------------------------------------------------
! end of location/twod_sphere/location_mod.f90
!----------------------------------------------------------------------------
More information about the Dart-dev
mailing list