[Dart-dev] DART/branches Revision: 10916

[dart at ucar.edu]

mizzi at ucar.edu
2017-01-18 14:29:03 -0700 (Wed, 18 Jan 2017)
104
Adding source files we may need at some point.
Original, unmodified versions from Arthur.
(this is tim)



Added: DART/branches/mizzi/cov_cutoff/cov_cutoff_mod_APM.f90
===================================================================
--- DART/branches/mizzi/cov_cutoff/cov_cutoff_mod_APM.f90	                        (rev 0)
+++ DART/branches/mizzi/cov_cutoff/cov_cutoff_mod_APM.f90	2017-01-18 21:29:03 UTC (rev 10916)
@@ -0,0 +1,217 @@
+! DART software - Copyright 2004 - 2013 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$
+
+module cov_cutoff_mod
+
+
+use     types_mod, only : r8
+use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
+                          do_output, do_nml_file, do_nml_term, nmlfileunit, &
+                          find_namelist_in_file, check_namelist_read
+use location_mod,  only : location_type
+use obs_kind_mod
+
+implicit none
+private
+
+public :: comp_cov_factor
+
+! 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$"
+
+
+!============================================================================
+
+!---- namelist with default values
+logical :: namelist_initialized = .false.
+
+integer :: select_localization = 1
+! Value 1 selects default Gaspari-Cohn cutoff
+! Value 2 selects boxcar
+! Value 3 selects ramped boxcar
+
+namelist / cov_cutoff_nml / select_localization
+
+!============================================================================
+
+contains
+
+!======================================================================
+
+
+
+function comp_cov_factor(z_in, c, obs_loc, obs_type, target_loc, target_kind, &
+   localization_override)
+!----------------------------------------------------------------------
+! function comp_cov_factor(z_in, c)
+!
+! Computes a covariance cutoff function from Gaspari and Cohn
+! QJRMS, 125, 723-757.  (their eqn. 4.10)
+!
+! z_in is the distance while c is the cutoff distance. 
+! For distances greater than 2c, the cov_factor returned goes to 0.
+
+! Other ramping shapes are also available and can be selected by a namelist
+! parameter. At present, these include a boxcar with the given halfwidth
+! and a ramp in which the weight is set at 1.0 up to the half-width 
+! distance and then decreases linearly to 0 at twice the half-width 
+! distance.
+
+! Additional information is passed in about the location and specific type of the
+! observation and the location and generic kind of the variable being targeted for
+! increments. These can be used for more refined algorithms that want to 
+! make the cutoff a function of these additional arguments. 
+
+use location_mod, only : get_location
+implicit none
+
+real(r8),                      intent(in) :: z_in, c
+type(location_type), optional, intent(in) :: obs_loc, target_loc
+integer,             optional, intent(in) :: obs_type, target_kind
+integer,             optional, intent(in) :: localization_override
+real(r8)                                  :: comp_cov_factor
+
+real(r8) :: z, r
+integer  :: iunit, io
+integer  :: localization_type
+
+real(r8) :: apm_pi, apm_target_loc(3), apm_fac
+
+!--------------------------------------------------------
+! Initialize namelist if not already done
+if(.not. namelist_initialized) then
+
+   call register_module(source, revision, revdate)
+
+   namelist_initialized = .true.
+
+   ! Read the namelist entry
+   call find_namelist_in_file("input.nml", "cov_cutoff_nml", iunit)
+   read(iunit, nml = cov_cutoff_nml, iostat = io)