diff --git a/CHANGELOG b/CHANGELOG
index c1d8b03a80..09dbda9e67 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -785,6 +785,88 @@ When using a distributed mean "convert_all_obs_verticals_first = .true." should
be set. If your observations will impact most of the model state, then
"convert_all_state_verticals_first = .true.' can also be set.
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++ Apr 30 2019 :: cam-fv refactor, posteriors optional, QC 8 $Revision$
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+- The CAM Finite Volume (cam-fv) model_mod.f90 has undergone substantial
+ refactoring to improve simplicity and remove code for unsupported CAM variants
+ while also supporting WACCM and WACCM-X. Namelist changes will be required.
+
+- CAM-FV setup and scripting support added for CESM 2.1, including advanced
+ archiving and compression
+
+- fix for WRF's wind direction vectors when using the Polar Stereographic
+ map projection. Thanks to Kevin Manning for the fix.
+
+- Add filter namelist option to avoid calling the posterior forward operators
+ and to not create those copies in the obs_seq.final file.
+
+- Use less memory if writing ensemble member values into the obs_seq.final file.
+
+- added a DART QC of 8 for failed vertical conversions
+
+- updated Matlab scripts support QC=8 and no posterior in obs sequence files.
+
+- sampling error correction table now has all ensemble sizes between 3 and 200
+
+- closest_member_tool can be compiled with other MPI targets
+
+- COSMIC_ELECTRON_DENSITY has been moved from obs_def_gps_mod.f90 to
+ obs_def_upper_atm_mod.f90, which has new quantities for
+ ION_O_MIXING_RATIO and ATOMIC_H_MIXING_RATIO
+
+- obs_converters/gps/convert_cosmic_ionosphere.f90 has a test dataset
+
+- support for NAG compiler
+
+- fixed Intel compiler bug in lorenz_96 comparing long integers to integer loop indices
+
+- get_maxdist() now a required routine all location modules
+
+- Default routines now create a time variable as time(time) to allow multiple
+ files to be concatinated along the unlimited dimension more easily. Also
+ conforms to the netCDF convention for coordinate dimensions.
+
+- obs_impact_tool handles a continuum of values, not just discrete 0 or 1.
+
+- fill_inflation_restart now produces files with names consistent with filter defaults.
+
+- expanded functionality in xyz_location_mod.f90
+
+- Removed 'slow' sorting routines from sort_mod.f90
+
+- replacing some repeated native netCDF library calls with routines from
+ the netcdf_utilities_mod.f90
+
+- Updated dewpoint equation to avoid dividing by zero given a very unlikely
+ scenario (r12832)
+
+- More efficient implementation of adaptive inflation
+
+- Yongfei Zhang and Cecilia Bitz added improvements to the CICE model and
+ observation converters and forward operators. These changes also use the
+ locations of the 'new' glade filesystem. They used CESM tag: cesm2_0_alpha06n
+
+- Worked with Yongfei Zhang to remove prototype codes and more completely
+ document observation converters and data sources for cice assimilation.
+
+- removed 'allow_missing_in_clm' flag from the &assim_tools_nml namelist in
+ the CICE work directory. The flag moved to a different namelist and the
+ CICE model doesn't care about it.
+
+- increased the maximum number of input files to obs_diag from 100 to 10000.
+
+- Updated the developer_tests to include more cases.
+
+- Updated oned/obs_diag.f90 to support 'obs_seq.out' files.
+
+- Better error and informational messages in various routines.
+
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++ MMM DD YYYY :: summary of changes in Manhattan update $Revision$
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
#
# $URL$
diff --git a/assimilation_code/location/annulus/location_mod.f90 b/assimilation_code/location/annulus/location_mod.f90
index cb53bab03e..18f019e85e 100644
--- a/assimilation_code/location/annulus/location_mod.f90
+++ b/assimilation_code/location/annulus/location_mod.f90
@@ -26,7 +26,7 @@ module location_mod
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
write_location, read_location, interactive_location, query_location, &
LocationDims, LocationName, LocationLName, LocationStorageOrder, LocationUnits, &
get_close_type, get_close_init, get_close, get_close_destroy, &
@@ -633,6 +633,17 @@ subroutine get_close(gc, base_loc, base_type, locs, loc_quantities, &
end subroutine get_close
+!---------------------------------------------------------------------------
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+get_maxdist = gc%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
!> Returns true if the given location is between the other two.
@@ -749,6 +760,7 @@ function get_vertical_localization_coordinate()
end function get_vertical_localization_coordinate
+
!----------------------------------------------------------------------------
! end of location/annulus/location_mod.f90
!----------------------------------------------------------------------------
diff --git a/assimilation_code/location/channel/location_mod.f90 b/assimilation_code/location/channel/location_mod.f90
index ee1ed51eb1..c8ec91c305 100644
--- a/assimilation_code/location/channel/location_mod.f90
+++ b/assimilation_code/location/channel/location_mod.f90
@@ -13,7 +13,7 @@ module location_mod
use types_mod, only : r8, i8, MISSING_R8, MISSING_I, PI, RAD2DEG, DEG2RAD
use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format, &
- nc_check, E_MSG, open_file, close_file, set_output, &
+ E_MSG, open_file, close_file, set_output, &
logfileunit, nmlfileunit, find_namelist_in_file, &
check_namelist_read, do_output, do_nml_file, &
do_nml_term, is_longitude_between
@@ -30,7 +30,7 @@ module location_mod
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
write_location, read_location, interactive_location, query_location, &
LocationDims, LocationName, LocationLName, LocationStorageOrder, LocationUnits, &
get_close_type, get_close_init, get_close_obs, get_close_state, get_close_destroy, &
@@ -77,11 +77,6 @@ module location_mod
character(len = 512) :: errstring
-real(r8) :: radius ! used only for converting points on a sphere into x,y,z and back
-
-! If maxdist stays the same, don't need to do box distance calculations
-integer :: last_maxdist = -1.0
-
integer :: nx = 10
integer :: ny = 10
integer :: nz = 10
@@ -119,7 +114,7 @@ subroutine initialize_module
! things which need doing exactly once.
-integer :: iunit, io, i
+integer :: iunit, io
if (module_initialized) return
@@ -331,7 +326,6 @@ subroutine write_location(locfile, loc, fform, charstring)
integer :: charlength
logical :: writebuf
-character(len=129) :: string1
10 format(1X,3(G25.16,1X))
@@ -484,108 +478,6 @@ end subroutine interactive_location
!----------------------------------------------------------------------------
-function nc_write_location_atts( ncFileID, fname, ObsNumDimID ) result (ierr)
-
-! Writes the "location module" -specific attributes to a netCDF file.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(in) :: ObsNumDimID ! handle to the dimension that grows
-integer :: ierr
-
-integer :: LocDimID
-integer :: VarID
-
-if ( .not. module_initialized ) call initialize_module
-
-ierr = -1 ! assume things will fail ...
-
-! define the rank/dimension of the location information
-call nc_check(nf90_def_dim(ncid=ncFileID, name='location', len=LocationDims, &
- dimid = LocDimID), 'nc_write_location_atts', 'def_dim:location '//trim(fname))
-
-! Define the location variable and attributes
-
-call nc_check(nf90_def_var(ncid=ncFileID, name='location', xtype=nf90_double, &
- dimids=(/ LocDimID, ObsNumDimID /), varid=VarID), &
- 'nc_write_location_atts', 'location:def_var')
-
-call nc_check(nf90_put_att(ncFileID, VarID, 'description', &
- 'location coordinates'), 'nc_write_location_atts', 'location:description')
-call nc_check(nf90_put_att(ncFileID, VarID, 'location_type', &
- trim(LocationName)), 'nc_write_location_atts', 'location:location_type')
-call nc_check(nf90_put_att(ncFileID, VarID, 'long_name', &
- trim(LocationLName)), 'nc_write_location_atts', 'location:long_name')
-call nc_check(nf90_put_att(ncFileID, VarID, 'storage_order', &
- 'X Y Z'), 'nc_write_location_atts', 'location:storage_order')
-call nc_check(nf90_put_att(ncFileID, VarID, 'units', &
- 'X Y Z'), 'nc_write_location_atts', 'location:units')
-
-ierr = 0
-
-end function nc_write_location_atts
-
-!----------------------------------------------------------------------------
-
-subroutine nc_get_location_varids( ncFileID, fname, LocationVarID, WhichVertVarID )
-
-! Return the LocationVarID and WhichVertVarID variables from a given netCDF file.
-!
-! ncFileId the netcdf file descriptor
-! fname the name of the netcdf file (for error messages only)
-! LocationVarID the integer ID of the 'location' variable in the netCDF file
-! WhichVertVarID the integer ID of the 'which_vert' variable in the netCDF file
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(out) :: LocationVarID, WhichVertVarID
-
-if ( .not. module_initialized ) call initialize_module
-
-call nc_check(nf90_inq_varid(ncFileID, 'location', varid=LocationVarID), &
- 'nc_get_location_varids', 'inq_varid:location '//trim(fname))
-
-WhichVertVarID = -1
-
-end subroutine nc_get_location_varids
-
-!----------------------------------------------------------------------------
-
-subroutine nc_write_location(ncFileID, LocationVarID, loc, obsindex, WhichVertVarID)
-
-! Writes a SINGLE location to the specified netCDF variable and file.
-! The LocationVarID and WhichVertVarID must be the values returned from
-! the nc_get_location_varids call.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID, LocationVarID
-type(location_type), intent(in) :: loc
-integer, intent(in) :: obsindex
-integer, intent(in) :: WhichVertVarID
-
-real(r8), dimension(LocationDims) :: locations
-integer, dimension(1) :: intval
-
-if ( .not. module_initialized ) call initialize_module
-
-locations = get_location( loc )
-
-call nc_check(nf90_put_var(ncFileID, LocationVarId, locations, &
- start=(/ 1, obsindex /), count=(/ LocationDims, 1 /) ), &
- 'nc_write_location', 'put_var:location')
-
-end subroutine nc_write_location
-
-!----------------------------------------------------------------------------
-
subroutine get_close_init(gc, num, maxdist, locs, maxdist_list)
! Initializes part of get_close accelerator that depends on the particular obs
@@ -912,8 +804,6 @@ subroutine find_box_ranges(gc, locs, num)
integer, intent(in) :: num
type(location_type), intent(in) :: locs(num)
-logical :: old_out
-
! FIXME: this space could be very sparse
@@ -935,19 +825,6 @@ subroutine find_box_ranges(gc, locs, num)
gc%nboxes_y = aint((gc%maxdist + (gc%y_width-1)) / gc%y_width)
gc%nboxes_z = aint((gc%maxdist + (gc%z_width-1)) / gc%z_width)
-
-!if(compare_to_correct) then
-! old_out = do_output()
-! call set_output(.true.)
-! write(errstring, *) 'x bot, top, width, nboxes ', gc%bot_x, gc%top_x, gc%x_width, gc%nboxes_x
-! call error_handler(E_MSG, 'find_box_ranges', errstring)
-! write(errstring, *) 'y bot, top, width, nboxes ', gc%bot_y, gc%top_y, gc%y_width, gc%nboxes_y
-! call error_handler(E_MSG, 'find_box_ranges', errstring)
-! write(errstring, *) 'z bot, top, width, nboxes ', gc%bot_z, gc%top_z, gc%z_width, gc%nboxes_z
-! call error_handler(E_MSG, 'find_box_ranges', errstring)
-! call set_output(old_out)
-!endif
-
end subroutine find_box_ranges
!----------------------------------------------------------------------------
@@ -1052,6 +929,17 @@ subroutine find_nearest(gc, base_loc, loc_list, nearest, rc)
end subroutine find_nearest
+!---------------------------------------------------------------------------
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+get_maxdist = gc%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
subroutine print_get_close_type(gc, amount)
diff --git a/assimilation_code/location/column/location_mod.f90 b/assimilation_code/location/column/location_mod.f90
index 11a276ffdc..33ab5d25c9 100644
--- a/assimilation_code/location/column/location_mod.f90
+++ b/assimilation_code/location/column/location_mod.f90
@@ -10,14 +10,13 @@ module location_mod
use types_mod, only : i8, r8, MISSING_R8, MISSING_I
use ensemble_manager_mod, only : ensemble_type
-use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format, &
- nc_check
+use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format
implicit none
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
write_location, read_location, interactive_location, query_location, &
LocationDims, LocationName, LocationLName, LocationStorageOrder, LocationUnits, &
get_close_type, get_close_init, get_close_obs, get_close_state, get_close_destroy, &
@@ -379,8 +378,6 @@ subroutine interactive_location(location, set_to_default)
type(location_type), intent(out) :: location
logical, intent(in), optional :: set_to_default
-real(r8) :: x
-
if ( .not. module_initialized ) call initialize_module
! If set_to_default is true, then just zero out and return
@@ -532,6 +529,17 @@ subroutine get_close(gc, base_loc, base_type, locs, loc_qtys, &
end subroutine get_close
+!---------------------------------------------------------------------------
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+get_maxdist = gc%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
function is_location_in_region(loc, minl, maxl)
@@ -686,6 +694,7 @@ subroutine convert_vertical_state(ens_handle, num, locs, loc_qtys, loc_indx, &
end subroutine convert_vertical_state
+
!----------------------------------------------------------------------------
! end of location/column/location_mod.f90
!----------------------------------------------------------------------------
diff --git a/assimilation_code/location/oned/location_mod.f90 b/assimilation_code/location/oned/location_mod.f90
index e564b454e4..e8d69da4f4 100644
--- a/assimilation_code/location/oned/location_mod.f90
+++ b/assimilation_code/location/oned/location_mod.f90
@@ -22,7 +22,7 @@ module location_mod
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
write_location, read_location, interactive_location, query_location, &
LocationDims, LocationName, LocationLName, LocationStorageOrder, LocationUnits, &
get_close_type, get_close_init, get_close_obs, get_close_state, get_close_destroy, &
@@ -483,6 +483,17 @@ subroutine get_close(gc, base_loc, base_type, locs, loc_qtys, &
end subroutine get_close
+!---------------------------------------------------------------------------
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+get_maxdist = gc%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
function is_location_in_region(loc, minl, maxl)
diff --git a/assimilation_code/location/threed/location_mod.f90 b/assimilation_code/location/threed/location_mod.f90
index 0a3e7dec14..0f665e4e08 100644
--- a/assimilation_code/location/threed/location_mod.f90
+++ b/assimilation_code/location/threed/location_mod.f90
@@ -25,7 +25,7 @@ module location_mod
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
write_location, read_location, interactive_location, query_location, &
LocationDims, LocationName, LocationLName, LocationStorageOrder, LocationUnits, &
get_close_type, get_close_init, get_close, get_close_destroy, &
@@ -495,6 +495,17 @@ subroutine get_close(gc, base_loc, base_type, locs, loc_qtys, &
end subroutine get_close
+!---------------------------------------------------------------------------
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+get_maxdist = gc%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
function is_location_in_region(loc, minl, maxl)
diff --git a/assimilation_code/location/threed_cartesian/location_mod.f90 b/assimilation_code/location/threed_cartesian/location_mod.f90
index 832cb8db1d..f4d70bcb0a 100644
--- a/assimilation_code/location/threed_cartesian/location_mod.f90
+++ b/assimilation_code/location/threed_cartesian/location_mod.f90
@@ -12,7 +12,7 @@ module location_mod
use types_mod, only : r8, i8, MISSING_R8, MISSING_I, PI, RAD2DEG, DEG2RAD
use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format, &
- nc_check, E_MSG, open_file, close_file, set_output, &
+ E_MSG, open_file, close_file, set_output, &
logfileunit, nmlfileunit, find_namelist_in_file, &
check_namelist_read, do_output, do_nml_file, &
do_nml_term, is_longitude_between
@@ -29,7 +29,7 @@ module location_mod
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
write_location, read_location, interactive_location, query_location, &
LocationDims, LocationName, LocationLName, LocationStorageOrder, LocationUnits, &
get_close_type, get_close_init, get_close_obs, get_close_state, get_close_destroy, &
@@ -100,10 +100,6 @@ module location_mod
character(len = 512) :: errstring
-real(r8) :: radius ! used only for converting points on a sphere into x,y,z and back
-
-! If maxdist stays the same, don't need to do box distance calculations
-integer :: last_maxdist = -1.0
! for sanity when i'm using arrays of length(3):
integer, parameter :: IX = 1
@@ -154,7 +150,7 @@ module location_mod
integer :: debug = 0
! for boxes
-integer :: nboxes = 10000 ! currently unused
+!integer :: nboxes = 10000 ! currently unused
integer :: nx = 10 ! box counts in each dimension
integer :: ny = 10
integer :: nz = 10
@@ -216,8 +212,7 @@ subroutine initialize_module
! things which need doing exactly once.
-integer :: iunit, io, i
-character(len=129) :: str1
+integer :: iunit, io
if (module_initialized) return
@@ -665,7 +660,6 @@ subroutine write_location(locfile, loc, fform, charstring)
integer :: charlength
logical :: writebuf
-character(len=129) :: string1
10 format(1X,3(G25.16,1X))
@@ -1173,7 +1167,7 @@ subroutine find_box_ranges(gc, locs, num)
integer, intent(in) :: num
type(location_type), intent(in) :: locs(num)
-logical :: old_out
+!logical :: old_out
if (x_is_periodic) then
gc%box%bot_x = min_x_for_periodic
@@ -1461,6 +1455,17 @@ subroutine recompute_periodic()
end subroutine recompute_periodic
+!---------------------------------------------------------------------------
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+get_maxdist = gc%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
subroutine print_get_close_type(gc, amount)
diff --git a/assimilation_code/location/threed_cartesian/xyz_location_mod.f90 b/assimilation_code/location/threed_cartesian/xyz_location_mod.f90
index 9040d017a8..f7c45dbb80 100644
--- a/assimilation_code/location/threed_cartesian/xyz_location_mod.f90
+++ b/assimilation_code/location/threed_cartesian/xyz_location_mod.f90
@@ -21,9 +21,18 @@ module xyz_location_mod
implicit none
private
-public :: xyz_location_type, xyz_get_location, xyz_set_location, &
- xyz_get_close_maxdist_init, xyz_get_close_obs_init, xyz_get_close_type, &
- xyz_find_nearest, xyz_get_close_obs_destroy, xyz_get_dist, xyz_get_ll_location
+public :: xyz_location_type, &
+ xyz_get_location, &
+ xyz_set_location, &
+ xyz_get_close_type, &
+ xyz_get_close_init, &
+ xyz_get_close_destroy, &
+ xyz_find_nearest, &
+ xyz_find_nearest_N, &
+ xyz_use_great_circle_dist, &
+ xyz_get_dist, &
+ xyz_get_ll_location, &
+ xyz_write_location
! version controlled file description for error handling, do not edit
character(len=256), parameter :: source = &
@@ -36,10 +45,15 @@ module xyz_location_mod
real(r8) :: x, y, z
end type xyz_location_type
-! This version supports both regularly spaced boxes, and octree division
-! of the space. for octrees, divide each dim in half until N numbers of filled
-! boxes, or octree reaches some depth? give some threshold where you don't
-! divide a box with less than N points in it?
+! This version supports only regularly spaced boxes. it originally had code to
+! use an octree division of the space, but finding nearest boxes on each side
+! (where there might be multiples) was too complex. i still think its a good
+! idea but need a better data structure to capture the relationships of leaving
+! any box via a face and listing all the other boxes that adjoin that face.
+!
+! the basic idea for octrees was to divide each dim in half until N numbers of filled
+! boxes, or octree reaches some max depth. give some threshold where you don't
+! divide a box with less than N points in it.
! contrast with kD-trees (divide along dimensions, not points), and there are
! two types of octrees - PR (point region) where the regions split at an
@@ -53,17 +67,17 @@ module xyz_location_mod
type box_type
private
- integer, pointer :: obs_box(:) ! (nobs); List of obs indices in boxes
- integer, pointer :: count(:, :, :) ! (nx, ny, nz); # of obs in each box
- integer, pointer :: start(:, :, :) ! (nx, ny, nz); Start of list of obs in this box
+ integer, pointer :: loc_box(:) ! (nloc); List of loc indices in boxes
+ integer, pointer :: count(:, :, :) ! (nx, ny, nz); # of loc in each box
+ integer, pointer :: start(:, :, :) ! (nx, ny, nz); Start of list of loc in this box
real(r8) :: bot_x, top_x ! extents in x, y, z
real(r8) :: bot_y, top_y
real(r8) :: bot_z, top_z
real(r8) :: x_width, y_width, z_width ! widths of boxes in x,y,z
- real(r8) :: nboxes_x, nboxes_y, nboxes_z ! based on maxdist how far to search
+ real(r8) :: nboxes_x, nboxes_y, nboxes_z ! based on maxdist how far to search - unused FIXME
end type box_type
-! Type to facilitate efficient computation of observations close to a given location
+! Type to facilitate efficient computation of locations close to a given location
type xyz_get_close_type
private
integer :: num
@@ -73,28 +87,20 @@ module xyz_location_mod
logical, save :: module_initialized = .false.
-character(len = 512) :: errstring
+real(r8) :: sphere_radius = -1.0_r8
+logical :: line_of_sight_distance = .true. ! alternative: great circle
-!real(r8) :: radius ! used only for converting points on a sphere into x,y,z and back
+character(len = 512) :: errstring
!-----------------------------------------------------------------
! Namelist with default values
! count of boxes (for box option) in each dim.
-integer :: nx = 20
-integer :: ny = 20
-integer :: nz = 20
-
-! tuning options
-integer :: filled = 10 ! threshold at which you quit splitting
-logical :: use_octree = .false. ! if false, use regular boxes
-
-! extensible options - these may be useful for tuning the octree
-! integer :: nboxes = 1000 ! suggestion for max number of nodes
-! integer :: maxdepth = 4 ! suggestion for max tree depth
+integer :: nx = 20
+integer :: ny = 20
+integer :: nz = 20
namelist /xyz_location_nml/ &
- filled, use_octree, &
nx, ny, nz
!-----------------------------------------------------------------
@@ -130,15 +136,17 @@ subroutine initialize_module
if(do_nml_file()) write(nmlfileunit, nml=xyz_location_nml)
if(do_nml_term()) write( * , nml=xyz_location_nml)
-if (filled < 1) then
- write(errstring,*)'filled sets limit for number of points per box. must be >= 1'
- call error_handler(E_ERR, 'set_location', errstring, source, revision, revdate)
-endif
+end subroutine initialize_module
+
+!----------------------------------------------------------------------------
-! FIXME:
-use_octree = .false. ! if false, use regular boxes
+subroutine xyz_use_great_circle_dist(radius)
+ real(r8), intent(in) :: radius
-end subroutine initialize_module
+sphere_radius = radius
+line_of_sight_distance = .false.
+
+end subroutine xyz_use_great_circle_dist
!----------------------------------------------------------------------------
@@ -161,15 +169,35 @@ function xyz_get_dist(loc1, loc2, type1, kind2)
real(r8) :: xyz_get_dist
real(r8) :: x_dif, y_dif, z_dif
+real(r8) :: mag1, mag2, norm
if ( .not. module_initialized ) call initialize_module
+if (line_of_sight_distance) then
+
+ ! straight line in 3d space
x_dif = loc1%x - loc2%x
y_dif = loc1%y - loc2%y
z_dif = loc1%z - loc2%z
xyz_get_dist = sqrt(x_dif * x_dif + y_dif * y_dif + z_dif * z_dif)
+ !print *, 'los dist: ', xyz_get_dist
+
+else
+
+ ! great circle distance
+ mag1 = sqrt(loc1%x * loc1%x + loc1%y * loc1%y + loc1%z * loc1%z)
+ mag2 = sqrt(loc2%x * loc2%x + loc2%y * loc2%y + loc2%z * loc2%z)
+ norm = (loc1%x*loc2%x + loc1%y*loc2%y + loc1%z*loc2%z) / (mag1 * mag2)
+
+ xyz_get_dist = sphere_radius * acos(norm)
+
+ !print *, 'mag1, 2, norm, acos, radius: ', mag1, mag2, norm, acos(norm), sphere_radius
+ !print *, ' gc dist: ', xyz_get_dist
+
+endif
+
end function xyz_get_dist
!---------------------------------------------------------------------------
@@ -193,10 +221,9 @@ end function xyz_get_location
subroutine xyz_get_ll_location(loc, radius, lon, lat)
-! Given a cartesian x, y, z coordinate relative to the origin
-! at the center of the earth, using a fixed radius specified
-! by MPAS (in the grid generation step), return the corresponding
-! lon, lat location in degrees.
+! Given a cartesian x, y, z coordinate relative to an origin at
+! the center of the sphere, using a fixed radius specified by the
+! caller, return the corresponding lon, lat location in degrees.
type(xyz_location_type) :: loc
real(r8), intent(in) :: radius
@@ -204,7 +231,7 @@ subroutine xyz_get_ll_location(loc, radius, lon, lat)
real(r8) :: rlat, rlon
-! right now this is only needed for debugging messages.
+! don't call this in performance-critical code.
! the arc versions of routines are expensive.
rlat = PI/2.0_r8 - acos(loc%z/radius)
@@ -258,7 +285,6 @@ end function set_location_array
function set_location_lonlat(lon, lat, height, radius)
-! location semi-independent interface routine
! given a lon, lat, and radius, compute X,Y,Z and set location
real(r8), intent(in) :: lon, lat, height, radius
@@ -285,63 +311,56 @@ function set_location_lonlat(lon, lat, height, radius)
end function set_location_lonlat
-!---------------------------------------------------------------------------
-
-subroutine xyz_get_close_obs_init(gc, num, obs)
-
-! Initializes part of get_close accelerator that depends on the particular obs
-
-type(xyz_get_close_type), intent(inout) :: gc
-integer, intent(in) :: num
-type(xyz_location_type), intent(in) :: obs(num)
-
- call get_close_init_boxes(gc, num, obs)
-
-end subroutine xyz_get_close_obs_init
-
!----------------------------------------------------------------------------
-subroutine get_close_init_boxes(gc, num, obs)
-
-! Initializes part of get_close accelerator that depends on the particular obs
+subroutine xyz_get_close_init(gc, maxdist, num, locs)
type(xyz_get_close_type), intent(inout) :: gc
+real(r8), intent(in) :: maxdist
integer, intent(in) :: num
-type(xyz_location_type), intent(in) :: obs(num)
-
+type(xyz_location_type), intent(in) :: locs(num)
integer :: i, j, k, cum_start, l
integer :: x_box(num), y_box(num), z_box(num)
integer :: tstart(nx, ny, nz)
if ( .not. module_initialized ) call initialize_module
-! Allocate storage for obs number dependent part
-allocate(gc%box%obs_box(num))
-gc%box%obs_box(:) = -1
+! set the default value.
+gc%maxdist = maxdist
+!print *, 'setting maxdist to ', maxdist
+
+! Allocate the storage for the grid dependent boxes
+allocate(gc%box%count(nx,ny,nz), gc%box%start(nx,ny,nz))
+gc%box%count = -1
+gc%box%start = -1
+
+! Allocate storage for loc number dependent part
+allocate(gc%box%loc_box(num))
+gc%box%loc_box(:) = -1
-! Set the value of num_obs in the structure
+! Set the value of num_loc in the structure
gc%num = num
! If num == 0, no point in going any further.
if (num == 0) return
-! Determine where the boxes should be for this set of obs and maxdist
-call find_box_ranges(gc, obs, num)
+! Determine where the boxes should be for this set of loc and maxdist
+call find_box_ranges(gc, locs, num)
-! Begin by computing the number of observations in each box in x,y,z
+! Begin by computing the number of locations in each box in x,y,z
gc%box%count = 0
do i = 1, num
-!print *, i, obs(i)%x, obs(i)%y, obs(i)%z
- x_box(i) = floor((obs(i)%x - gc%box%bot_x) / gc%box%x_width) + 1
+!print *, i, locs(i)%x, locs(i)%y, locs(i)%z
+ x_box(i) = floor((locs(i)%x - gc%box%bot_x) / gc%box%x_width) + 1
if(x_box(i) > nx) x_box(i) = nx
if(x_box(i) < 1) x_box(i) = 1
- y_box(i) = floor((obs(i)%y - gc%box%bot_y) / gc%box%y_width) + 1
+ y_box(i) = floor((locs(i)%y - gc%box%bot_y) / gc%box%y_width) + 1
if(y_box(i) > ny) y_box(i) = ny
if(y_box(i) < 1) y_box(i) = 1
- z_box(i) = floor((obs(i)%z - gc%box%bot_z) / gc%box%z_width) + 1
+ z_box(i) = floor((locs(i)%z - gc%box%bot_z) / gc%box%z_width) + 1
if(z_box(i) > nz) z_box(i) = nz
if(z_box(i) < 1) z_box(i) = 1
@@ -364,7 +383,7 @@ subroutine get_close_init_boxes(gc, num, obs)
! Now we know how many are in each box, get a list of which are in each box
tstart = gc%box%start
do i = 1, num
- gc%box%obs_box(tstart(x_box(i), y_box(i), z_box(i))) = i
+ gc%box%loc_box(tstart(x_box(i), y_box(i), z_box(i))) = i
tstart(x_box(i), y_box(i), z_box(i)) = tstart(x_box(i), y_box(i), z_box(i)) + 1
end do
@@ -373,161 +392,145 @@ subroutine get_close_init_boxes(gc, num, obs)
do k = 1, nz
!if (gc%box%count(i,j,k) > 0) print *, i,j,k, gc%box%count(i,j,k), gc%box%start(i,j,k)
do l=1, gc%box%count(i,j,k)
-!print *, l, gc%box%obs_box(l)
+!print *, l, gc%box%loc_box(l)
enddo
end do
end do
end do
-end subroutine get_close_init_boxes
-
-!----------------------------------------------------------------------------
-
-subroutine xyz_get_close_obs_destroy(gc)
-
-type(xyz_get_close_type), intent(inout) :: gc
-
- call get_close_destroy_boxes(gc)
-
-end subroutine xyz_get_close_obs_destroy
-
-!----------------------------------------------------------------------------
-
-subroutine get_close_destroy_boxes(gc)
-
-type(xyz_get_close_type), intent(inout) :: gc
-
-deallocate(gc%box%obs_box, gc%box%count, gc%box%start)
-
-end subroutine get_close_destroy_boxes
+end subroutine xyz_get_close_init
!----------------------------------------------------------------------------
-subroutine xyz_get_close_maxdist_init(gc, maxdist)
+subroutine xyz_get_close_destroy(gc)
type(xyz_get_close_type), intent(inout) :: gc
-real(r8), intent(in) :: maxdist
-! set the default value.
-gc%maxdist = maxdist
-!print *, 'setting maxdist to ', maxdist
+deallocate(gc%box%loc_box, gc%box%count, gc%box%start)
-if (.not. use_octree) then
- ! Allocate the storage for the grid dependent boxes
- allocate(gc%box%count(nx,ny,nz), gc%box%start(nx,ny,nz))
- gc%box%count = -1
- gc%box%start = -1
-endif
-
-end subroutine xyz_get_close_maxdist_init
+end subroutine xyz_get_close_destroy
!----------------------------------------------------------------------------
+!> Finds boundaries for x,y,z boxes.
subroutine find_box_ranges(gc, locs, num)
-! Finds boundaries for x,y,z boxes.
-! FIXME: ways boxes could be divided:
-! - evenly along each axis
-! - octree-like, divide each axis so roughly half the points are
-! on each side of the dividing plane.
-! - about 100 other schemes
-
type(xyz_get_close_type), intent(inout) :: gc
integer, intent(in) :: num
type(xyz_location_type), intent(in) :: locs(num)
-! integer :: i
+logical :: old_out
+integer :: i
+
! FIXME: this space could be very sparse
-gc%box%bot_x = minval(locs(:)%x)
-gc%box%bot_y = minval(locs(:)%y)
-gc%box%bot_z = minval(locs(:)%z)
+! find the rectangular prism that encloses all the given locations
+! with maxdist boundaries on all sides
+gc%box%bot_x = minval(locs(:)%x) - gc%maxdist
+gc%box%bot_y = minval(locs(:)%y) - gc%maxdist
+gc%box%bot_z = minval(locs(:)%z) - gc%maxdist
-gc%box%top_x = maxval(locs(:)%x)
-gc%box%top_y = maxval(locs(:)%y)
-gc%box%top_z = maxval(locs(:)%z)
-
-!gc%box%bot_x = locs(1)%x
-!gc%box%bot_y = locs(1)%y
-!gc%box%bot_z = locs(1)%z
-!
-!gc%box%top_x = locs(1)%x
-!gc%box%top_y = locs(1)%y
-!gc%box%top_z = locs(1)%z
-!
-!do i=2, num
-! gc%box%bot_x = min(gc%box%bot_x, locs(i)%x)
-! gc%box%bot_y = min(gc%box%bot_y, locs(i)%y)
-! gc%box%bot_z = min(gc%box%bot_z, locs(i)%z)
+gc%box%top_x = maxval(locs(:)%x) + gc%maxdist
+gc%box%top_y = maxval(locs(:)%y) + gc%maxdist
+gc%box%top_z = maxval(locs(:)%z) + gc%maxdist
+
+!! for now, add 1% margin around the space.
+!! should this be a namelist item as a percentage, or an actual distance?
+!gc%box%bot_x = gc%box%bot_x - (0.01_r8 * gc%box%bot_x)
+!gc%box%bot_y = gc%box%bot_y - (0.01_r8 * gc%box%bot_y)
+!gc%box%bot_z = gc%box%bot_z - (0.01_r8 * gc%box%bot_z)
!
-! gc%box%top_x = max(gc%box%top_x, locs(i)%x)
-! gc%box%top_y = max(gc%box%top_y, locs(i)%y)
-! gc%box%top_z = max(gc%box%top_z, locs(i)%z)
-!enddo
+!gc%box%top_x = gc%box%top_x + (0.01_r8 * gc%box%top_x)
+!gc%box%top_y = gc%box%top_y + (0.01_r8 * gc%box%top_y)
+!gc%box%top_z = gc%box%top_z + (0.01_r8 * gc%box%top_z)
+! divide the space into boxes
gc%box%x_width = (gc%box%top_x - gc%box%bot_x) / nx
gc%box%y_width = (gc%box%top_y - gc%box%bot_y) / ny
gc%box%z_width = (gc%box%top_z - gc%box%bot_z) / nz
! FIXME: compute a sphere of radius maxdist and see how
-! many boxes in x, y, z that would include.
-gc%box%nboxes_x = aint((gc%maxdist + (gc%box%x_width-1)) / gc%box%x_width)
-gc%box%nboxes_y = aint((gc%maxdist + (gc%box%y_width-1)) / gc%box%y_width)
-gc%box%nboxes_z = aint((gc%maxdist + (gc%box%z_width-1)) / gc%box%z_width)
+! many boxes in x, y, z that would include. unused at present.
+!gc%box%nboxes_x = aint((gc%maxdist + (gc%box%x_width-1)) / gc%box%x_width)
+!gc%box%nboxes_y = aint((gc%maxdist + (gc%box%y_width-1)) / gc%box%y_width)
+!gc%box%nboxes_z = aint((gc%maxdist + (gc%box%z_width-1)) / gc%box%z_width)
!print *, 'min xyz = ', gc%box%bot_x, gc%box%bot_y, gc%box%bot_z
!print *, 'max xyz = ', gc%box%top_x, gc%box%top_y, gc%box%top_z
!print *, 'wid xyz = ', gc%box%x_width, gc%box%y_width, gc%box%z_width
!print *, 'nbx xyz = ', nx, ny, nz
-!print *, 'nbx xyz = ', gc%box%nboxes_x, gc%box%nboxes_y, gc%box%nboxes_z
+!!print *, 'nbx xyz = ', gc%box%nboxes_x, gc%box%nboxes_y, gc%box%nboxes_z
end subroutine find_box_ranges
!----------------------------------------------------------------------------
+!> find the nearest point in the get close list to the specified point
+!> optionally return the exact distance since we have to compute it anyway
-subroutine xyz_find_nearest(gc, base_loc, loc_list, nearest, rc)
+subroutine xyz_find_nearest(gc, base_loc, loc_list, nearest, rc, dist)
type(xyz_get_close_type), intent(in), target :: gc
type(xyz_location_type), intent(in) :: base_loc
type(xyz_location_type), intent(in) :: loc_list(:)
integer, intent(out) :: nearest
integer, intent(out) :: rc
+ real(r8), optional, intent(out) :: dist
-! find the nearest point in the get close list to the specified point
- call find_nearest_boxes(gc, base_loc, loc_list, nearest, rc)
+call find_nearest_boxes(gc, base_loc, loc_list, nearest, rc, dist)
end subroutine xyz_find_nearest
!----------------------------------------------------------------------------
+!> find the nearest N points in the get close list to the specified location
+
+subroutine xyz_find_nearest_N(gc, base_loc, loc_list, n_wanted, nearest, n_found, rc, dist)
+ type(xyz_get_close_type), intent(in), target :: gc
+ type(xyz_location_type), intent(in) :: base_loc
+ type(xyz_location_type), intent(in) :: loc_list(:)
+ integer, intent(in) :: n_wanted
+ integer, intent(out) :: nearest(:)
+ integer, intent(out) :: n_found
+ integer, intent(out) :: rc
+ real(r8), optional, intent(out) :: dist(:)
+
+call find_nearest_n_boxes(gc, base_loc, loc_list, n_wanted, nearest, n_found, rc, dist)
+
+end subroutine xyz_find_nearest_N
+
+!----------------------------------------------------------------------------
+!> search all boxes which are potentially close enough
-subroutine find_nearest_boxes(gc, base_loc, loc_list, nearest, rc)
+subroutine find_nearest_boxes(gc, base_loc, loc_list, nearest, rc, dist)
type(xyz_get_close_type), intent(in), target :: gc
type(xyz_location_type), intent(in) :: base_loc
type(xyz_location_type), intent(in) :: loc_list(:)
integer, intent(out) :: nearest
integer, intent(out) :: rc
+ real(r8), optional, intent(out) :: dist
-! find the nearest point in the get close list to the specified point
integer :: x_box, y_box, z_box, i, j, k, l
integer :: start_x, end_x, start_y, end_y, start_z, end_z
-integer :: n_in_box, st, t_ind, ghost
-real(r8) :: this_dist, dist
+integer :: n_in_box, st, t_ind(1), ghost, n_found
+real(r8) :: this_dist, mindist(1)
! First, set the intent out arguments to a missing value
nearest = -99
+t_ind = -99
rc = -1
-dist = 1e38_r8 ! something big and positive.
+n_found = 0
+mindist = 1e38_r8 ! something big and positive.
+if (present(dist)) dist = 1e38_r8 ! ditto
-! 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,
+! the list of locations in the loc_list() argument must be the same
+! as the list of locations passed into get_close_init(), so
+! gc%num and size(loc_list) better be the same. if the list changes
! you have to destroy the old gc and init a new one.
if (size(loc_list) /= 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)
+ write(errstring,*)'loc_list() array must match one passed to xyz_get_close_init()'
+ call error_handler(E_ERR, 'find_nearest_boxes', errstring, source, revision, revdate)
endif
! If num == 0, no point in going any further.
@@ -557,33 +560,162 @@ subroutine find_nearest_boxes(gc, base_loc, loc_list, nearest, rc)
!print *, 'good box'
-! First, search all points in this box.
+! First, search all points in the box that contains the base loc
+call do_this_box(gc, x_box, y_box, z_box, base_loc, loc_list, 1, t_ind, mindist, n_found)
-! Box to search is x_box,y_box,z_box
-n_in_box = gc%box%count(x_box,y_box,z_box)
-st = gc%box%start(x_box,y_box,z_box)
+! if box small enough that no points match, expand search.
+! and for now, it is quite possible that points in a neighboring
+! box are closer than all points in the current box. so search
+! the neighbors until we are far enough away that we know we
+! have the nearest ones.
+ghost = 0
-! find the closest one in this box
-do l = 1, n_in_box
+10 continue
+if (ghost == 0 .or. n_found < 1) then
+ ghost = ghost + 1
- t_ind = gc%box%obs_box(st - 1 + l)
-!print *, 'l, t_ind = ', l, t_ind
+ start_x = x_box - ghost
+ if (start_x < 1) start_x = 1
+ end_x = x_box + ghost
+ if (end_x > nx) end_x = nx
- this_dist = xyz_get_dist(base_loc, loc_list(t_ind))
-!print *, 'this_dist = ', this_dist
- ! If this obs' distance is less than current nearest, it's new nearest
- if(this_dist <= dist) then
- nearest = t_ind
- dist = this_dist
- if (rc < 0) rc = 0
- endif
+ start_y = y_box - ghost
+ if (start_y < 1) start_y = 1
+ end_y = y_box + ghost
+ if (end_y > ny) end_y = ny
+
+ start_z = z_box - ghost
+ if (start_z < 1) start_z = 1
+ end_z = z_box + ghost
+ if (end_z > nz) end_z = nz
+
+ !print *, 'looping from '
+ !print *, 'x: ', start_x, end_x
+ !print *, 'y: ', start_y, end_y
+ !print *, 'z: ', start_z, end_z
+
+ ! Next, loop through each box that is close to this box
+ do i = start_x, end_x
+ do j = start_y, end_y
+ do k = start_z, end_z
+
+ call do_this_box(gc, i, j, k, base_loc, loc_list, 1, t_ind, mindist, n_found)
+
+ end do
+ end do
end do
-! if box small enough that no points match, expand search
+ if (n_found < 1) then
+ ! if we have searched the entire space, punt.
+ if (start_x == 1 .and. end_x == nx .and. &
+ start_y == 1 .and. end_y == ny .and. &
+ start_z == 1 .and. end_z == nz) return
+
+ ! repeat search with larger radius of boxes
+ goto 10
+ endif
+endif
+
+nearest = t_ind(1)
+rc = 0
+
+! if the caller asked for the actual distance, return it
+if (present(dist)) dist = mindist(1)
+
+end subroutine find_nearest_boxes
+
+!----------------------------------------------------------------------------
+
+subroutine find_nearest_n_boxes(gc, base_loc, loc_list, n_wanted, nearest, n_found, rc, dist)
+ type(xyz_get_close_type), intent(in), target :: gc
+ type(xyz_location_type), intent(in) :: base_loc
+ type(xyz_location_type), intent(in) :: loc_list(:)
+ integer, intent(in) :: n_wanted
+ integer, intent(out) :: nearest(:)
+ integer, intent(out) :: n_found
+ integer, intent(out) :: rc
+ real(r8), optional, intent(out) :: dist(:)
+
+! find the nearest N points in the get close list to the specified point
+
+integer :: x_box, y_box, z_box, i, j, k, l
+integer :: start_x, end_x, start_y, end_y, start_z, end_z
+integer :: n_in_box, st, t_ind, ghost
+real(r8) :: this_dist, mindist(n_wanted), largest_dist
+logical :: been_searched(nx, ny, nz)
+
+! First, set the intent out arguments to a missing value
+nearest = -99
+n_found = 0
+rc = -1
+mindist = 1e38_r8 ! something big and positive.
+largest_dist = 1e38_r8 ! ditto
+if (present(dist)) dist(:) = 1e38_r8 ! ditto
+
+! make sure they want something - else return or fail?
+if (n_wanted < 1) then
+ write(errstring,*)'n_wanted must be 1 or larger'
+ call error_handler(E_ERR, 'find_nearest_n_boxes', errstring, source, revision, revdate)
+endif
+
+if (present(dist)) then
+ if (size(dist) < n_wanted) then
+ write(errstring,*)'dist(:) array size must be equal to or larger than n_wanted'
+ call error_handler(E_ERR, 'find_nearest_n_boxes', errstring, source, revision, revdate)
+ endif
+endif
+
+! the list of locations in the loc_list argument must be the same
+! as the list of locations passed into get_close_init(), so
+! gc%num and size(loc_list better be the same. if the list changes
+! you have to destroy the old gc and init a new one.
+if (size(loc_list) /= gc%num) then
+ write(errstring,*)'loc_list() array must match one passed to xyz_get_close_init()'
+ call error_handler(E_ERR, 'find_nearest_n_boxes', errstring, source, revision, revdate)
+endif
+
+! If num == 0, no point in going any further.
+if (gc%num == 0) return
+
+!--------------------------------------------------------------
+
+! Begin by figuring out which box the base loc is in
+x_box = floor((base_loc%x - gc%box%bot_x) / gc%box%x_width) + 1
+if(x_box > nx) x_box = nx
+if(x_box < 1) x_box = 1
+y_box = floor((base_loc%y - gc%box%bot_y) / gc%box%y_width) + 1
+if(y_box > ny) y_box = ny
+if(y_box < 1) y_box = 1
+z_box = floor((base_loc%z - gc%box%bot_z) / gc%box%z_width) + 1
+if(z_box > nz) z_box = nz
+if(z_box < 1) z_box = 1
+
+!print *, 'base_loc box ', x_box, y_box, z_box
+!print *, 'nx, ny, nz = ', nx, ny, nz
+
+! If it is not in any box, then is this an error? what do we do about maxdist? FIXME
+if(x_box > nx .or. x_box < 1) return
+if(y_box > ny .or. y_box < 1) return
+if(z_box > nz .or. z_box < 1) return
+
+!print *, 'good box'
+
+been_searched(:,:,:) = .false.
+
+! find the closest N in the box that contains the base loc
+call do_this_box(gc, x_box, y_box, z_box, base_loc, loc_list, n_wanted, nearest, mindist, n_found)
+been_searched(x_box, y_box, z_box) = .true.
+
+! if box small enough that not enough points match, expand search.
+! also, it is quite possible that points in a neighboring
+! box are closer than some points in the current box. so search
+! the neighbors until we are far enough away that we know we
+! have the nearest ones. FIXME: be smarter about this.
+! have it set a flag for boxes it has already checked?
ghost = 0
10 continue
-if (nearest < 0 .or. ghost == 0) then
+if (ghost == 0 .or. n_found < n_wanted) then
ghost = ghost + 1
start_x = x_box - ghost
@@ -611,31 +743,16 @@ subroutine find_nearest_boxes(gc, base_loc, loc_list, nearest, rc)
do j = start_y, end_y
do k = start_z, end_z
- ! Box to search is i,j,k
- n_in_box = gc%box%count(i, j, k)
- st = gc%box%start(i,j,k)
-
-
- ! Loop to check how close all obs in the box are; add those that are close
- do l = 1, n_in_box
+ if (been_searched(i,j,k)) cycle
- t_ind = gc%box%obs_box(st - 1 + l)
- ! print *, 'l, t_ind = ', l, t_ind
+ call do_this_box(gc, i, j, k, base_loc, loc_list, n_wanted, nearest, mindist, n_found)
+ been_searched(i,j,k) = .true.
- this_dist = xyz_get_dist(base_loc, loc_list(t_ind))
- ! print *, 'this_dist = ', this_dist
- ! If this obs' distance is less than current nearest, it's new nearest
- if(this_dist <= dist) then
- nearest = t_ind
- dist = this_dist
- if (rc < 0) rc = 0
- endif
- end do
end do
end do
end do
- if (nearest < 0) then
+ if (n_found < n_wanted) then
! if we have searched the entire space, punt.
if (start_x == 1 .and. end_x == nx .and. &
start_y == 1 .and. end_y == ny .and. &
@@ -646,10 +763,86 @@ subroutine find_nearest_boxes(gc, base_loc, loc_list, nearest, rc)
endif
endif
-end subroutine find_nearest_boxes
+! if they asked for the explicit distances, return them
+if (present(dist)) dist(:) = mindist(:)
+
+end subroutine find_nearest_n_boxes
+
+!----------------------------------------------------------------------------
+
+subroutine do_this_box(gc, i, j, k, base_loc, loc_list, n_wanted, nearest, dist, n_found)
+ type(xyz_get_close_type), intent(in), target :: gc
+ integer, intent(in) :: i, j, k
+ type(xyz_location_type), intent(in) :: base_loc
+ type(xyz_location_type), intent(in) :: loc_list(:)
+ integer, intent(in) :: n_wanted
+ integer, intent(inout) :: nearest(:)
+ real(r8), intent(inout) :: dist(:)
+ integer, intent(inout) :: n_found !< how many we already have
+
+
+integer :: n_in_box, st, l, m, n, t_ind
+real(r8) :: this_dist
+logical :: this_one_is_wanted
+
+! Box to search is i,j,k
+n_in_box = gc%box%count(i, j, k)
+st = gc%box%start(i,j,k)
+
+! Loop to check how close all locs in the box are; add those that are close
+do l = 1, n_in_box
+
+ t_ind = gc%box%loc_box(st - 1 + l)
+ ! print *, 'l, t_ind = ', l, t_ind
+
+ this_dist = xyz_get_dist(base_loc, loc_list(t_ind))
+ ! print *, 'this_dist = ', this_dist
+
+ ! if we haven't filled up the number of wanted near points,
+ ! or this new distance is smaller than the largest one, we are
+ ! going to be adding it. make these separate tests since if
+ ! n_found is 0, you'll get an out-of-bounds on dist(n_found)
+ this_one_is_wanted = .false.
+ if(n_found < n_wanted) then
+ this_one_is_wanted = .true.
+ else if (this_dist < dist(n_found)) then
+ this_one_is_wanted = .true.
+ endif
+
+ if (this_one_is_wanted) then
+ if (n_found < n_wanted) n_found = n_found + 1
+ do m=1, n_wanted ! updated value
+ if (this_dist >= dist(m)) cycle
+ if (m == n_found) then
+ nearest(m) = t_ind
+ dist(m) = this_dist
+ exit
+ else
+ do n=n_found, m+1, -1
+ nearest(n) = nearest(n-1)
+ dist(n) = dist(n-1)
+ enddo
+ nearest(m) = t_ind
+ dist(m) = this_dist
+ exit
+ endif
+ enddo
+ endif
+end do ! n_in_box
+
+end subroutine do_this_box
!----------------------------------------------------------------------------
+subroutine xyz_write_location(loc, buf)
+ type(xyz_location_type), intent(in) :: loc
+ character(len=*), intent(out) :: buf
+
+ if (len(buf) < 18*3) print *, 'buffer too short in xyz_write_location'
+ write(buf, '(3F18.6)') loc%x, loc%y, loc%z
+
+end subroutine
+
!----------------------------------------------------------------------------
! end of location/threed_cartesian/xyz_location_mod.f90
!----------------------------------------------------------------------------
diff --git a/assimilation_code/location/threed_sphere/location_mod.f90 b/assimilation_code/location/threed_sphere/location_mod.f90
index 6e8aec936d..3803957ca6 100644
--- a/assimilation_code/location/threed_sphere/location_mod.f90
+++ b/assimilation_code/location/threed_sphere/location_mod.f90
@@ -37,7 +37,7 @@ module location_mod
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
write_location, read_location, interactive_location, query_location, &
LocationDims, LocationName, LocationLName, LocationStorageOrder, LocationUnits, &
get_close_type, get_close_init, get_close_obs, get_close_state, get_close_destroy, &
@@ -2009,6 +2009,23 @@ function find_del_lon(minlat, maxlat, maxdist)
end function find_del_lon
+!---------------------------------------------------------------------------
+!> returns the maximum distance for the cutoff specified for the
+!> observation type of interest.
+!> May be useful in custom 'get_close' applications.
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+integer :: bt
+
+bt = gc%type_to_cutoff_map(obs_type)
+get_maxdist = gc%gtt(bt)%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
subroutine distinct_values(in_list, count, values, map)
diff --git a/assimilation_code/location/threed_sphere/location_mod.html b/assimilation_code/location/threed_sphere/location_mod.html
index d76f4de773..be92135fb2 100644
--- a/assimilation_code/location/threed_sphere/location_mod.html
+++ b/assimilation_code/location/threed_sphere/location_mod.html
@@ -41,7 +41,7 @@
Overview
The DART framework needs to be able to compute distances
between locations, to pass location information to and from the
-model interface code (model_mod.f90), and to be able to
+model interface code (model_mod.f90), and to be able to
read and write location information to files.
DART isolates all this location information into separate modules
so that the main algorithms can operate with the same code independent
@@ -73,7 +73,7 @@
Usage
The location routines are general purpose code that can be used
for a variety of utilities. The following discussion is specifically
restricted to how the location namelist settings affect the
-execution of the filter assimilation program.
+execution of the filter assimilation program.
@@ -89,7 +89,7 @@
Usage
Issues related to changing the results of an assimilation based on
-code in the model-specific model_mod.f90 module:
+code in the model-specific model_mod.f90 module:
Whether the model-specific code needs to convert vertical coordinates.
Whether the model-specific code alters the distances in some other way.
@@ -143,6 +143,11 @@
Vertical Issues
cutoff and the vertical radius is defined by the normalization factors.
+
+See examples below for specific examples that
+highlight some vertical localization issues.
+
+
Different vertical factors per observation type
Generally a single cutoff value and a single set of normalization
@@ -164,7 +169,7 @@
Model-dependent Vertical Conversion Issues
If the model supports either a different vertical coordinate than
the vertical coordinate of the observations, or if the user wants to
localize in a different vertical coordinate than the observations
-or state vector items, the model-specific model_mod.f90
+or state vector items, the model-specific model_mod.f90
code will have to provide a conversion between different vertical coordinates.
This cannot be done by the location module since most vertical
conversions require additional model-specific information such
@@ -192,7 +197,7 @@
Model-dependent Distance Adjustments
The calls to routines that collect the distances between locations
for the assimilation code pass through
-the model-specific model_mod.f90 code. This allows
+the model-specific model_mod.f90 code. This allows
the code to alter the actual distances to either increase or decrease the
effect of an observation on the state or on other observations.
@@ -236,7 +241,62 @@
Internal bin counts
location search.
-
+
+
Examples and Questions involving vertical issues
+
Example of specifying a cutoff based on a distance in kilometers
+
+The Earth radius is nominally 6,371 Km. If you want the
+maximum horizontal distance that an observation can possibly
+influence something in the model state to be X km, then set
+the cutoff to be (X / 6,371) / 2. Remember the actual impact will
+depend on a combination of this distance and the regression
+coefficient computed from the distribution of forward operator values
+and the ensemble of values in the model state.
+
+
Cutoff and half-widths
+
+Q: Why is the cutoff specified as half the distance to where
+the impact goes to 0, and why is it called 'cutoff'?
+A: Because the original paper by Gaspari & Cohn used that
+definition in this paper which our localization function is
+based on.
+Gaspari, G. and Cohn, S. E. (1999), Construction of correlation
+functions in two and three dimensions. Q.J.R. Meteorol. Soc., 125: 723-757.
+doi:10.1002/qj.49712555417
+
+
Computing vertical normalization values
+
+Because distances are computed in radians, the vertical distances
+have to be translated to radians. To get a maximum vertical separation
+of X meters (if localizing in height), specify the vert_normalization_height
+of X / cutoff. If localizing in pressure, specify vert_normalization_pressure
+as X pascals / cutoff, etc.
+
+
Single vertical coordinate type
+
+Vertical distances can only be computed between two locations that have
+the same vertical type. In practice this means
+if vertical localization is enabled all observations which have a
+vertical location need to be converted to a single vertical coordinate
+type, which matches the desired localization unit. The model state must
+also be able to be converted to the same vertical coordinate type.
+
+
+For example, if some observations come with a vertical coordinate type of
+pressure and some with height, and you want to localize in height, the
+pressure coordinates need to be converted to an equivalant height.
+This usually requires information only available to the model interface
+code in the model_mod.f90 file, so a convert_vertical_obs() routine
+is called to do the conversion.
+
+
+The locations of the model state are returned by the get_state_meta_data()
+routine in the model_mod.f90 file. If the vertical coordinate used in
+the state is not the same as the desired vertical localization type,
+they must also be converted using a convert_vertical_state() routine.
+
+
+
@@ -412,9 +472,7 @@
Namelist
-
-
-
+
@@ -475,25 +533,24 @@
Usage of distance routines
-call get_close_maxdist_init() ! is called before get_close_obs_init()
-call get_close_obs_init()
+call get_close_init()
...
call get_close_obs() ! called many, many times
...
-call get_close_obs_destroy()
+call get_close_destroy()
-In the threed_sphere implementation the
-first routine initializes some data structures, the second one
-bins up the list of locations, and then the third one is called
+get_close_init() initializes the data structures,
+get_close_obs() is called
multiple times to find all locations within a given radius of
some reference location, and to optionally
compute the exact separation distance from the reference location.
-The last routine deallocates the space. See the documentation
+get_close_destroy() deallocates the space.
+See the documentation
below for the specific details for each routine.
-All 4 of these routines must be present in every location module
+All 3 of these routines must be present in every location module
but in most other versions
all but get_close_obs() are stubs.
In this threed_sphere version
@@ -528,9 +585,8 @@
-Sets the threshhold distance. maxdist is in
-units of radians.
+Initializes the get_close accelerator.
+maxdist is in units of radians.
Anything closer than this is deemed to be close.
This routine must be called first, before the other
get_close routines.
It allocates space so it is necessary to call
-get_close_obs_destroy
+get_close_destroy
when completely done with getting distances between locations.
-If the last optional argument is not specified, maxdist
+If the last optional argument is not specified, maxdist
applies to all locations. If the last argument is specified,
it must be a list of exactly the length of the number of
-specific types in the obs_kind_mod.f90 file.
+specific types in the obs_kind_mod.f90 file.
This length can be queried with the
get_num_types_of_obs() function to get count of obs types.
It allows a different maximum distance to be set per base type
-when get_close() is called.
+when get_close() is called.
gc
Data for efficiently finding close locations.
+
+
num
+
The number of locations, i.e. the length of the locs array.
+
maxdist
Anything closer than this number of radians is a close location.
+
+
locs
+
The list of locations in question.
+
maxdist
If specified, must be a list of real values. The length of
the list must be exactly the same length as the number of
@@ -1154,54 +1222,12 @@
-Initialize storage for efficient identification of locations close
-to a given location. Allocates storage for keeping track of which 'box'
-each location in the list is in.
-Must be called after get_close_maxdist_init, and
-the list of locations here must be the same as the list of locations
-passed into get_close_obs(). If the list changes,
-get_close_obs_destroy() must be called, and both
-the initialization routines must be called again.
-It allocates space so it is necessary to call get_close_obs_destroy
-when completely done with getting distances between locations.
-
-
-
-
gc
-
Structure that contains data to efficiently find locations
- close to a given location.
-
num
-
The number of locations in the list.
-
obs
-
The locations of each element in the list,
- not used in 1D implementation.
these and the distances for the close ones. The list of locations
passed in via the obs argument must be identical to
the list of obs passed into the most recent call
-to get_close_obs_init(). If the list of locations
-of interest changes get_close_obs_destroy() must
+to get_close_init(). If the list of locations
+of interest changes get_close_destroy() must
be called and then the two initialization routines must be called
before using get_close_obs() again.
@@ -1241,7 +1268,7 @@
Public Interfaces
If called without the optional dist argument,
all locations that are potentially close are returned, which is likely a
superset of the locations that are within the threshold distance specified in
-the get_close_maxdist_init() call. This can be
+the get_close_init() call. This can be
useful to collect a list of potential locations, and then to convert
all the vertical coordinates into one consistent unit (pressure, height
in meters, etc), and then the list can be looped over, calling
@@ -1268,6 +1295,8 @@
Public Interfaces
dist
Distance between given location and the
close ones identified in close_ind.
Releases memory associated with the gc
derived type. Must be called whenever the list of locations
-changes, and then get_close_maxdist_init and
-get_close_obs_init must be called again
+changes, and then
+get_close_init must be called again
with the new locations list.
+Since it is possible to have different cutoffs for different observation types,
+an optional argument obs_type
+may be used to specify which maximum distance is of interest.
+The cutoff is specified as the half-width of the tapering function,
+get_maxdist returns the full width of the tapering function.
+
+
+
+
gc
+
Data for efficiently finding close locations.
+
obs_type
+
The integer code specifying the type of observation.
+
var
+
The distance at which the tapering function is zero. Put another way,
+anything closer than this number of radians is a close location.
+
+
+
+
+
+
+
+
@@ -1712,8 +1779,8 @@
Public Interfaces
-
+
@@ -1728,6 +1795,7 @@
Files
to read the location_mod namelist
+
@@ -1739,6 +1807,7 @@
References
none
+
@@ -1822,12 +1891,6 @@
Future Plans
name for this routine.
-The functions of 'get_close_maxdist_init()' and 'get_close_obs_init()'
-appear to be able to be combined into a single init routine. This
-impacts all model_mods, however, since they can intercept these routines.
-Doing this will be a non-backwards compatible change.
-
-
The use of 'obs' in all these routine names should probably be
changed to 'loc' since there is no particular dependence that
they be observations. They may need to have an associated DART
diff --git a/assimilation_code/location/twod/location_mod.f90 b/assimilation_code/location/twod/location_mod.f90
index dcb793b909..7dadbd6ce7 100644
--- a/assimilation_code/location/twod/location_mod.f90
+++ b/assimilation_code/location/twod/location_mod.f90
@@ -11,20 +11,18 @@ module location_mod
! as (x, y) from 0.0 to 1.0 in both dimensions.
use types_mod, only : r8, MISSING_R8
-use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format, &
- nc_check
+use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format
use random_seq_mod, only : random_seq_type, init_random_seq, random_uniform
implicit none
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
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, &
operator(==), operator(/=), get_dist, get_close_obs_destroy, &
- nc_write_location_atts, nc_get_location_varids, nc_write_location, &
vert_is_height, vert_is_pressure, vert_is_undef, vert_is_level, &
vert_is_surface, has_vertical_localization, &
set_vert, get_vert, set_which_vert
@@ -423,118 +421,6 @@ end subroutine interactive_location
!----------------------------------------------------------------------------
-function nc_write_location_atts( ncFileID, fname, ObsNumDimID ) result (ierr)
-
-! Writes the "location module" -specific attributes to a netCDF file.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(in) :: ObsNumDimID ! handle to the dimension that grows
-integer :: ierr
-
-integer :: LocDimID
-integer :: VarID
-
-if ( .not. module_initialized ) call initialize_module
-
-ierr = -1 ! assume things will fail ...
-
-! define the rank/dimension of the location information
-call nc_check(nf90_def_dim(ncid=ncFileID, name='location', len=LocationDims, &
- dimid = LocDimID), 'nc_write_location_atts', 'def_dim:location '//trim(fname))
-
-! Define the observation location variable and attributes
-
-call nc_check(nf90_def_var(ncid=ncFileID, name='location', xtype=nf90_double, &
- dimids=(/ LocDimID, ObsNumDimID /), varid=VarID), &
- 'nc_write_location_atts', 'location:def_var')
-
-call nc_check(nf90_put_att(ncFileID, VarID, 'description', &
- 'location coordinates'), 'nc_write_location_atts', 'location:description')
-call nc_check(nf90_put_att(ncFileID, VarID, 'location_type', &
- trim(LocationName)), 'nc_write_location_atts', 'location:location_type')
-call nc_check(nf90_put_att(ncFileID, VarID, 'long_name', &
- trim(LocationLName)), 'nc_write_location_atts', 'location:long_name')
-call nc_check(nf90_put_att(ncFileID, VarID, 'storage_order', &
- 'X Y'), 'nc_write_location_atts', 'location:storage_order')
-call nc_check(nf90_put_att(ncFileID, VarID, 'units', &
- 'none none'), 'nc_write_location_atts', 'location:units')
-
-! no vertical array here.
-
-! If we made it to here without error-ing out ... we're good.
-
-ierr = 0
-
-end function nc_write_location_atts
-
-!----------------------------------------------------------------------------
-
-subroutine nc_get_location_varids( ncFileID, fname, LocationVarID, WhichVertVarID )
-
-! Return the LocationVarID and WhichVertVarID variables from a given netCDF file.
-!
-! ncFileId the netcdf file descriptor
-! fname the name of the netcdf file (for error messages only)
-! LocationVarID the integer ID of the 'location' variable in the netCDF file
-! WhichVertVarID the integer ID of the 'which_vert' variable in the netCDF file
-!
-! In this instance, WhichVertVarID will never be defined, ... set to a bogus value
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(out) :: LocationVarID, WhichVertVarID
-
-if ( .not. module_initialized ) call initialize_module
-
-call nc_check(nf90_inq_varid(ncFileID, 'location', varid=LocationVarID), &
- 'nc_get_location_varids', 'inq_varid:location '//trim(fname))
-
-WhichVertVarID = -99
-
-end subroutine nc_get_location_varids
-
-!----------------------------------------------------------------------------
-
-subroutine nc_write_location(ncFileID, LocationVarID, loc, obsindex, WhichVertVarID)
-
-! Writes a SINGLE location to the specified netCDF variable and file.
-! The LocationVarID and WhichVertVarID must be the values returned from
-! the nc_get_location_varids call.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID, LocationVarID
-type(location_type), intent(in) :: loc
-integer, intent(in) :: obsindex
-integer, intent(in) :: WhichVertVarID
-
-real(r8), dimension(LocationDims) :: locations
-
-if ( .not. module_initialized ) call initialize_module
-
-locations = get_location( loc )
-
-call nc_check(nf90_put_var(ncFileID, LocationVarId, locations, &
- start=(/ 1, obsindex /), count=(/ LocationDims, 1 /) ), &
- 'nc_write_location', 'put_var:location')
-
-if ( WhichVertVarID >= 0 ) then
- write(errstring,*)'WhichVertVarID supposed to be negative ... is ',WhichVertVarID
- call error_handler(E_ERR, 'nc_write_location', errstring, source, revision, revdate)
-endif ! if less than zero (as it should be) ... just ignore
-
-end subroutine nc_write_location
-
-!----------------------------------------------------------------------------
-
subroutine get_close_obs_init(gc, num, obs)
! Initializes part of get_close accelerator that depends on the particular obs
@@ -609,6 +495,17 @@ subroutine get_close_obs(gc, base_obs_loc, base_obs_type, obs, obs_kind, &
end subroutine get_close_obs
+!---------------------------------------------------------------------------
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+get_maxdist = gc%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
function is_location_in_region(loc, minl, maxl)
diff --git a/assimilation_code/location/twod_annulus/location_mod.f90 b/assimilation_code/location/twod_annulus/location_mod.f90
index ba786ab144..b86d48c16c 100644
--- a/assimilation_code/location/twod_annulus/location_mod.f90
+++ b/assimilation_code/location/twod_annulus/location_mod.f90
@@ -16,21 +16,20 @@ module location_mod
use types_mod, only : r8, PI, RAD2DEG, DEG2RAD, MISSING_R8, MISSING_I
use utilities_mod, only : register_module, error_handler, E_ERR, ascii_file_format, &
- nc_check, find_namelist_in_file, check_namelist_read, &
+ find_namelist_in_file, check_namelist_read, &
do_output, do_nml_file, do_nml_term, nmlfileunit, &
- open_file, close_file, nc_check, is_longitude_between
+ open_file, close_file, is_longitude_between
use random_seq_mod, only : random_seq_type, init_random_seq, random_uniform
implicit none
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
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, &
operator(==), operator(/=), get_dist, get_close_obs_destroy, &
- nc_write_location_atts, nc_get_location_varids, nc_write_location, &
vert_is_height, vert_is_pressure, vert_is_undef, vert_is_level, &
vert_is_surface, has_vertical_localization, &
set_vert, get_vert, set_which_vert
@@ -315,7 +314,6 @@ subroutine write_location(locfile, loc, fform, charstring)
integer :: charlength
logical :: writebuf
-character(len = 128) :: string1
10 format(1X,F21.16,1X,G25.16,1X,I2)
@@ -565,112 +563,6 @@ end subroutine interactive_location
!----------------------------------------------------------------------------
-function nc_write_location_atts( ncFileID, fname, ObsNumDimID ) result (ierr)
-
-! Writes the "location module" -specific attributes to a netCDF file.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(in) :: ObsNumDimID ! handle to the dimension that grows
-integer :: ierr
-
-integer :: LocDimID
-integer :: VarID
-
-if ( .not. module_initialized ) call initialize_module
-
-ierr = -1 ! assume things will fail ...
-
-! define the rank/dimension of the location information
-call nc_check(nf90_def_dim(ncid=ncFileID, name='location', len=LocationDims, &
- dimid = LocDimID), 'nc_write_location_atts', 'def_dim:location '//trim(fname))
-
-! Define the observation location variable and attributes
-
-call nc_check(nf90_def_var(ncid=ncFileID, name='location', xtype=nf90_double, &
- dimids=(/ LocDimID, ObsNumDimID /), varid=VarID), &
- 'nc_write_location_atts', 'location:def_var')
-
-call nc_check(nf90_put_att(ncFileID, VarID, 'description', &
- 'location coordinates'), 'nc_write_location_atts', 'location:description')
-call nc_check(nf90_put_att(ncFileID, VarID, 'location_type', &
- trim(LocationName)), 'nc_write_location_atts', 'location:location_type')
-call nc_check(nf90_put_att(ncFileID, VarID, 'long_name', &
- trim(LocationLName)), 'nc_write_location_atts', 'location:long_name')
-call nc_check(nf90_put_att(ncFileID, VarID, 'storage_order', &
- 'Azimuth Radius'), 'nc_write_location_atts', 'location:storage_order')
-call nc_check(nf90_put_att(ncFileID, VarID, 'units', &
- 'degrees meters'), 'nc_write_location_atts', 'location:units')
-
-! Define the ancillary vertical array and attributes
-
-! If we made it to here without error-ing out ... we're good.
-
-ierr = 0
-
-end function nc_write_location_atts
-
-!----------------------------------------------------------------------------
-
-subroutine nc_get_location_varids( ncFileID, fname, LocationVarID, WhichVertVarID )
-
-! Return the LocationVarID and WhichVertVarID variables from a given netCDF file.
-!
-! ncFileId the netcdf file descriptor
-! fname the name of the netcdf file (for error messages only)
-! LocationVarID the integer ID of the 'location' variable in the netCDF file
-! WhichVertVarID the integer ID of the 'which_vert' variable in the netCDF file
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(out) :: LocationVarID, WhichVertVarID
-
-if ( .not. module_initialized ) call initialize_module
-
-call nc_check(nf90_inq_varid(ncFileID, 'location', varid=LocationVarID), &
- 'nc_get_location_varids', 'inq_varid:location '//trim(fname))
-
-WhichVertVarID = -99
-
-end subroutine nc_get_location_varids
-
-!----------------------------------------------------------------------------
-
-subroutine nc_write_location(ncFileID, LocationVarID, loc, obsindex, WhichVertVarID)
-
-! Writes a SINGLE location to the specified netCDF variable and file.
-! The LocationVarID and WhichVertVarID must be the values returned from
-! the nc_get_location_varids call.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID, LocationVarID
-type(location_type), intent(in) :: loc
-integer, intent(in) :: obsindex
-integer, intent(in) :: WhichVertVarID
-
-real(r8), dimension(LocationDims) :: locations
-integer, dimension(1) :: intval
-
-if ( .not. module_initialized ) call initialize_module
-
-locations = get_location( loc ) ! converts from radians to degrees, btw
-
-call nc_check(nf90_put_var(ncFileID, LocationVarId, locations, &
- start=(/ 1, obsindex /), count=(/ LocationDims, 1 /) ), &
- 'nc_write_location', 'put_var:location')
-
-end subroutine nc_write_location
-
-!----------------------------------------------------------------------------
-
subroutine get_close_obs_init(gc, num, obs)
! Initializes part of get_close accelerator that depends on the particular obs
@@ -746,6 +638,17 @@ subroutine get_close_obs(gc, base_obs_loc, base_obs_type, obs, obs_kind, &
end subroutine get_close_obs
+!---------------------------------------------------------------------------
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+get_maxdist = gc%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
function is_location_in_region(loc, minl, maxl)
diff --git a/assimilation_code/location/twod_sphere/location_mod.f90 b/assimilation_code/location/twod_sphere/location_mod.f90
index d9b2a453ab..ed00c87b87 100644
--- a/assimilation_code/location/twod_sphere/location_mod.f90
+++ b/assimilation_code/location/twod_sphere/location_mod.f90
@@ -15,19 +15,18 @@ module location_mod
use types_mod, only : r8, DEG2RAD, RAD2DEG, PI, MISSING_R8
use utilities_mod, only : register_module, error_handler, E_ERR, &
- ascii_file_format, is_longitude_between, nc_check
+ ascii_file_format, is_longitude_between
use random_seq_mod, only : random_seq_type, init_random_seq, random_uniform
implicit none
private
public :: location_type, get_location, set_location, &
- set_location_missing, is_location_in_region, &
+ set_location_missing, is_location_in_region, get_maxdist, &
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, &
operator(==), operator(/=), get_dist, get_close_obs_destroy, &
- nc_write_location_atts, nc_get_location_varids, nc_write_location, &
vert_is_height, vert_is_pressure, vert_is_undef, vert_is_level, &
vert_is_surface, has_vertical_localization, &
set_vert, get_vert, set_which_vert
@@ -412,118 +411,6 @@ end subroutine interactive_location
!----------------------------------------------------------------------------
-function nc_write_location_atts( ncFileID, fname, ObsNumDimID ) result (ierr)
-
-! Writes the "location module" -specific attributes to a netCDF file.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(in) :: ObsNumDimID ! handle to the dimension that grows
-integer :: ierr
-
-integer :: LocDimID
-integer :: VarID
-
-if ( .not. module_initialized ) call initialize_module
-
-ierr = -1 ! assume things will fail ...
-
-! define the rank/dimension of the location information
-call nc_check(nf90_def_dim(ncid=ncFileID, name='location', len=LocationDims, &
- dimid = LocDimID), 'nc_write_location_atts', 'def_dim:location '//trim(fname))
-
-! Define the observation location variable and attributes
-
-call nc_check(nf90_def_var(ncid=ncFileID, name='location', xtype=nf90_double, &
- dimids=(/ LocDimID, ObsNumDimID /), varid=VarID), &
- 'nc_write_location_atts', 'location:def_var')
-
-call nc_check(nf90_put_att(ncFileID, VarID, 'description', &
- 'location coordinates'), 'nc_write_location_atts', 'location:description')
-call nc_check(nf90_put_att(ncFileID, VarID, 'location_type', &
- trim(LocationName)), 'nc_write_location_atts', 'location:location_type')
-call nc_check(nf90_put_att(ncFileID, VarID, 'long_name', &
- trim(LocationLName)), 'nc_write_location_atts', 'location:long_name')
-call nc_check(nf90_put_att(ncFileID, VarID, 'storage_order', &
- 'Lon Lat'), 'nc_write_location_atts', 'location:storage_order')
-call nc_check(nf90_put_att(ncFileID, VarID, 'units', &
- 'degrees degrees'), 'nc_write_location_atts', 'location:units')
-
-! No vertical for this location type.
-
-! If we made it to here without error-ing out ... we're good.
-
-ierr = 0
-
-end function nc_write_location_atts
-
-!----------------------------------------------------------------------------
-
-subroutine nc_get_location_varids( ncFileID, fname, LocationVarID, WhichVertVarID )
-
-! Return the LocationVarID and WhichVertVarID variables from a given netCDF file.
-!
-! ncFileId the netcdf file descriptor
-! fname the name of the netcdf file (for error messages only)
-! LocationVarID the integer ID of the 'location' variable in the netCDF file
-! WhichVertVarID the integer ID of the 'which_vert' variable in the netCDF file
-!
-! In this instance, WhichVertVarID will never be defined, ... set to a bogus value
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID ! handle to the netcdf file
-character(len=*), intent(in) :: fname ! file name (for printing purposes)
-integer, intent(out) :: LocationVarID, WhichVertVarID
-
-if ( .not. module_initialized ) call initialize_module
-
-call nc_check(nf90_inq_varid(ncFileID, 'location', varid=LocationVarID), &
- 'nc_get_location_varids', 'inq_varid:location '//trim(fname))
-
-WhichVertVarID = -99
-
-end subroutine nc_get_location_varids
-
-!----------------------------------------------------------------------------
-
-subroutine nc_write_location(ncFileID, LocationVarID, loc, obsindex, WhichVertVarID)
-
-! Writes a SINGLE location to the specified netCDF variable and file.
-! The LocationVarID and WhichVertVarID must be the values returned from
-! the nc_get_location_varids call.
-
-use typeSizes
-use netcdf
-
-integer, intent(in) :: ncFileID, LocationVarID
-type(location_type), intent(in) :: loc
-integer, intent(in) :: obsindex
-integer, intent(in) :: WhichVertVarID
-
-real(r8), dimension(LocationDims) :: locations
-
-if ( .not. module_initialized ) call initialize_module
-
-locations = get_location( loc ) ! converts from radians to degrees, btw
-
-call nc_check(nf90_put_var(ncFileID, LocationVarId, locations, &
- start=(/ 1, obsindex /), count=(/ LocationDims, 1 /) ), &
- 'nc_write_location', 'put_var:location')
-
-if ( WhichVertVarID >= 0 ) then
- write(errstring,*)'WhichVertVarID supposed to be negative ... is ',WhichVertVarID
- call error_handler(E_ERR, 'nc_write_location', errstring, source, revision, revdate)
-endif ! if less than zero (as it should be) ... just ignore
-
-end subroutine nc_write_location
-
-!----------------------------------------------------------------------------
-
subroutine get_close_obs_init(gc, num, obs)
! Initializes part of get_close accelerator that depends on the particular obs
@@ -598,6 +485,17 @@ subroutine get_close_obs(gc, base_obs_loc, base_obs_type, obs, obs_kind, &
end subroutine get_close_obs
+!---------------------------------------------------------------------------
+
+function get_maxdist(gc, obs_type)
+type(get_close_type), intent(in) :: gc
+integer, optional, intent(in) :: obs_type
+real(r8) :: get_maxdist
+
+get_maxdist = gc%maxdist
+
+end function get_maxdist
+
!----------------------------------------------------------------------------
function is_location_in_region(loc, minl, maxl)
diff --git a/assimilation_code/modules/assimilation/adaptive_inflate_mod.f90 b/assimilation_code/modules/assimilation/adaptive_inflate_mod.f90
index e650a4a7c2..5f56a02857 100644
--- a/assimilation_code/modules/assimilation/adaptive_inflate_mod.f90
+++ b/assimilation_code/modules/assimilation/adaptive_inflate_mod.f90
@@ -364,7 +364,8 @@ end function deterministic_inflate
subroutine validate_inflate_options(inf_flavor, inf_damping, inf_initial_from_restart, &
inf_sd_initial_from_restart, inf_deterministic, inf_sd_max_change, &
- do_prior_inflate, do_posterior_inflate, output_inflation)
+ do_prior_inflate, do_posterior_inflate, output_inflation, &
+ compute_posterior)
integer, intent(in) :: inf_flavor(2)
real(r8), intent(inout) :: inf_damping(2)
@@ -375,6 +376,7 @@ subroutine validate_inflate_options(inf_flavor, inf_damping, inf_initial_from_re
logical, intent(out) :: do_prior_inflate
logical, intent(out) :: do_posterior_inflate
logical, intent(out) :: output_inflation
+logical, intent(in) :: compute_posterior
integer :: i
character(len=32) :: string(2)
@@ -411,6 +413,13 @@ subroutine validate_inflate_options(inf_flavor, inf_damping, inf_initial_from_re
if(inf_flavor(1) == 4) call error_handler(E_ERR, 'validate_inflate_options', &
'RTPS inflation (type 4) only supported for Posterior inflation', source, revision, revdate)
+! Cannot select posterior options if not computing posterior
+if(.not. compute_posterior .and. inf_flavor(2) > 0) then
+ write(msgstring, *) 'cannot enable posterior inflation if not computing posterior values'
+ call error_handler(E_ERR,'validate_inflate_options', msgstring, source, revision, revdate, &
+ text2='"compute_posterior" is false; posterior inflation flavor must be 0')
+endif
+
! RTPS needs a single parameter from namelist: inf_initial(2).
! Do not read in any files. Also, no damping. but warn the user if they try to set different
! values in the namelist.
@@ -588,12 +597,9 @@ subroutine bayes_cov_inflate(ens_size, inf_type, x_p, sigma_p_2, y_o, sigma_o_2,
real(r8), intent(in) :: gamma_corr, sd_lower_bound_in, sd_max_change_in
real(r8), intent(out) :: new_cov_inflate, new_cov_inflate_sd
-integer :: i, mlambda_index(1)
real(r8) :: dist_2, rate, shape_old, shape_new, rate_new
real(r8) :: lambda_sd_2, density_1, density_2, omega, ratio
real(r8) :: new_1_sd, new_max
-real(r8) :: b, c, d, Q, R, disc, alpha, beta, cube_root_alpha, cube_root_beta, x
-real(r8) :: rrr, cube_root_rrr, angle, mx(3), sep(3), mlambda(3)
! If gamma is 0, nothing changes
if(gamma_corr <= 0.0_r8) then
@@ -610,6 +616,10 @@ subroutine bayes_cov_inflate(ens_size, inf_type, x_p, sigma_p_2, y_o, sigma_o_2,
! this block of code no longer being used. it's here for historical purposes.
+!integer :: i, mlambda_index(1)
+!real(r8) :: b, c, d, Q, R, disc, alpha, beta, cube_root_alpha, cube_root_beta, x
+!real(r8) :: rrr, cube_root_rrr, angle, mx(3), sep(3), mlambda(3)
+
! ! Use ONLY the linear approximation, cubic solution below can be numerically
! ! unstable for extreme cases. Should look at this later.
! if(gamma_corr > 0.99_r8) then
@@ -669,44 +679,55 @@ subroutine bayes_cov_inflate(ens_size, inf_type, x_p, sigma_p_2, y_o, sigma_o_2,
call linear_bayes(dist_2, sigma_p_2, sigma_o_2, lambda_mean, lambda_sd_2, gamma_corr, &
new_cov_inflate)
-! Bail out to save cost when lower bound is reached on lambda standard deviation
-if(lambda_sd <= sd_lower_bound_in) then
- new_cov_inflate_sd = lambda_sd
-else
- ! Compute by forcing a Gaussian fit at one positive SD
-! First compute the new_max value for normalization purposes
- new_max = compute_new_density(dist_2, sigma_p_2, sigma_o_2, lambda_mean, lambda_sd, &
- gamma_corr, new_cov_inflate)
-
-! Find value at a point one OLD sd above new mean value
- new_1_sd = compute_new_density(dist_2, sigma_p_2, sigma_o_2, lambda_mean, lambda_sd, gamma_corr, &
- new_cov_inflate + lambda_sd)
-
- ! If either the numerator or denominator of the following computation
- ! of 'ratio' is going to be zero (or almost so), return the original incoming
- ! inflation value. The computation would have resulted in either Inf or NaN.
- if (abs(new_max) <= TINY(0.0_r8) .or. abs(new_1_sd) <= TINY(0.0_r8)) then
- new_cov_inflate_sd = lambda_sd
- return
- endif
-
- ratio = new_1_sd / new_max
-
- ! Another error for numerical issues; if ratio is larger than 0.99, bail out
- if(ratio > 0.99) then
+ ! Bail out to save cost when lower bound is reached on lambda standard deviation
+ ! The original test to see if lambda_sd was less than the lower bound
+ ! would sometimes return false because of roundoff error and the computation
+ ! would go through the expensive part of the code when the minimum was
+ ! really reached. (sd_lower_bound comes from a namelist and precision
+ ! errors may be because of the conversion between ascii, single precision
+ ! and double precision.) In any case, the test was changed to return if
+ ! the value is within TINY of the limit.
+ if(abs(lambda_sd - sd_lower_bound_in) <= TINY(0.0_r8)) then
new_cov_inflate_sd = lambda_sd
return
- endif
-
- ! Can now compute the standard deviation consistent with this as
+ else
+ ! Compute by forcing a Gaussian fit at one positive SD
+ ! First compute the new_max value for normalization purposes
+ new_max = compute_new_density(dist_2, sigma_p_2, sigma_o_2, lambda_mean, lambda_sd, &
+ gamma_corr, new_cov_inflate)
+
+ ! Find value at a point one OLD sd above new mean value
+ new_1_sd = compute_new_density(dist_2, sigma_p_2, sigma_o_2, lambda_mean, lambda_sd, gamma_corr, &
+ new_cov_inflate + lambda_sd)
+
+ ! If either the numerator or denominator of the following computation
+ ! of 'ratio' is going to be zero (or almost so), return the original incoming
+ ! inflation value. The computation would have resulted in either Inf or NaN.
+ if (abs(new_max) <= TINY(0.0_r8) .or. abs(new_1_sd) <= TINY(0.0_r8)) then
+ new_cov_inflate_sd = lambda_sd
+ return
+ endif
+
+ ratio = new_1_sd / new_max
+
+ ! Another error for numerical issues; if ratio is larger than 0.99, bail out
+ if(ratio > 0.99) then
+ new_cov_inflate_sd = lambda_sd
+ return
+ endif
+
+ ! Can now compute the standard deviation consistent with this as
! sigma = sqrt(-x^2 / (2 ln(r)) where r is ratio and x is lambda_sd (distance from mean)
- new_cov_inflate_sd = sqrt( -1.0_r8 * lambda_sd_2 / (2.0_r8 * log(ratio)))
-
- ! Prevent an increase in the sd of lambda???
- ! For now, this is mostly countering numerical errors in this computation
- if(new_cov_inflate_sd > lambda_sd) new_cov_inflate_sd = lambda_sd
-
-endif
+ new_cov_inflate_sd = sqrt( -1.0_r8 * lambda_sd_2 / (2.0_r8 * log(ratio)))
+
+ ! Prevent an increase in the sd of lambda???
+ ! For now, this is mostly countering numerical errors in this computation
+ if(new_cov_inflate_sd > lambda_sd) then
+ new_cov_inflate_sd = lambda_sd
+ return
+ endif
+
+ endif
else if (inf_type == GHA2017) then
@@ -718,9 +739,10 @@ subroutine bayes_cov_inflate(ens_size, inf_type, x_p, sigma_p_2, y_o, sigma_o_2,
gamma_corr, ens_size, rate, new_cov_inflate)
! Bail out to save cost when lower bound is reached on lambda standard deviation
- if(lambda_sd <= sd_lower_bound_in) then
+ ! See comment in Anderson case for why we use abs and TINY for this comparison.
+ if(abs(lambda_sd - sd_lower_bound_in) <= TINY(0.0_r8)) then
new_cov_inflate_sd = lambda_sd
-
+ return
else
! Compute the shape parameter of the prior IG
! This comes from the assumption that the mode of the IG is the mean/mode of the input Gaussian
@@ -761,9 +783,12 @@ subroutine bayes_cov_inflate(ens_size, inf_type, x_p, sigma_p_2, y_o, sigma_o_2,
! If the updated variance is more than xx% the prior variance, keep the prior unchanged
! for stability reasons. Also, if the updated variance is NaN (not sure why this
- ! can happen; never did when develping this code), keep the prior variance unchanged.
+ ! can happen; never did when developing this code), keep the prior variance unchanged.
if ( new_cov_inflate_sd > sd_max_change_in*lambda_sd .OR. &
- new_cov_inflate_sd /= new_cov_inflate_sd) new_cov_inflate_sd = lambda_sd
+ new_cov_inflate_sd /= new_cov_inflate_sd) then
+ new_cov_inflate_sd = lambda_sd
+ return
+ endif
endif
else
diff --git a/assimilation_code/modules/assimilation/assim_model_mod.f90 b/assimilation_code/modules/assimilation/assim_model_mod.f90
index 8029963218..20b899e807 100644
--- a/assimilation_code/modules/assimilation/assim_model_mod.f90
+++ b/assimilation_code/modules/assimilation/assim_model_mod.f90
@@ -59,9 +59,6 @@ module assim_model_mod
character(len=128), parameter :: revdate = "$Date$"
-! Permanent class storage for model_size
-integer :: model_size
-
! Ensure init code is called exactly once
logical :: module_initialized = .false.
diff --git a/assimilation_code/modules/assimilation/assim_tools_mod.f90 b/assimilation_code/modules/assimilation/assim_tools_mod.f90
index 21d590418a..f98f3d8f39 100644
--- a/assimilation_code/modules/assimilation/assim_tools_mod.f90
+++ b/assimilation_code/modules/assimilation/assim_tools_mod.f90
@@ -3043,7 +3043,7 @@ subroutine log_namelist_selections(num_special_cutoff, cache_override)
if (adjust_obs_impact) then
call allocate_impact_table(obs_impact_table)
- call read_impact_table(obs_impact_filename, obs_impact_table, allow_any_impact_values)
+ call read_impact_table(obs_impact_filename, obs_impact_table, allow_any_impact_values, "allow_any_impact_values")
call error_handler(E_MSG, 'assim_tools_init:', &
'Using observation impact table from file "'//trim(obs_impact_filename)//'"')
endif
diff --git a/assimilation_code/modules/assimilation/filter_mod.dopplerfold.f90 b/assimilation_code/modules/assimilation/filter_mod.dopplerfold.f90
index c5f356eb0f..b07bbbee7f 100644
--- a/assimilation_code/modules/assimilation/filter_mod.dopplerfold.f90
+++ b/assimilation_code/modules/assimilation/filter_mod.dopplerfold.f90
@@ -48,7 +48,7 @@ module filter_mod
compute_copy_mean, compute_copy_mean_sd, &
compute_copy_mean_var, duplicate_ens, get_copy_owner_index, &
get_ensemble_time, set_ensemble_time, broadcast_copy, &
- map_task_to_pe, map_pe_to_task, prepare_to_update_copies, &
+ map_pe_to_task, prepare_to_update_copies, &
copies_in_window, set_num_extra_copies, get_allow_transpose, &
all_copies_to_all_vars, allocate_single_copy, allocate_vars, &
get_single_copy, put_single_copy, deallocate_single_copy, &
@@ -108,9 +108,8 @@ module filter_mod
! Some convenient global storage items
character(len=512) :: msgstring
-type(obs_type) :: observation
-integer :: trace_level, timestamp_level
+integer :: trace_level, timestamp_level
! Defining whether diagnostics are for prior or posterior
integer, parameter :: PRIOR_DIAG = 0, POSTERIOR_DIAG = 2
@@ -159,6 +158,12 @@ module filter_mod
logical :: has_cycling = .false. ! filter will advance the model
+! parms for trace/timing messages
+integer, parameter :: T_BEFORE = 1
+integer, parameter :: T_AFTER = 2
+integer, parameter :: T_NEITHER = 3
+logical, parameter :: P_TIME = .true.
+
!----------------------------------------------------------------
! Namelist input with default values
!
@@ -201,8 +206,11 @@ module filter_mod
logical :: perturb_from_single_instance = .false.
real(r8) :: perturbation_amplitude = 0.2_r8
! File options. Single vs. Multiple. really 'unified' or 'combination' vs 'individual'
-logical :: single_file_in = .false. ! all copies read from 1 file
-logical :: single_file_out = .false. ! all copies written to 1 file
+logical :: single_file_in = .false. ! all copies read from 1 file
+logical :: single_file_out = .false. ! all copies written to 1 file
+
+! optimization option:
+logical :: compute_posterior = .true. ! set to false to not compute posterior values
! Stages to write. Valid values are:
! multi-file: input, forecast, preassim, postassim, analysis, output
@@ -289,6 +297,7 @@ module filter_mod
single_file_out, &
perturb_from_single_instance, &
perturbation_amplitude, &
+ compute_posterior, &
stages_to_write, &
input_state_files, &
output_state_files, &
@@ -324,7 +333,7 @@ subroutine filter_main()
integer, allocatable :: keys(:)
integer(i8) :: model_size
-integer :: i, iunit, io, time_step_number, num_obs_in_set, ntimes
+integer :: iunit, io, time_step_number, num_obs_in_set, ntimes
integer :: last_key_used, key_bounds(2)
integer :: in_obs_copy, obs_val_index
integer :: prior_obs_mean_index, posterior_obs_mean_index
@@ -393,7 +402,7 @@ subroutine filter_main()
call validate_inflate_options(inf_flavor, inf_damping, inf_initial_from_restart, &
inf_sd_initial_from_restart, inf_deterministic, inf_sd_max_change, &
- do_prior_inflate, do_posterior_inflate, output_inflation)
+ do_prior_inflate, do_posterior_inflate, output_inflation, compute_posterior)
! Initialize the adaptive inflation module
call adaptive_inflate_init(prior_inflate, inf_flavor(1), inf_initial_from_restart(1), &
@@ -461,11 +470,27 @@ subroutine filter_main()
TOTAL_OBS_COPIES = ens_size + 5 + 2*num_groups
+!>@todo FIXME turn trace/timestamp calls into:
+!>
+!> integer, parameter :: T_BEFORE = 1
+!> integer, parameter :: T_AFTER = 2
+!> integer, parameter :: P_TIME = 1
+!>
+!> call progress(string, T_BEFORE) ! simple trace msg
+!> call progress(string, T_AFTER)
+!>
+!> call progress(string, T_BEFORE, P_TIME) ! trace plus timestamp
+!> call progress(string, T_AFTER, P_TIME)
+
+!> DO NOT timestamp every trace message because some are
+!> so quick that the timestamps don't impart any info.
+!> we should be careful to timestamp logical *sections* instead.
+
call trace_message('Before setting up space for observations')
call timestamp_message('Before setting up space for observations')
! Initialize the obs_sequence; every pe gets a copy for now
-call filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, input_qc_index, DART_qc_index)
+call filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, input_qc_index, DART_qc_index, compute_posterior)
call timestamp_message('After setting up space for observations')
call trace_message('After setting up space for observations')
@@ -477,17 +502,31 @@ subroutine filter_main()
if(distributed_state) then
call init_ensemble_manager(state_ens_handle, num_state_ens_copies, model_size)
+ msgstring = 'running with distributed state; model states stay distributed across all tasks for the entire run'
else
call init_ensemble_manager(state_ens_handle, num_state_ens_copies, model_size, transpose_type_in = 2)
+ msgstring = 'running without distributed state; model states are gathered by ensemble for forward operators'
endif
+! don't print if running single task. transposes don't matter in this case.
+if (task_count() > 1) &
+ call error_handler(E_MSG,'filter_main:', msgstring, source, revision, revdate)
call set_num_extra_copies(state_ens_handle, num_extras)
call trace_message('After setting up space for ensembles')
! Don't currently support number of processes > model_size
-if(task_count() > model_size) call error_handler(E_ERR,'filter_main', &
- 'Number of processes > model size' ,source,revision,revdate)
+if(task_count() > model_size) then
+ write(msgstring, *) 'number of MPI processes = ', task_count(), ' while model size = ', model_size
+ call error_handler(E_ERR,'filter_main', &
+ 'Cannot have number of processes > model size' ,source,revision,revdate, &
+ text2=msgstring)
+endif
+
+if(.not. compute_posterior) then
+ msgstring = 'skipping computation of posterior forward operators'
+ call error_handler(E_MSG,'filter_main:', msgstring, source, revision, revdate)
+endif
! Set a time type for initial time if namelist inputs are not negative
call filter_set_initial_time(init_time_days, init_time_seconds, time1, read_time_from_file)
@@ -551,7 +590,8 @@ subroutine filter_main()
! Initialize the output sequences and state files and set their meta data
call filter_generate_copy_meta_data(seq, in_obs_copy, &
prior_obs_mean_index, posterior_obs_mean_index, &
- prior_obs_spread_index, posterior_obs_spread_index)
+ prior_obs_spread_index, posterior_obs_spread_index, &
+ compute_posterior)
if(ds) call error_handler(E_ERR, 'filter', 'smoother broken by Helen')
if(ds) call smoother_gen_copy_meta_data(num_output_state_members, output_inflation=.true.) !> @todo fudge
@@ -840,14 +880,10 @@ subroutine filter_main()
obs_val_index, OBS_KEY_COPY, & ! new
prior_obs_mean_index, prior_obs_spread_index, num_obs_in_set, &
OBS_MEAN_START, OBS_VAR_START, OBS_GLOBAL_QC_COPY, &
- OBS_VAL_COPY, OBS_ERR_VAR_COPY, DART_qc_index)
+ OBS_VAL_COPY, OBS_ERR_VAR_COPY, DART_qc_index, compute_posterior)
call trace_message('After observation space diagnostics')
- ! FIXME: i believe both copies and vars are equal at the end
- ! of the obs_space diags, so we can skip this.
- !call all_vars_to_all_copies(obs_fwd_op_ens_handle)
-
write(msgstring, '(A,I8,A)') 'Ready to assimilate up to', size(keys), ' observations'
call trace_message(msgstring, 'filter:', -1)
@@ -951,43 +987,47 @@ subroutine filter_main()
! this block recomputes the expected obs values for the obs_seq.final file
- call trace_message('Before computing posterior observation values')
- call timestamp_message('Before computing posterior observation values')
-
- ! Compute the ensemble of posterior observations, load up the obs_err_var
- ! and obs_values. ens_size is the number of regular ensemble members,
- ! not the number of copies
-
- call get_obs_ens_distrib_state(state_ens_handle, obs_fwd_op_ens_handle, qc_ens_handle, &
- seq, keys, obs_val_index, input_qc_index, &
- OBS_ERR_VAR_COPY, OBS_VAL_COPY, OBS_KEY_COPY, OBS_GLOBAL_QC_COPY, OBS_EXTRA_QC_COPY, &
- OBS_MEAN_START, OBS_VAR_START, isprior=.false., prior_qc_copy=prior_qc_copy)
-
- call deallocate_single_copy(obs_fwd_op_ens_handle, prior_qc_copy)
-
- call timestamp_message('After computing posterior observation values')
- call trace_message('After computing posterior observation values')
-
- if(ds) then
- call trace_message('Before computing smoother means/spread')
- call smoother_mean_spread(ens_size, ENS_MEAN_COPY, ENS_SD_COPY)
- call trace_message('After computing smoother means/spread')
+ if (compute_posterior) then
+ call trace_message('Before computing posterior observation values')
+ call timestamp_message('Before computing posterior observation values')
+
+ ! Compute the ensemble of posterior observations, load up the obs_err_var
+ ! and obs_values. ens_size is the number of regular ensemble members,
+ ! not the number of copies
+
+ call get_obs_ens_distrib_state(state_ens_handle, obs_fwd_op_ens_handle, qc_ens_handle, &
+ seq, keys, obs_val_index, input_qc_index, &
+ OBS_ERR_VAR_COPY, OBS_VAL_COPY, OBS_KEY_COPY, OBS_GLOBAL_QC_COPY, OBS_EXTRA_QC_COPY, &
+ OBS_MEAN_START, OBS_VAR_START, isprior=.false., prior_qc_copy=prior_qc_copy)
+
+ call deallocate_single_copy(obs_fwd_op_ens_handle, prior_qc_copy)
+
+ call timestamp_message('After computing posterior observation values')
+ call trace_message('After computing posterior observation values')
+
+ if(ds) then
+ call trace_message('Before computing smoother means/spread')
+ call smoother_mean_spread(ens_size, ENS_MEAN_COPY, ENS_SD_COPY)
+ call trace_message('After computing smoother means/spread')
+ endif
+
+ call trace_message('Before posterior obs space diagnostics')
+
+ ! Write posterior observation space diagnostics
+ ! There is a transpose (all_copies_to_all_vars(obs_fwd_op_ens_handle)) in obs_space_diagnostics
+ call obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size, &
+ seq, keys, POSTERIOR_DIAG, num_output_obs_members, in_obs_copy+2, &
+ obs_val_index, OBS_KEY_COPY, & ! new
+ posterior_obs_mean_index, posterior_obs_spread_index, num_obs_in_set, &
+ OBS_MEAN_START, OBS_VAR_START, OBS_GLOBAL_QC_COPY, &
+ OBS_VAL_COPY, OBS_ERR_VAR_COPY, DART_qc_index, compute_posterior)
+
+
+ call trace_message('After posterior obs space diagnostics')
+ else
+ call deallocate_single_copy(obs_fwd_op_ens_handle, prior_qc_copy)
endif
- call trace_message('Before posterior obs space diagnostics')
-
- ! Write posterior observation space diagnostics
- ! There is a transpose (all_copies_to_all_vars(obs_fwd_op_ens_handle)) in obs_space_diagnostics
- call obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size, &
- seq, keys, POSTERIOR_DIAG, num_output_obs_members, in_obs_copy+2, &
- obs_val_index, OBS_KEY_COPY, & ! new
- posterior_obs_mean_index, posterior_obs_spread_index, num_obs_in_set, &
- OBS_MEAN_START, OBS_VAR_START, OBS_GLOBAL_QC_COPY, &
- OBS_VAL_COPY, OBS_ERR_VAR_COPY, DART_qc_index)
-
-
- call trace_message('After posterior obs space diagnostics')
-
! this block computes the adaptive state space posterior inflation
! (it was applied earlier, this is computing the updated values for
! the next cycle.)
@@ -1045,13 +1085,15 @@ subroutine filter_main()
endif
! only intended for debugging when cycling inside filter.
- ! writing the obs_seq file can be slow - but if filter crashes
+ ! writing the obs_seq file here will be slow - but if filter crashes
! you can get partial results by enabling this flag.
if (write_obs_every_cycle) then
- call trace_message('Before writing in-progress output sequence file')
+ call trace_message('Before writing in-progress output sequence file')
+ call timestamp_message('Before writing in-progress output sequence file')
! Only pe 0 outputs the observation space diagnostic file
if(my_task_id() == 0) call write_obs_seq(seq, obs_sequence_out_name)
- call trace_message('After writing in-progress output sequence file')
+ call timestamp_message('After writing in-progress output sequence file')
+ call trace_message('After writing in-progress output sequence file')
endif
call trace_message('Near bottom of main loop, cleaning up obs space')
@@ -1088,10 +1130,12 @@ subroutine filter_main()
endif
-call trace_message('Before writing output sequence file')
+call trace_message('Before writing output sequence file')
+call timestamp_message('Before writing output sequence file')
! Only pe 0 outputs the observation space diagnostic file
if(my_task_id() == 0) call write_obs_seq(seq, obs_sequence_out_name)
-call trace_message('After writing output sequence file')
+call timestamp_message('After writing output sequence file')
+call trace_message('After writing output sequence file')
! Output all restart files if requested
if (write_all_stages_at_end) then
@@ -1135,8 +1179,7 @@ subroutine filter_main()
call trace_message('Before ensemble and obs memory cleanup')
call end_ensemble_manager(state_ens_handle)
-! Free up the observation kind and obs sequence
-call destroy_obs(observation)
+! Free up the obs sequence
call destroy_obs_sequence(seq)
call trace_message('After ensemble and obs memory cleanup')
@@ -1163,12 +1206,14 @@ end subroutine filter_main
!> in the ensemble handle.
subroutine filter_generate_copy_meta_data(seq, in_obs_copy, &
prior_obs_mean_index, posterior_obs_mean_index, &
- prior_obs_spread_index, posterior_obs_spread_index)
+ prior_obs_spread_index, posterior_obs_spread_index, &
+ do_post)
type(obs_sequence_type), intent(inout) :: seq
integer, intent(in) :: in_obs_copy
integer, intent(out) :: prior_obs_mean_index, posterior_obs_mean_index
integer, intent(out) :: prior_obs_spread_index, posterior_obs_spread_index
+logical, intent(in) :: do_post
! Figures out the strings describing the output copies for the three output files.
! THese are the prior and posterior state output files and the observation sequence
@@ -1177,30 +1222,52 @@ subroutine filter_generate_copy_meta_data(seq, in_obs_copy, &
character(len=metadatalength) :: prior_meta_data, posterior_meta_data
integer :: i, num_obs_copies
+! only PE0 (here task 0) will allocate space for the obs_seq.final
+!
+! all other tasks should NOT allocate all this space.
+! instead, set the copy numbers to an illegal value
+! so we'll trap if they're used, and return early.
+if (my_task_id() /= 0) then
+ prior_obs_mean_index = -1
+ posterior_obs_mean_index = -1
+ prior_obs_spread_index = -1
+ posterior_obs_spread_index = -1
+ return
+endif
+
! Set the metadata for the observations.
! Set up obs ensemble mean
num_obs_copies = in_obs_copy
+
num_obs_copies = num_obs_copies + 1
prior_meta_data = 'prior ensemble mean'
call set_copy_meta_data(seq, num_obs_copies, prior_meta_data)
prior_obs_mean_index = num_obs_copies
-num_obs_copies = num_obs_copies + 1
-posterior_meta_data = 'posterior ensemble mean'
-call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
-posterior_obs_mean_index = num_obs_copies
+
+if (do_post) then
+ num_obs_copies = num_obs_copies + 1
+ posterior_meta_data = 'posterior ensemble mean'
+ call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
+ posterior_obs_mean_index = num_obs_copies
+endif
! Set up obs ensemble spread
num_obs_copies = num_obs_copies + 1
prior_meta_data = 'prior ensemble spread'
call set_copy_meta_data(seq, num_obs_copies, prior_meta_data)
prior_obs_spread_index = num_obs_copies
-num_obs_copies = num_obs_copies + 1
-posterior_meta_data = 'posterior ensemble spread'
-call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
-posterior_obs_spread_index = num_obs_copies
-! Make sure there are not too many copies requested
+if (do_post) then
+ num_obs_copies = num_obs_copies + 1
+ posterior_meta_data = 'posterior ensemble spread'
+ call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
+ posterior_obs_spread_index = num_obs_copies
+endif
+
+! Make sure there are not too many copies requested -
+! proposed: make this magic number set in 1 place with an accessor
+! routine so all parts of the code agree on max values.
if(num_output_obs_members > 10000) then
write(msgstring, *)'output metadata in filter needs obs ensemble size < 10000, not ',&
num_output_obs_members
@@ -1209,12 +1276,14 @@ subroutine filter_generate_copy_meta_data(seq, in_obs_copy, &
! Set up obs ensemble members as requested
do i = 1, num_output_obs_members
- write(prior_meta_data, '(a21, 1x, i6)') 'prior ensemble member', i
- write(posterior_meta_data, '(a25, 1x, i6)') 'posterior ensemble member', i
num_obs_copies = num_obs_copies + 1
+ write(prior_meta_data, '(a21, 1x, i6)') 'prior ensemble member', i
call set_copy_meta_data(seq, num_obs_copies, prior_meta_data)
- num_obs_copies = num_obs_copies + 1
- call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
+ if (do_post) then
+ num_obs_copies = num_obs_copies + 1
+ write(posterior_meta_data, '(a25, 1x, i6)') 'posterior ensemble member', i
+ call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
+ endif
end do
@@ -1241,23 +1310,20 @@ end subroutine filter_initialize_modules_used
!-------------------------------------------------------------------------
subroutine filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, &
- input_qc_index, DART_qc_index)
+ input_qc_index, DART_qc_index, do_post)
type(obs_sequence_type), intent(inout) :: seq
integer, intent(out) :: in_obs_copy, obs_val_index
integer, intent(out) :: input_qc_index, DART_qc_index
+logical, intent(in) :: do_post
character(len=metadatalength) :: no_qc_meta_data = 'No incoming data QC'
character(len=metadatalength) :: dqc_meta_data = 'DART quality control'
character(len=129) :: obs_seq_read_format
-integer :: obs_seq_file_id, num_obs_copies
-integer :: tnum_copies, tnum_qc, tnum_obs, tmax_num_obs, qc_num_inc, num_qc
-logical :: pre_I_format
-
-! Determine the number of output obs space fields
-! 4 is for prior/posterior mean and spread,
-! Prior and posterior values for all selected fields (so times 2)
-num_obs_copies = 2 * num_output_obs_members + 4
+integer :: obs_seq_file_id, copies_num_inc, qc_num_inc
+integer :: tnum_copies, tnum_qc, tnum_obs, tmax_num_obs
+integer :: my_task, io_task
+logical :: pre_I_format
! Input file can have one qc field, none, or more. note that read_obs_seq_header
! does NOT return the actual metadata values, which would be helpful in trying
@@ -1265,18 +1331,53 @@ subroutine filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, &
call read_obs_seq_header(obs_sequence_in_name, tnum_copies, tnum_qc, tnum_obs, tmax_num_obs, &
obs_seq_file_id, obs_seq_read_format, pre_I_format, close_the_file = .true.)
+! return the original number of copies in the obs_seq file
+! before we add any copies for diagnostics.
+in_obs_copy = tnum_copies
+
+! FIXME: this should be called from inside obs_space_diagnostics the first
+! time that routine is called, so it has an ensemble handle to query for
+! exactly which task is pe0 (or use a different pe number). here we
+! have to assume task 0 == pe 0 which is currently true but someday
+! we would like to be able to change.
+io_task = 0
+my_task = my_task_id()
+
+! only the task writing the obs_seq.final file needs space for the
+! additional copies/qcs. for large numbers of individual members
+! in the final file this takes quite a bit of memory.
+
+if (my_task == io_task) then
+ ! Determine the number of output obs space fields
+ if (do_post) then
+ ! 4 is for prior/posterior mean and spread, plus
+ ! prior/posterior values for all requested members
+ copies_num_inc = 4 + (2 * num_output_obs_members)
+ else
+ ! 2 is for prior mean and spread, plus
+ ! prior values for all requested members
+ copies_num_inc = 2 + (1 * num_output_obs_members)
+ endif
+else
+ copies_num_inc = 0
+endif
! if there are less than 2 incoming qc fields, we will need
! to make at least 2 (one for the dummy data qc and one for
-! the dart qc).
+! the dart qc) on task 0. other tasks just need 1 for incoming qc.
if (tnum_qc < 2) then
- qc_num_inc = 2 - tnum_qc
+ if (my_task == io_task) then
+ qc_num_inc = 2 - tnum_qc
+ else
+ qc_num_inc = 1 - tnum_qc
+ endif
else
qc_num_inc = 0
endif
! Read in with enough space for diagnostic output values and add'l qc field(s)
-call read_obs_seq(obs_sequence_in_name, num_obs_copies, qc_num_inc, 0, seq)
+! ONLY ADD SPACE ON TASK 0. everyone else just read in the original obs_seq file.
+call read_obs_seq(obs_sequence_in_name, copies_num_inc, qc_num_inc, 0, seq)
! check to be sure that we have an incoming qc field. if not, look for
! a blank qc field
@@ -1298,9 +1399,9 @@ subroutine filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, &
endif
! check to be sure we either find an existing dart qc field and
-! reuse it, or we add a new one.
+! reuse it, or we add a new one. only on task 0.
DART_qc_index = get_obs_dartqc_index(seq)
-if (DART_qc_index < 0) then
+if (DART_qc_index < 0 .and. my_task == io_task) then
DART_qc_index = get_blank_qc_index(seq)
if (DART_qc_index < 0) then
! Need 1 new qc field for the DART quality control
@@ -1315,18 +1416,7 @@ subroutine filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, &
call set_qc_meta_data(seq, DART_qc_index, dqc_meta_data)
endif
-! Get num of obs copies and num_qc
-num_qc = get_num_qc(seq)
-in_obs_copy = get_num_copies(seq) - num_obs_copies
-
-! Create an observation type temporary for use in filter
-call init_obs(observation, get_num_copies(seq), num_qc)
-
-! Set initial DART quality control to 0 for all observations?
-! Or leave them uninitialized, since
-! obs_space_diagnostics should set them all without reading them
-
-! Determine which copy has actual obs
+! Determine which copy has actual obs value and return it.
obs_val_index = get_obs_copy_index(seq)
end subroutine filter_setup_obs_sequence
@@ -1540,7 +1630,7 @@ subroutine obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size,
obs_val_index, OBS_KEY_COPY, &
ens_mean_index, ens_spread_index, num_obs_in_set, &
OBS_MEAN_START, OBS_VAR_START, OBS_GLOBAL_QC_COPY, OBS_VAL_COPY, &
- OBS_ERR_VAR_COPY, DART_qc_index)
+ OBS_ERR_VAR_COPY, DART_qc_index, do_post)
! Do prior observation space diagnostics on the set of obs corresponding to keys
@@ -1556,9 +1646,10 @@ subroutine obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size,
integer, intent(in) :: OBS_MEAN_START, OBS_VAR_START
integer, intent(in) :: OBS_GLOBAL_QC_COPY, OBS_VAL_COPY
integer, intent(in) :: OBS_ERR_VAR_COPY, DART_qc_index
+logical, intent(in) :: do_post
-integer :: j, k, ens_offset
-integer :: ivalue
+integer :: j, k, ens_offset, copy_factor
+integer :: ivalue, io_task, my_task
real(r8), allocatable :: obs_temp(:)
real(r8) :: rvalue(1)
@@ -1575,34 +1666,40 @@ subroutine obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size,
OBS_ERR_VAR_COPY, DART_qc_index, PRIOR_DIAG)
endif
+! this is a query routine to return which task has
+! logical processing element 0 in this ensemble.
+io_task = map_pe_to_task(obs_fwd_op_ens_handle, 0)
+my_task = my_task_id()
+
+! single value per member if no posterior, else 2
+if (do_post) then
+ copy_factor = 2
+else
+ copy_factor = 1
+endif
! Make var complete for get_copy() calls below.
-! Can you use a gather instead of a transpose and get copy?
+! Optimize: Could we use a gather instead of a transpose and get copy?
call all_copies_to_all_vars(obs_fwd_op_ens_handle)
-! allocate temp space for sending data - surely only task 0 needs to allocate this?
-allocate(obs_temp(num_obs_in_set))
+! allocate temp space for sending data only on the task that will
+! write the obs_seq.final file
+if (my_task == io_task) allocate(obs_temp(num_obs_in_set))
+
! Update the ensemble mean
-! Get this copy to process 0
-call get_copy(map_task_to_pe(obs_fwd_op_ens_handle, 0), obs_fwd_op_ens_handle, OBS_MEAN_START, obs_temp)
-! Only pe 0 gets to write the sequence
-if(my_task_id() == 0) then
- ! Loop through the observations for this time
- do j = 1, obs_fwd_op_ens_handle%num_vars
+call get_copy(io_task, obs_fwd_op_ens_handle, OBS_MEAN_START, obs_temp)
+if(my_task == io_task) then
+ do j = 1, obs_fwd_op_ens_handle%num_vars
rvalue(1) = obs_temp(j)
call replace_obs_values(seq, keys(j), rvalue, ens_mean_index)
end do
endif
! Update the ensemble spread
-! Get this copy to process 0
-call get_copy(map_task_to_pe(obs_fwd_op_ens_handle, 0), obs_fwd_op_ens_handle, OBS_VAR_START, obs_temp)
-! Only pe 0 gets to write the sequence
-if(my_task_id() == 0) then
- ! Loop through the observations for this time
+call get_copy(io_task, obs_fwd_op_ens_handle, OBS_VAR_START, obs_temp)
+if(my_task == io_task) then
do j = 1, obs_fwd_op_ens_handle%num_vars
- ! update the spread in each obs
if (obs_temp(j) /= missing_r8) then
rvalue(1) = sqrt(obs_temp(j))
else
@@ -1612,38 +1709,29 @@ subroutine obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size,
end do
endif
-! May be possible to only do this after the posterior call...
! Update any requested ensemble members
-ens_offset = members_index + 4
-! Update all of these ensembles that are required to sequence file
+ens_offset = members_index + 2*copy_factor
do k = 1, num_output_members
- ! Get this copy on pe 0
- call get_copy(map_task_to_pe(obs_fwd_op_ens_handle, 0), obs_fwd_op_ens_handle, k, obs_temp)
- ! Only task 0 gets to write the sequence
- if(my_task_id() == 0) then
- ! Loop through the observations for this time
+ call get_copy(io_task, obs_fwd_op_ens_handle, k, obs_temp)
+ if(my_task == io_task) then
+ ivalue = ens_offset + copy_factor * (k - 1)
do j = 1, obs_fwd_op_ens_handle%num_vars
- ! update the obs values
rvalue(1) = obs_temp(j)
- ivalue = ens_offset + 2 * (k - 1)
call replace_obs_values(seq, keys(j), rvalue, ivalue)
end do
endif
end do
! Update the qc global value
-call get_copy(map_task_to_pe(obs_fwd_op_ens_handle, 0), obs_fwd_op_ens_handle, OBS_GLOBAL_QC_COPY, obs_temp)
-! Only task 0 gets to write the observations for this time
-if(my_task_id() == 0) then
- ! Loop through the observations for this time
+call get_copy(io_task, obs_fwd_op_ens_handle, OBS_GLOBAL_QC_COPY, obs_temp)
+if(my_task == io_task) then
do j = 1, obs_fwd_op_ens_handle%num_vars
rvalue(1) = obs_temp(j)
call replace_qc(seq, keys(j), rvalue, DART_qc_index)
end do
endif
-! clean up.
-deallocate(obs_temp)
+if (my_task == io_task) deallocate(obs_temp)
end subroutine obs_space_diagnostics
@@ -1802,6 +1890,67 @@ subroutine timestamp_message(msg, sync)
end subroutine timestamp_message
+!-------------------------------------------------------------------------
+!> call progress(string, T_BEFORE, P_TIME, label, threshold, sync) ! trace plus timestamp
+!-------------------------------------------------------------------------
+
+subroutine progress(msg, when, dotime, label, threshold, sync) ! trace plus timestamp
+
+character(len=*), intent(in) :: msg
+integer, intent(in) :: when
+logical, intent(in) :: dotime
+character(len=*), intent(in), optional :: label
+integer, intent(in), optional :: threshold
+logical, intent(in), optional :: sync
+
+! Write message to stdout and log file.
+! optionally write timestamp.
+integer :: t, lastchar
+character(len=40) :: label_to_use
+
+t = 0
+if (present(threshold)) t = threshold
+
+if (trace_level <= t) return
+
+if (.not. do_output()) return
+
+if (present(label)) then
+ lastchar = min(len_trim(label), len(label_to_use))
+ label_to_use = label(1:lastchar)
+else
+ label_to_use = ' filter_trace: '
+endif
+
+select case (when)
+ case (T_BEFORE)
+ call error_handler(E_MSG, trim(label_to_use)//' Before ', trim(msg))
+ case (T_AFTER)
+ call error_handler(E_MSG, trim(label_to_use)//' After ', trim(msg))
+ case default
+ call error_handler(E_MSG, trim(label_to_use), trim(msg))
+end select
+
+if (timestamp_level <= 0) return
+
+! if sync is present and true, sync mpi jobs before printing time.
+if (present(sync)) then
+ if (sync) call task_sync()
+endif
+
+if (do_output()) then
+ select case (when)
+ case (T_BEFORE)
+ call timestamp(' Before '//trim(msg), pos='brief')
+ case (T_AFTER)
+ call timestamp(' After '//trim(msg), pos='brief')
+ case default
+ call timestamp(' '//trim(msg), pos='brief')
+ end select
+endif
+
+end subroutine progress
+
!-------------------------------------------------------------------------
subroutine print_ens_time(ens_handle, msg)
@@ -2412,8 +2561,7 @@ subroutine initialize_file_information(ncopies, &
type(file_info_type), intent(out) :: file_info_analysis
type(file_info_type), intent(out) :: file_info_output
-integer :: noutput_members, next_file, ninput_files, noutput_files, ndomains, idom
-character(len=64) :: fsource
+integer :: noutput_members, ninput_files, noutput_files, ndomains
character(len=256), allocatable :: file_array_input(:,:), file_array_output(:,:)
! local variable to shorten the name for function input
@@ -2616,8 +2764,9 @@ subroutine update_observations_radar(obs_ens_handle, ens_size, seq, keys, prior_
use obs_kind_mod, only : DOPPLER_RADIAL_VELOCITY
use obs_def_radar_mod, only : get_obs_def_radial_vel
use location_mod, only : location_type
-use ensemble_manager_mod, only : ensemble_type, all_copies_to_all_vars, &
- all_vars_to_all_copies, broadcast_copy
+use ensemble_manager_mod, only : ensemble_type, get_my_num_copies, &
+ all_copies_to_all_vars, all_vars_to_all_copies, &
+ get_copy_owner_index, broadcast_copy
use mpi_utilities_mod, only : my_task_id !, broadcast_send, broadcast_recv
diff --git a/assimilation_code/modules/assimilation/filter_mod.f90 b/assimilation_code/modules/assimilation/filter_mod.f90
index 71b6a2c656..2c7a943949 100644
--- a/assimilation_code/modules/assimilation/filter_mod.f90
+++ b/assimilation_code/modules/assimilation/filter_mod.f90
@@ -48,7 +48,7 @@ module filter_mod
compute_copy_mean, compute_copy_mean_sd, &
compute_copy_mean_var, duplicate_ens, get_copy_owner_index, &
get_ensemble_time, set_ensemble_time, broadcast_copy, &
- map_task_to_pe, map_pe_to_task, prepare_to_update_copies, &
+ map_pe_to_task, prepare_to_update_copies, &
copies_in_window, set_num_extra_copies, get_allow_transpose, &
all_copies_to_all_vars, allocate_single_copy, allocate_vars, &
get_single_copy, put_single_copy, deallocate_single_copy, &
@@ -108,9 +108,8 @@ module filter_mod
! Some convenient global storage items
character(len=512) :: msgstring
-type(obs_type) :: observation
-integer :: trace_level, timestamp_level
+integer :: trace_level, timestamp_level
! Defining whether diagnostics are for prior or posterior
integer, parameter :: PRIOR_DIAG = 0, POSTERIOR_DIAG = 2
@@ -159,6 +158,12 @@ module filter_mod
logical :: has_cycling = .false. ! filter will advance the model
+! parms for trace/timing messages
+integer, parameter :: T_BEFORE = 1
+integer, parameter :: T_AFTER = 2
+integer, parameter :: T_NEITHER = 3
+logical, parameter :: P_TIME = .true.
+
!----------------------------------------------------------------
! Namelist input with default values
!
@@ -201,8 +206,11 @@ module filter_mod
logical :: perturb_from_single_instance = .false.
real(r8) :: perturbation_amplitude = 0.2_r8
! File options. Single vs. Multiple. really 'unified' or 'combination' vs 'individual'
-logical :: single_file_in = .false. ! all copies read from 1 file
-logical :: single_file_out = .false. ! all copies written to 1 file
+logical :: single_file_in = .false. ! all copies read from 1 file
+logical :: single_file_out = .false. ! all copies written to 1 file
+
+! optimization option:
+logical :: compute_posterior = .true. ! set to false to not compute posterior values
! Stages to write. Valid values are:
! multi-file: input, forecast, preassim, postassim, analysis, output
@@ -289,6 +297,7 @@ module filter_mod
single_file_out, &
perturb_from_single_instance, &
perturbation_amplitude, &
+ compute_posterior, &
stages_to_write, &
input_state_files, &
output_state_files, &
@@ -321,7 +330,7 @@ subroutine filter_main()
integer, allocatable :: keys(:)
integer(i8) :: model_size
-integer :: i, iunit, io, time_step_number, num_obs_in_set, ntimes
+integer :: iunit, io, time_step_number, num_obs_in_set, ntimes
integer :: last_key_used, key_bounds(2)
integer :: in_obs_copy, obs_val_index
integer :: prior_obs_mean_index, posterior_obs_mean_index
@@ -390,7 +399,7 @@ subroutine filter_main()
call validate_inflate_options(inf_flavor, inf_damping, inf_initial_from_restart, &
inf_sd_initial_from_restart, inf_deterministic, inf_sd_max_change, &
- do_prior_inflate, do_posterior_inflate, output_inflation)
+ do_prior_inflate, do_posterior_inflate, output_inflation, compute_posterior)
! Initialize the adaptive inflation module
call adaptive_inflate_init(prior_inflate, inf_flavor(1), inf_initial_from_restart(1), &
@@ -458,11 +467,27 @@ subroutine filter_main()
TOTAL_OBS_COPIES = ens_size + 5 + 2*num_groups
+!>@todo FIXME turn trace/timestamp calls into:
+!>
+!> integer, parameter :: T_BEFORE = 1
+!> integer, parameter :: T_AFTER = 2
+!> integer, parameter :: P_TIME = 1
+!>
+!> call progress(string, T_BEFORE) ! simple trace msg
+!> call progress(string, T_AFTER)
+!>
+!> call progress(string, T_BEFORE, P_TIME) ! trace plus timestamp
+!> call progress(string, T_AFTER, P_TIME)
+
+!> DO NOT timestamp every trace message because some are
+!> so quick that the timestamps don't impart any info.
+!> we should be careful to timestamp logical *sections* instead.
+
call trace_message('Before setting up space for observations')
call timestamp_message('Before setting up space for observations')
! Initialize the obs_sequence; every pe gets a copy for now
-call filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, input_qc_index, DART_qc_index)
+call filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, input_qc_index, DART_qc_index, compute_posterior)
call timestamp_message('After setting up space for observations')
call trace_message('After setting up space for observations')
@@ -474,17 +499,31 @@ subroutine filter_main()
if(distributed_state) then
call init_ensemble_manager(state_ens_handle, num_state_ens_copies, model_size)
+ msgstring = 'running with distributed state; model states stay distributed across all tasks for the entire run'
else
call init_ensemble_manager(state_ens_handle, num_state_ens_copies, model_size, transpose_type_in = 2)
+ msgstring = 'running without distributed state; model states are gathered by ensemble for forward operators'
endif
+! don't print if running single task. transposes don't matter in this case.
+if (task_count() > 1) &
+ call error_handler(E_MSG,'filter_main:', msgstring, source, revision, revdate)
call set_num_extra_copies(state_ens_handle, num_extras)
call trace_message('After setting up space for ensembles')
! Don't currently support number of processes > model_size
-if(task_count() > model_size) call error_handler(E_ERR,'filter_main', &
- 'Number of processes > model size' ,source,revision,revdate)
+if(task_count() > model_size) then
+ write(msgstring, *) 'number of MPI processes = ', task_count(), ' while model size = ', model_size
+ call error_handler(E_ERR,'filter_main', &
+ 'Cannot have number of processes > model size' ,source,revision,revdate, &
+ text2=msgstring)
+endif
+
+if(.not. compute_posterior) then
+ msgstring = 'skipping computation of posterior forward operators'
+ call error_handler(E_MSG,'filter_main:', msgstring, source, revision, revdate)
+endif
! Set a time type for initial time if namelist inputs are not negative
call filter_set_initial_time(init_time_days, init_time_seconds, time1, read_time_from_file)
@@ -548,7 +587,8 @@ subroutine filter_main()
! Initialize the output sequences and state files and set their meta data
call filter_generate_copy_meta_data(seq, in_obs_copy, &
prior_obs_mean_index, posterior_obs_mean_index, &
- prior_obs_spread_index, posterior_obs_spread_index)
+ prior_obs_spread_index, posterior_obs_spread_index, &
+ compute_posterior)
if(ds) call error_handler(E_ERR, 'filter', 'smoother broken by Helen')
if(ds) call smoother_gen_copy_meta_data(num_output_state_members, output_inflation=.true.) !> @todo fudge
@@ -837,14 +877,10 @@ subroutine filter_main()
obs_val_index, OBS_KEY_COPY, & ! new
prior_obs_mean_index, prior_obs_spread_index, num_obs_in_set, &
OBS_MEAN_START, OBS_VAR_START, OBS_GLOBAL_QC_COPY, &
- OBS_VAL_COPY, OBS_ERR_VAR_COPY, DART_qc_index)
+ OBS_VAL_COPY, OBS_ERR_VAR_COPY, DART_qc_index, compute_posterior)
call trace_message('After observation space diagnostics')
- ! FIXME: i believe both copies and vars are equal at the end
- ! of the obs_space diags, so we can skip this.
- !call all_vars_to_all_copies(obs_fwd_op_ens_handle)
-
write(msgstring, '(A,I8,A)') 'Ready to assimilate up to', size(keys), ' observations'
call trace_message(msgstring, 'filter:', -1)
@@ -948,43 +984,47 @@ subroutine filter_main()
! this block recomputes the expected obs values for the obs_seq.final file
- call trace_message('Before computing posterior observation values')
- call timestamp_message('Before computing posterior observation values')
-
- ! Compute the ensemble of posterior observations, load up the obs_err_var
- ! and obs_values. ens_size is the number of regular ensemble members,
- ! not the number of copies
-
- call get_obs_ens_distrib_state(state_ens_handle, obs_fwd_op_ens_handle, qc_ens_handle, &
- seq, keys, obs_val_index, input_qc_index, &
- OBS_ERR_VAR_COPY, OBS_VAL_COPY, OBS_KEY_COPY, OBS_GLOBAL_QC_COPY, OBS_EXTRA_QC_COPY, &
- OBS_MEAN_START, OBS_VAR_START, isprior=.false., prior_qc_copy=prior_qc_copy)
-
- call deallocate_single_copy(obs_fwd_op_ens_handle, prior_qc_copy)
-
- call timestamp_message('After computing posterior observation values')
- call trace_message('After computing posterior observation values')
-
- if(ds) then
- call trace_message('Before computing smoother means/spread')
- call smoother_mean_spread(ens_size, ENS_MEAN_COPY, ENS_SD_COPY)
- call trace_message('After computing smoother means/spread')
+ if (compute_posterior) then
+ call trace_message('Before computing posterior observation values')
+ call timestamp_message('Before computing posterior observation values')
+
+ ! Compute the ensemble of posterior observations, load up the obs_err_var
+ ! and obs_values. ens_size is the number of regular ensemble members,
+ ! not the number of copies
+
+ call get_obs_ens_distrib_state(state_ens_handle, obs_fwd_op_ens_handle, qc_ens_handle, &
+ seq, keys, obs_val_index, input_qc_index, &
+ OBS_ERR_VAR_COPY, OBS_VAL_COPY, OBS_KEY_COPY, OBS_GLOBAL_QC_COPY, OBS_EXTRA_QC_COPY, &
+ OBS_MEAN_START, OBS_VAR_START, isprior=.false., prior_qc_copy=prior_qc_copy)
+
+ call deallocate_single_copy(obs_fwd_op_ens_handle, prior_qc_copy)
+
+ call timestamp_message('After computing posterior observation values')
+ call trace_message('After computing posterior observation values')
+
+ if(ds) then
+ call trace_message('Before computing smoother means/spread')
+ call smoother_mean_spread(ens_size, ENS_MEAN_COPY, ENS_SD_COPY)
+ call trace_message('After computing smoother means/spread')
+ endif
+
+ call trace_message('Before posterior obs space diagnostics')
+
+ ! Write posterior observation space diagnostics
+ ! There is a transpose (all_copies_to_all_vars(obs_fwd_op_ens_handle)) in obs_space_diagnostics
+ call obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size, &
+ seq, keys, POSTERIOR_DIAG, num_output_obs_members, in_obs_copy+2, &
+ obs_val_index, OBS_KEY_COPY, & ! new
+ posterior_obs_mean_index, posterior_obs_spread_index, num_obs_in_set, &
+ OBS_MEAN_START, OBS_VAR_START, OBS_GLOBAL_QC_COPY, &
+ OBS_VAL_COPY, OBS_ERR_VAR_COPY, DART_qc_index, compute_posterior)
+
+
+ call trace_message('After posterior obs space diagnostics')
+ else
+ call deallocate_single_copy(obs_fwd_op_ens_handle, prior_qc_copy)
endif
- call trace_message('Before posterior obs space diagnostics')
-
- ! Write posterior observation space diagnostics
- ! There is a transpose (all_copies_to_all_vars(obs_fwd_op_ens_handle)) in obs_space_diagnostics
- call obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size, &
- seq, keys, POSTERIOR_DIAG, num_output_obs_members, in_obs_copy+2, &
- obs_val_index, OBS_KEY_COPY, & ! new
- posterior_obs_mean_index, posterior_obs_spread_index, num_obs_in_set, &
- OBS_MEAN_START, OBS_VAR_START, OBS_GLOBAL_QC_COPY, &
- OBS_VAL_COPY, OBS_ERR_VAR_COPY, DART_qc_index)
-
-
- call trace_message('After posterior obs space diagnostics')
-
! this block computes the adaptive state space posterior inflation
! (it was applied earlier, this is computing the updated values for
! the next cycle.)
@@ -1042,13 +1082,15 @@ subroutine filter_main()
endif
! only intended for debugging when cycling inside filter.
- ! writing the obs_seq file can be slow - but if filter crashes
+ ! writing the obs_seq file here will be slow - but if filter crashes
! you can get partial results by enabling this flag.
if (write_obs_every_cycle) then
- call trace_message('Before writing in-progress output sequence file')
+ call trace_message('Before writing in-progress output sequence file')
+ call timestamp_message('Before writing in-progress output sequence file')
! Only pe 0 outputs the observation space diagnostic file
if(my_task_id() == 0) call write_obs_seq(seq, obs_sequence_out_name)
- call trace_message('After writing in-progress output sequence file')
+ call timestamp_message('After writing in-progress output sequence file')
+ call trace_message('After writing in-progress output sequence file')
endif
call trace_message('Near bottom of main loop, cleaning up obs space')
@@ -1085,10 +1127,12 @@ subroutine filter_main()
endif
-call trace_message('Before writing output sequence file')
+call trace_message('Before writing output sequence file')
+call timestamp_message('Before writing output sequence file')
! Only pe 0 outputs the observation space diagnostic file
if(my_task_id() == 0) call write_obs_seq(seq, obs_sequence_out_name)
-call trace_message('After writing output sequence file')
+call timestamp_message('After writing output sequence file')
+call trace_message('After writing output sequence file')
! Output all restart files if requested
if (write_all_stages_at_end) then
@@ -1132,8 +1176,7 @@ subroutine filter_main()
call trace_message('Before ensemble and obs memory cleanup')
call end_ensemble_manager(state_ens_handle)
-! Free up the observation kind and obs sequence
-call destroy_obs(observation)
+! Free up the obs sequence
call destroy_obs_sequence(seq)
call trace_message('After ensemble and obs memory cleanup')
@@ -1160,12 +1203,14 @@ end subroutine filter_main
!> in the ensemble handle.
subroutine filter_generate_copy_meta_data(seq, in_obs_copy, &
prior_obs_mean_index, posterior_obs_mean_index, &
- prior_obs_spread_index, posterior_obs_spread_index)
+ prior_obs_spread_index, posterior_obs_spread_index, &
+ do_post)
type(obs_sequence_type), intent(inout) :: seq
integer, intent(in) :: in_obs_copy
integer, intent(out) :: prior_obs_mean_index, posterior_obs_mean_index
integer, intent(out) :: prior_obs_spread_index, posterior_obs_spread_index
+logical, intent(in) :: do_post
! Figures out the strings describing the output copies for the three output files.
! THese are the prior and posterior state output files and the observation sequence
@@ -1174,30 +1219,52 @@ subroutine filter_generate_copy_meta_data(seq, in_obs_copy, &
character(len=metadatalength) :: prior_meta_data, posterior_meta_data
integer :: i, num_obs_copies
+! only PE0 (here task 0) will allocate space for the obs_seq.final
+!
+! all other tasks should NOT allocate all this space.
+! instead, set the copy numbers to an illegal value
+! so we'll trap if they're used, and return early.
+if (my_task_id() /= 0) then
+ prior_obs_mean_index = -1
+ posterior_obs_mean_index = -1
+ prior_obs_spread_index = -1
+ posterior_obs_spread_index = -1
+ return
+endif
+
! Set the metadata for the observations.
! Set up obs ensemble mean
num_obs_copies = in_obs_copy
+
num_obs_copies = num_obs_copies + 1
prior_meta_data = 'prior ensemble mean'
call set_copy_meta_data(seq, num_obs_copies, prior_meta_data)
prior_obs_mean_index = num_obs_copies
-num_obs_copies = num_obs_copies + 1
-posterior_meta_data = 'posterior ensemble mean'
-call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
-posterior_obs_mean_index = num_obs_copies
+
+if (do_post) then
+ num_obs_copies = num_obs_copies + 1
+ posterior_meta_data = 'posterior ensemble mean'
+ call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
+ posterior_obs_mean_index = num_obs_copies
+endif
! Set up obs ensemble spread
num_obs_copies = num_obs_copies + 1
prior_meta_data = 'prior ensemble spread'
call set_copy_meta_data(seq, num_obs_copies, prior_meta_data)
prior_obs_spread_index = num_obs_copies
-num_obs_copies = num_obs_copies + 1
-posterior_meta_data = 'posterior ensemble spread'
-call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
-posterior_obs_spread_index = num_obs_copies
-! Make sure there are not too many copies requested
+if (do_post) then
+ num_obs_copies = num_obs_copies + 1
+ posterior_meta_data = 'posterior ensemble spread'
+ call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
+ posterior_obs_spread_index = num_obs_copies
+endif
+
+! Make sure there are not too many copies requested -
+! proposed: make this magic number set in 1 place with an accessor
+! routine so all parts of the code agree on max values.
if(num_output_obs_members > 10000) then
write(msgstring, *)'output metadata in filter needs obs ensemble size < 10000, not ',&
num_output_obs_members
@@ -1206,12 +1273,14 @@ subroutine filter_generate_copy_meta_data(seq, in_obs_copy, &
! Set up obs ensemble members as requested
do i = 1, num_output_obs_members
- write(prior_meta_data, '(a21, 1x, i6)') 'prior ensemble member', i
- write(posterior_meta_data, '(a25, 1x, i6)') 'posterior ensemble member', i
num_obs_copies = num_obs_copies + 1
+ write(prior_meta_data, '(a21, 1x, i6)') 'prior ensemble member', i
call set_copy_meta_data(seq, num_obs_copies, prior_meta_data)
- num_obs_copies = num_obs_copies + 1
- call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
+ if (do_post) then
+ num_obs_copies = num_obs_copies + 1
+ write(posterior_meta_data, '(a25, 1x, i6)') 'posterior ensemble member', i
+ call set_copy_meta_data(seq, num_obs_copies, posterior_meta_data)
+ endif
end do
@@ -1238,23 +1307,20 @@ end subroutine filter_initialize_modules_used
!-------------------------------------------------------------------------
subroutine filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, &
- input_qc_index, DART_qc_index)
+ input_qc_index, DART_qc_index, do_post)
type(obs_sequence_type), intent(inout) :: seq
integer, intent(out) :: in_obs_copy, obs_val_index
integer, intent(out) :: input_qc_index, DART_qc_index
+logical, intent(in) :: do_post
character(len=metadatalength) :: no_qc_meta_data = 'No incoming data QC'
character(len=metadatalength) :: dqc_meta_data = 'DART quality control'
character(len=129) :: obs_seq_read_format
-integer :: obs_seq_file_id, num_obs_copies
-integer :: tnum_copies, tnum_qc, tnum_obs, tmax_num_obs, qc_num_inc, num_qc
-logical :: pre_I_format
-
-! Determine the number of output obs space fields
-! 4 is for prior/posterior mean and spread,
-! Prior and posterior values for all selected fields (so times 2)
-num_obs_copies = 2 * num_output_obs_members + 4
+integer :: obs_seq_file_id, copies_num_inc, qc_num_inc
+integer :: tnum_copies, tnum_qc, tnum_obs, tmax_num_obs
+integer :: my_task, io_task
+logical :: pre_I_format
! Input file can have one qc field, none, or more. note that read_obs_seq_header
! does NOT return the actual metadata values, which would be helpful in trying
@@ -1262,18 +1328,53 @@ subroutine filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, &
call read_obs_seq_header(obs_sequence_in_name, tnum_copies, tnum_qc, tnum_obs, tmax_num_obs, &
obs_seq_file_id, obs_seq_read_format, pre_I_format, close_the_file = .true.)
+! return the original number of copies in the obs_seq file
+! before we add any copies for diagnostics.
+in_obs_copy = tnum_copies
+
+! FIXME: this should be called from inside obs_space_diagnostics the first
+! time that routine is called, so it has an ensemble handle to query for
+! exactly which task is pe0 (or use a different pe number). here we
+! have to assume task 0 == pe 0 which is currently true but someday
+! we would like to be able to change.
+io_task = 0
+my_task = my_task_id()
+
+! only the task writing the obs_seq.final file needs space for the
+! additional copies/qcs. for large numbers of individual members
+! in the final file this takes quite a bit of memory.
+
+if (my_task == io_task) then
+ ! Determine the number of output obs space fields
+ if (do_post) then
+ ! 4 is for prior/posterior mean and spread, plus
+ ! prior/posterior values for all requested members
+ copies_num_inc = 4 + (2 * num_output_obs_members)
+ else
+ ! 2 is for prior mean and spread, plus
+ ! prior values for all requested members
+ copies_num_inc = 2 + (1 * num_output_obs_members)
+ endif
+else
+ copies_num_inc = 0
+endif
! if there are less than 2 incoming qc fields, we will need
! to make at least 2 (one for the dummy data qc and one for
-! the dart qc).
+! the dart qc) on task 0. other tasks just need 1 for incoming qc.
if (tnum_qc < 2) then
- qc_num_inc = 2 - tnum_qc
+ if (my_task == io_task) then
+ qc_num_inc = 2 - tnum_qc
+ else
+ qc_num_inc = 1 - tnum_qc
+ endif
else
qc_num_inc = 0
endif
! Read in with enough space for diagnostic output values and add'l qc field(s)
-call read_obs_seq(obs_sequence_in_name, num_obs_copies, qc_num_inc, 0, seq)
+! ONLY ADD SPACE ON TASK 0. everyone else just read in the original obs_seq file.
+call read_obs_seq(obs_sequence_in_name, copies_num_inc, qc_num_inc, 0, seq)
! check to be sure that we have an incoming qc field. if not, look for
! a blank qc field
@@ -1295,9 +1396,9 @@ subroutine filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, &
endif
! check to be sure we either find an existing dart qc field and
-! reuse it, or we add a new one.
+! reuse it, or we add a new one. only on task 0.
DART_qc_index = get_obs_dartqc_index(seq)
-if (DART_qc_index < 0) then
+if (DART_qc_index < 0 .and. my_task == io_task) then
DART_qc_index = get_blank_qc_index(seq)
if (DART_qc_index < 0) then
! Need 1 new qc field for the DART quality control
@@ -1312,18 +1413,7 @@ subroutine filter_setup_obs_sequence(seq, in_obs_copy, obs_val_index, &
call set_qc_meta_data(seq, DART_qc_index, dqc_meta_data)
endif
-! Get num of obs copies and num_qc
-num_qc = get_num_qc(seq)
-in_obs_copy = get_num_copies(seq) - num_obs_copies
-
-! Create an observation type temporary for use in filter
-call init_obs(observation, get_num_copies(seq), num_qc)
-
-! Set initial DART quality control to 0 for all observations?
-! Or leave them uninitialized, since
-! obs_space_diagnostics should set them all without reading them
-
-! Determine which copy has actual obs
+! Determine which copy has actual obs value and return it.
obs_val_index = get_obs_copy_index(seq)
end subroutine filter_setup_obs_sequence
@@ -1537,7 +1627,7 @@ subroutine obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size,
obs_val_index, OBS_KEY_COPY, &
ens_mean_index, ens_spread_index, num_obs_in_set, &
OBS_MEAN_START, OBS_VAR_START, OBS_GLOBAL_QC_COPY, OBS_VAL_COPY, &
- OBS_ERR_VAR_COPY, DART_qc_index)
+ OBS_ERR_VAR_COPY, DART_qc_index, do_post)
! Do prior observation space diagnostics on the set of obs corresponding to keys
@@ -1553,42 +1643,50 @@ subroutine obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size,
integer, intent(in) :: OBS_MEAN_START, OBS_VAR_START
integer, intent(in) :: OBS_GLOBAL_QC_COPY, OBS_VAL_COPY
integer, intent(in) :: OBS_ERR_VAR_COPY, DART_qc_index
+logical, intent(in) :: do_post
-integer :: j, k, ens_offset
-integer :: ivalue
+integer :: j, k, ens_offset, copy_factor
+integer :: ivalue, io_task, my_task
real(r8), allocatable :: obs_temp(:)
real(r8) :: rvalue(1)
! Do verbose forward operator output if requested
if(output_forward_op_errors) call verbose_forward_op_output(qc_ens_handle, prior_post, ens_size, keys)
+! this is a query routine to return which task has
+! logical processing element 0 in this ensemble.
+io_task = map_pe_to_task(obs_fwd_op_ens_handle, 0)
+my_task = my_task_id()
+
+! single value per member if no posterior, else 2
+if (do_post) then
+ copy_factor = 2
+else
+ copy_factor = 1
+endif
+
! Make var complete for get_copy() calls below.
-! Can you use a gather instead of a transpose and get copy?
+! Optimize: Could we use a gather instead of a transpose and get copy?
call all_copies_to_all_vars(obs_fwd_op_ens_handle)
-! allocate temp space for sending data - surely only task 0 needs to allocate this?
-allocate(obs_temp(num_obs_in_set))
+! allocate temp space for sending data only on the task that will
+! write the obs_seq.final file
+if (my_task == io_task) allocate(obs_temp(num_obs_in_set))
+
! Update the ensemble mean
-! Get this copy to process 0
-call get_copy(map_task_to_pe(obs_fwd_op_ens_handle, 0), obs_fwd_op_ens_handle, OBS_MEAN_START, obs_temp)
-! Only pe 0 gets to write the sequence
-if(my_task_id() == 0) then
- ! Loop through the observations for this time
- do j = 1, obs_fwd_op_ens_handle%num_vars
+call get_copy(io_task, obs_fwd_op_ens_handle, OBS_MEAN_START, obs_temp)
+if(my_task == io_task) then
+ do j = 1, obs_fwd_op_ens_handle%num_vars
rvalue(1) = obs_temp(j)
call replace_obs_values(seq, keys(j), rvalue, ens_mean_index)
end do
endif
! Update the ensemble spread
-! Get this copy to process 0
-call get_copy(map_task_to_pe(obs_fwd_op_ens_handle, 0), obs_fwd_op_ens_handle, OBS_VAR_START, obs_temp)
-! Only pe 0 gets to write the sequence
-if(my_task_id() == 0) then
- ! Loop through the observations for this time
+call get_copy(io_task, obs_fwd_op_ens_handle, OBS_VAR_START, obs_temp)
+if(my_task == io_task) then
do j = 1, obs_fwd_op_ens_handle%num_vars
- ! update the spread in each obs
if (obs_temp(j) /= missing_r8) then
rvalue(1) = sqrt(obs_temp(j))
else
@@ -1598,38 +1696,29 @@ subroutine obs_space_diagnostics(obs_fwd_op_ens_handle, qc_ens_handle, ens_size,
end do
endif
-! May be possible to only do this after the posterior call...
! Update any requested ensemble members
-ens_offset = members_index + 4
-! Update all of these ensembles that are required to sequence file
+ens_offset = members_index + 2*copy_factor
do k = 1, num_output_members
- ! Get this copy on pe 0
- call get_copy(map_task_to_pe(obs_fwd_op_ens_handle, 0), obs_fwd_op_ens_handle, k, obs_temp)
- ! Only task 0 gets to write the sequence
- if(my_task_id() == 0) then
- ! Loop through the observations for this time
+ call get_copy(io_task, obs_fwd_op_ens_handle, k, obs_temp)
+ if(my_task == io_task) then
+ ivalue = ens_offset + copy_factor * (k - 1)
do j = 1, obs_fwd_op_ens_handle%num_vars
- ! update the obs values
rvalue(1) = obs_temp(j)
- ivalue = ens_offset + 2 * (k - 1)
call replace_obs_values(seq, keys(j), rvalue, ivalue)
end do
endif
end do
! Update the qc global value
-call get_copy(map_task_to_pe(obs_fwd_op_ens_handle, 0), obs_fwd_op_ens_handle, OBS_GLOBAL_QC_COPY, obs_temp)
-! Only task 0 gets to write the observations for this time
-if(my_task_id() == 0) then
- ! Loop through the observations for this time
+call get_copy(io_task, obs_fwd_op_ens_handle, OBS_GLOBAL_QC_COPY, obs_temp)
+if(my_task == io_task) then
do j = 1, obs_fwd_op_ens_handle%num_vars
rvalue(1) = obs_temp(j)
call replace_qc(seq, keys(j), rvalue, DART_qc_index)
end do
endif
-! clean up.
-deallocate(obs_temp)
+if (my_task == io_task) deallocate(obs_temp)
end subroutine obs_space_diagnostics
@@ -1788,6 +1877,67 @@ subroutine timestamp_message(msg, sync)
end subroutine timestamp_message
+!-------------------------------------------------------------------------
+!> call progress(string, T_BEFORE, P_TIME, label, threshold, sync) ! trace plus timestamp
+!-------------------------------------------------------------------------
+
+subroutine progress(msg, when, dotime, label, threshold, sync) ! trace plus timestamp
+
+character(len=*), intent(in) :: msg
+integer, intent(in) :: when
+logical, intent(in) :: dotime
+character(len=*), intent(in), optional :: label
+integer, intent(in), optional :: threshold
+logical, intent(in), optional :: sync
+
+! Write message to stdout and log file.
+! optionally write timestamp.
+integer :: t, lastchar
+character(len=40) :: label_to_use
+
+t = 0
+if (present(threshold)) t = threshold
+
+if (trace_level <= t) return
+
+if (.not. do_output()) return
+
+if (present(label)) then
+ lastchar = min(len_trim(label), len(label_to_use))
+ label_to_use = label(1:lastchar)
+else
+ label_to_use = ' filter_trace: '
+endif
+
+select case (when)
+ case (T_BEFORE)
+ call error_handler(E_MSG, trim(label_to_use)//' Before ', trim(msg))
+ case (T_AFTER)
+ call error_handler(E_MSG, trim(label_to_use)//' After ', trim(msg))
+ case default
+ call error_handler(E_MSG, trim(label_to_use), trim(msg))
+end select
+
+if (timestamp_level <= 0) return
+
+! if sync is present and true, sync mpi jobs before printing time.
+if (present(sync)) then
+ if (sync) call task_sync()
+endif
+
+if (do_output()) then
+ select case (when)
+ case (T_BEFORE)
+ call timestamp(' Before '//trim(msg), pos='brief')
+ case (T_AFTER)
+ call timestamp(' After '//trim(msg), pos='brief')
+ case default
+ call timestamp(' '//trim(msg), pos='brief')
+ end select
+endif
+
+end subroutine progress
+
!-------------------------------------------------------------------------
subroutine print_ens_time(ens_handle, msg)
@@ -2398,8 +2548,7 @@ subroutine initialize_file_information(ncopies, &
type(file_info_type), intent(out) :: file_info_analysis
type(file_info_type), intent(out) :: file_info_output
-integer :: noutput_members, next_file, ninput_files, noutput_files, ndomains, idom
-character(len=64) :: fsource
+integer :: noutput_members, ninput_files, noutput_files, ndomains
character(len=256), allocatable :: file_array_input(:,:), file_array_output(:,:)
! local variable to shorten the name for function input
diff --git a/assimilation_code/modules/assimilation/filter_mod.html b/assimilation_code/modules/assimilation/filter_mod.html
index 656ce541c2..ca5fedfba0 100644
--- a/assimilation_code/modules/assimilation/filter_mod.html
+++ b/assimilation_code/modules/assimilation/filter_mod.html
@@ -98,6 +98,7 @@
runtime, but can lower the cost of the job significantly in some cases.
+
compute_posterior
+
logical
+
If .false., skip computing posterior forward operators and do not write
+ posterior values in the obs_seq.final file. Saves time and memory.
+ Cannot enable posterior inflation and skip computing the posteriors.
+ For backwards compatibility the default for this is .true.
+
+
ens_size
integer
Size of ensemble.
@@ -478,7 +487,7 @@
NAMELIST
for a discussion of how the standard deviation
adapts based on different types of inflation.
-
+
trace_execution
logical
True means output very detailed messages about what routines
@@ -535,6 +544,8 @@
NAMELIST
+
+
diff --git a/assimilation_code/modules/assimilation/filter_mod.nml b/assimilation_code/modules/assimilation/filter_mod.nml
index ab7eccb870..0e3913be42 100644
--- a/assimilation_code/modules/assimilation/filter_mod.nml
+++ b/assimilation_code/modules/assimilation/filter_mod.nml
@@ -18,6 +18,7 @@
output_mean = .true.
output_sd = .true.
write_all_stages_at_end = .false.
+ compute_posterior = .true.
ens_size = 20,
num_groups = 1,
diff --git a/assimilation_code/modules/assimilation/quality_control_mod.f90 b/assimilation_code/modules/assimilation/quality_control_mod.f90
index b0f01058ad..67706a90d8 100644
--- a/assimilation_code/modules/assimilation/quality_control_mod.f90
+++ b/assimilation_code/modules/assimilation/quality_control_mod.f90
@@ -42,10 +42,10 @@ module quality_control_mod
!------------------------------------------------------------------------------
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
!------------------------------------------------------------------------------
! Dart quality control variables
@@ -133,7 +133,7 @@ function set_input_qc(input_qc, assimilate_this_ob, evaluate_this_ob)
if(input_qc == 0 .and. (assimilate_this_ob .or. evaluate_this_ob)) then
set_input_qc = 0.0_r8
else
- set_input_qc = 1000.0_r8
+ set_input_qc = 1000.0_r8 + input_qc ! give some clue about why
endif
end function set_input_qc
diff --git a/assimilation_code/modules/assimilation/sampling_error_correction_mod.f90 b/assimilation_code/modules/assimilation/sampling_error_correction_mod.f90
index 9cd7409024..20cb9eda00 100644
--- a/assimilation_code/modules/assimilation/sampling_error_correction_mod.f90
+++ b/assimilation_code/modules/assimilation/sampling_error_correction_mod.f90
@@ -15,8 +15,9 @@
module sampling_error_correction_mod
-use types_mod, only : r8
-use utilities_mod, only : error_handler, E_ERR, nc_check
+use types_mod, only : r8
+use utilities_mod, only : error_handler, E_ERR
+use netcdf_utilities_mod, only : nc_check
use netcdf
diff --git a/assimilation_code/modules/assimilation/smoother_mod.f90 b/assimilation_code/modules/assimilation/smoother_mod.f90
index ce52c0947c..a6d50747e3 100644
--- a/assimilation_code/modules/assimilation/smoother_mod.f90
+++ b/assimilation_code/modules/assimilation/smoother_mod.f90
@@ -271,8 +271,8 @@ subroutine smoother_gen_copy_meta_data(num_output_state_members, output_inflatio
! The 4 is for ensemble mean and spread plus inflation mean and spread
character(len = metadatalength) :: state_meta(num_output_state_members + 4)
-character(len = 14) :: file_name
-character(len = 15) :: meta_data_string
+!character(len = 14) :: file_name
+!character(len = 15) :: meta_data_string
integer :: i, ensemble_offset, num_state_copies
! must have called init_smoother() before using this routine
@@ -318,7 +318,7 @@ subroutine smoother_gen_copy_meta_data(num_output_state_members, output_inflatio
state_meta(num_state_copies) = 'inflation sd'
endif
-!>@todo FIXME JPH: No longer writting diagnostic files. Need to handle
+!>@todo FIXME: No longer writing diagnostic files. Need to handle
!> writting out smoother information.
! ! Set up diagnostic output for model state, if output is desired
! do i = 1, num_lags
@@ -344,7 +344,7 @@ subroutine smoother_write_restart(start_copy, end_copy)
character(len = 256) :: file_name
integer :: i, smoother_index
-type(file_info_type) :: file_info
+!type(file_info_type) :: file_info
! must have called init_smoother() before using this routine
if ( .not. module_initialized ) then
@@ -361,7 +361,7 @@ subroutine smoother_write_restart(start_copy, end_copy)
do i = 1, num_current_lags
smoother_index = next_index(i)
write(file_name, '("Lag_", I5.5, "_", A)') i, trim(restart_out_file_name)
- !>@todo FIXME JPH: Need to write out smoother restarts
+ !>@todo FIXME : Need to write out smoother restarts
!call write_ensemble_restart(lag_handle(smoother_index), file_info, file_name, start_copy, end_copy)
!write(errstring, '(A,I4,A,I4)') 'writing restart file ', i, ' from cycle number', smoother_index
!call error_handler(E_MSG, 'smoother_write_restart', errstring)
diff --git a/assimilation_code/modules/io/dart_time_io_mod.f90 b/assimilation_code/modules/io/dart_time_io_mod.f90
index 0806294d79..c1365799d9 100644
--- a/assimilation_code/modules/io/dart_time_io_mod.f90
+++ b/assimilation_code/modules/io/dart_time_io_mod.f90
@@ -7,18 +7,19 @@
module dart_time_io_mod
!> \defgroup dart_time_io_mod dart_time_io_mod
-!> Netcdf reading and writing dart model time.
-!> Temporary module for dart time.
-!>@todo should this go in state_vector_io_mod or io_filename_mod?
+!> Default routines for netCDF reading and writing dart model time.
+!> If your model uses a different name for the time dimension
+!> or has a different way of handing/storing time, it must provide
+!> a custom read_model_time() and write_model_time() routine.
!> @{
-use types_mod, only : r8, digits12
-use time_manager_mod, only : time_type, set_time, get_time, print_time, &
- set_calendar_type, set_date, get_calendar_string, &
- operator(+)
-
-use utilities_mod, only : nc_check, E_MSG, E_ERR, error_handler, to_upper
+use types_mod, only : r8, digits12
+use time_manager_mod, only : time_type, set_time, get_time, print_time, &
+ set_calendar_type, set_date, get_calendar_string, &
+ operator(+)
+use utilities_mod, only : E_MSG, E_ERR, error_handler, to_upper
+use netcdf_utilities_mod, only : nc_check, nc_open_file_readonly, nc_close_file
use typeSizes
use netcdf
@@ -53,6 +54,7 @@ function read_model_time(filename)
integer :: year, month, day, hour, minute, second
type(time_type) :: base_time, delta_time
+character(len=*), parameter :: routine = 'read_model_time'
real(digits12) :: model_time, time_array(1)
integer, dimension(NF90_MAX_VAR_DIMS) :: dimIDs
@@ -64,8 +66,7 @@ function read_model_time(filename)
write(string3,*)'You may need to supply a model-specific "read_model_time()" to read the time.'
-call nc_check( nf90_open(filename, NF90_NOWRITE, ncid), &
- 'read_model_time', 'opening : "'//trim(filename)//'"')
+ncid = nc_open_file_readonly(filename, routine)
ios = nf90_inq_varid(ncid, "time", VarID)
if (ios /= NF90_NOERR) then
@@ -85,15 +86,20 @@ function read_model_time(filename)
source, revision, revdate, text2=string2, text3=string3)
endif
-! Since the time variable is known to have only 1 dimension, we know it is the first one.
+if (numdims == 0) then
+ ios = nf90_get_var(ncid, VarID, model_time)
+ call nc_check(ios, 'read_model_time','get_var scalar time' )
+else
-ios = nf90_inquire_dimension(ncid, dimids(1), len=ntimes)
-call nc_check(ios, 'read_model_time', 'inquire_dimension for time dimension from "'//trim(filename) )
+ ! Since the time variable is known to have only 1 dimension, we know it is the first one.
+ ios = nf90_inquire_dimension(ncid, dimIDs(1), len=ntimes)
+ call nc_check(ios, 'read_model_time', 'inquire_dimension for time dimension from "'//trim(filename) )
-! read the last one
-ios = nf90_get_var(ncid, VarID, time_array, start=(/ntimes/), count=(/1/))
-call nc_check(ios, 'read_model_time','get_var time' )
-model_time = time_array(1)
+ ! read the last one
+ ios = nf90_get_var(ncid, VarID, time_array, start=(/ntimes/), count=(/1/))
+ call nc_check(ios, 'read_model_time','get_var time' )
+ model_time = time_array(1)
+endif
! try to handle the calendar in a generic way
@@ -179,12 +185,15 @@ function read_model_time(filename)
source, revision, revdate, text2=string3)
endif
+!>@todo FIXME: do we really want this to print from any
+!> task without being asked? i vote no.
call print_time(read_model_time,'read_model_time')
+
!>@todo FIXME:
! make print_date() return without error if calendar is no_calendar,
-! and then add a call to print_date() here.
+! and then add a call to print_date() here. (also vote no.)
-call nc_check( nf90_close(ncid) , 'read_model_time closing : ', filename)
+call nc_close_file(ncid, routine)
end function read_model_time
@@ -198,119 +207,160 @@ subroutine write_model_time(ncid, dart_time)
integer, intent(in) :: ncid
type(time_type), intent(in) :: dart_time
+character(len=*), parameter :: routine = 'write_model_time'
integer :: ios
-integer :: xtype, numdims, ntimes
+integer :: numdims, ntimes
integer :: VarID
integer :: dart_days, dart_seconds
+integer :: unlimitedDimId
+
+logical :: has_unlimited, time_is_unlimited
real(digits12) :: model_time
integer, dimension(NF90_MAX_VAR_DIMS) :: dimIDs
-character (len=NF90_MAX_NAME) :: dart_calendar, file_calendar
+character (len=NF90_MAX_NAME) :: dart_calendar, var_calendar
+
+! If there is no unlimited dimension, unlimitedDimID = -1
+ios = nf90_inquire(ncid, unlimitedDimId=unlimitedDimId )
+call nc_check(ios,routine,'checking unlimited dimension')
+
+has_unlimited = (unlimitedDimID /= -1)
! this is used in many error messages below. set it here, and
! don't reuse string3 here, please.
write(string3,*)'You may need to supply a model-specific "write_model_time()" to write the time.'
+! see what kind of calendar dart is currently running with.
+call get_calendar_string(dart_calendar)
+
ios = nf90_inq_varid(ncid, "time", VarID)
! if the file doesn't already have a "time" variable, we make one
if (ios /= NF90_NOERR) then
- call error_handler(E_MSG,'write_model_time','no time variable found in file', &
+ call error_handler(E_MSG, routine, 'no variable "time" found in file', &
source, revision, revdate, text2='creating one')
! begin define mode
ios = nf90_Redef(ncid)
- call nc_check(ios, "write_model_time", "redef")
+ call nc_check(ios, routine, "redef")
! check to see if there is a time dimension
- ios = nf90_inq_dimid(ncid, "time", dimIds(1))
-
- ! if time dimension does not exist create it
+ ! if it does not exist create it
+ ios = nf90_inq_dimid(ncid, "time", dimIDs(1))
if (ios /= NF90_NOERR) then
- call nc_check(nf90_def_dim(ncid, "time", nf90_unlimited, dimIds(1)), &
- "write_model_time def_var dimension time")
+
+ ! If there is already an unlimited dimension, just make a
+ ! time dimension of 'normal' size. If there is no unlimited dim already
+ ! make the time variable 'unlimited'.
+
+ if (has_unlimited) then
+ ios = nf90_def_dim(ncid, "time", 1, dimIDs(1))
+ call nc_check(ios, routine, 'def_dim singleton dimension time')
+ else
+ ios = nf90_def_dim(ncid, "time", nf90_unlimited, dimIDs(1))
+ call nc_check(ios, routine, 'def_dim unlimited dimension time')
+ has_unlimited = .true.
+ unlimitedDimID = dimIDs(1)
+ endif
+
endif
- !>@todo NF90_UNLIMITED
- ios = nf90_def_var(ncid, name="time", xtype=nf90_double, varid=VarID)
- call nc_check(ios, "write_model_time", "time def_var")
+ ! make the time variable be dimensioned time(time) which is the
+ ! netCDF convention for coordinate variables (variables with the
+ ! same name as a dimension).
+ ios = nf90_def_var(ncid, name="time", xtype=nf90_double, dimids=dimIDs(1), varid=VarID)
+ call nc_check(ios, routine, "time def_var")
! define time attributes consistent with CF convention
ios = nf90_put_att(ncid, VarID, "long_name", "valid time of the model state")
- call nc_check(ios, "write_model_time", "time long_name")
+ call nc_check(ios, routine, "time long_name")
- call get_calendar_string(dart_calendar)
if (dart_calendar == 'NO_CALENDAR') then
ios = nf90_put_att(ncid, VarID, "calendar", "none")
- call nc_check(ios, "write_model_time", "calendar long_name")
+ call nc_check(ios, routine, "calendar long_name")
! ncview (actually, probably udunits2) crashes or errors out or
! displays misleading plot axes if you use 'days since ...' as the units.
! if you simply use 'days' it works much better.
ios = nf90_put_att(ncid, VarID, "units", "days")
- call nc_check(ios, "write_model_time", "units long_name")
+ call nc_check(ios, routine, "units long_name")
else if (dart_calendar == 'GREGORIAN') then
ios = nf90_put_att(ncid, VarID, "calendar", "gregorian")
- call nc_check(ios, "write_model_time", "calendar long_name")
+ call nc_check(ios, routine, "calendar long_name")
ios = nf90_put_att(ncid, VarID, "units", "days since 1601-01-01 00:00:00")
- call nc_check(ios, "write_model_time", "units long_name")
+ call nc_check(ios, routine, "units long_name")
else
- call error_handler(E_ERR, 'write_model_time:', &
- 'calendar type "'//trim(dart_calendar)//' unsupported by default write_model_time() routine', &
- source, revision, revdate, text2=string3)
+ write(string1,*) 'calendar type "'//trim(dart_calendar)// &
+ &'" unsupported by default write_model_time() routine'
+ call error_handler(E_ERR, routine, string1, &
+ source, revision, revdate, text2=string3)
endif
! end define mode
- call nc_check( nf90_Enddef(ncid),"write_model_time", "Enddef" )
+ call nc_check( nf90_Enddef(ncid),routine, "Enddef" )
endif
-! See if the existing time dimension has a calendar and start date to consider
+! See if the existing time variable has a calendar and start date to consider
-ios = nf90_get_att(ncid, VarID, 'calendar', file_calendar)
-if (ios /= NF90_NOERR) file_calendar = 'NO_CALENDAR'
-call to_upper(file_calendar)
+ios = nf90_get_att(ncid, VarID, 'calendar', var_calendar)
+if (ios /= NF90_NOERR) var_calendar = 'NO_CALENDAR'
+call to_upper(var_calendar)
-if (dart_calendar /= file_calendar ) then
+if (dart_calendar /= var_calendar ) then
! allow NO_CALENDAR, NO CALENDAR, and NONE to be synonyms.
- ! replace file_calendar with what dart uses to simplify the tests below.
- if (dart_calendar == 'NO_CALENDAR' .and. (file_calendar == 'NONE' .or. &
- file_calendar == 'NO CALENDAR')) then
- file_calendar = 'NO_CALENDAR'
+ ! replace var_calendar with what dart uses to simplify the tests below.
+ if (dart_calendar == 'NO_CALENDAR' .and. (var_calendar == 'NONE' .or. &
+ var_calendar == 'NO CALENDAR')) then
+ var_calendar = 'NO_CALENDAR'
else
write(string1,*)'inconsistent calendar types between DART program and input file.'
- write(string2,*)'DART initialized with: ', trim(dart_calendar), ' File uses: ', trim(file_calendar)
- call error_handler(E_ERR, 'write_model_time:', string1, source,revision, revdate, &
+ write(string2,*)'DART initialized with: ', trim(dart_calendar), ' File uses: ', trim(var_calendar)
+ call error_handler(E_ERR, routine, string1, source, revision, revdate, &
text2=string2, text3=string3)
endif
endif
+! convert time to something that netCDF can store, fractional days
+call get_time(dart_time, dart_seconds, dart_days)
+model_time = real(dart_days,digits12) + real(dart_seconds,digits12)/86400.0_digits12
+
! need to know how long the time variable is and hammer the last time
-ios = nf90_inquire_variable(ncid, VarID, xtype=xtype, dimids=dimIDs, ndims=numdims)
-call nc_check(ios, 'write_model_time', 'inquire_variable "time"')
+ios = nf90_inquire_variable(ncid, VarID, dimids=dimIDs, ndims=numdims)
+call nc_check(ios, routine, 'inquire number of dimensions of variable "time"')
+
+if (numdims == 0) then ! variable is a scalar
+ ios = nf90_put_var(ncid, VarID, model_time)
+ call nc_check(ios, routine, 'put_var scalar "model_time"')
+ return
+endif
if (numdims > 1) then
write(string1,*)'Expecting the "time" variable to be a single dimension.'
- call error_handler(E_ERR,'write_model_time', string1, &
+ call error_handler(E_ERR, routine, string1, &
source, revision, revdate, text2=string3)
endif
-! Since the time variable is known to have only 1 dimension, we know it is the first one.
+ios = nf90_inquire_dimension(ncid, dimIDs(1), len=ntimes)
+call nc_check(ios, routine, 'inquire_dimension for time dimension')
-ios = nf90_inquire_dimension(ncid, dimIds(1), len=ntimes)
-call nc_check(ios, 'write_model_time', 'inquire_dimension for time dimension')
+if (dimIDs(1) == unlimitedDimID) time_is_unlimited = .true.
-! convert time to something that netCDF can store, fractional days
-call get_time(dart_time, dart_seconds, dart_days)
-model_time = real(dart_days,digits12) + real(dart_seconds,digits12)/86400.0_digits12
+if (ntimes == 0 .and. time_is_unlimited) then
+ ntimes = ntimes + 1
+elseif (ntimes == 0) then
+ write(string1,*)'"time" variable has length 0 but is not the unlimited dimension.'
+ call error_handler(E_ERR, routine, string1, &
+ source, revision, revdate, text2=string3)
+endif
! write dart days and seconds files to netcdf file
ios = nf90_put_var(ncid, VarID, model_time, start=(/ ntimes /))
-call nc_check( ios, "write_model_time", "put_var model_time")
+call nc_check(ios, routine, "put_var model_time")
end subroutine write_model_time
diff --git a/assimilation_code/modules/io/direct_netcdf_mod.f90 b/assimilation_code/modules/io/direct_netcdf_mod.f90
index bf7a698d13..139410da7d 100644
--- a/assimilation_code/modules/io/direct_netcdf_mod.f90
+++ b/assimilation_code/modules/io/direct_netcdf_mod.f90
@@ -70,10 +70,12 @@ module direct_netcdf_mod
operator(-), operator(/), operator(*), &
operator(==), operator(/=)
-use utilities_mod, only : error_handler, nc_check, file_to_text, &
+use utilities_mod, only : error_handler, file_to_text, &
find_textfile_dims, file_exist, &
E_MSG, E_ALLMSG, E_ERR, E_DBG, E_WARN
+use netcdf_utilities_mod, only : nc_check
+
use mpi_utilities_mod, only : task_count, send_to, receive_from, my_task_id, &
broadcast_flag
@@ -1571,6 +1573,8 @@ end subroutine write_variables
!> Create the output files
!>
!> A 'blank' domain is one variable called state, with dimension = model size.
+!> It is used when the model has not supplied any netcdf info but
+!> direct_netcdf_write = .true.
!> The file is intentionally left OPEN.
!-------------------------------------------------------------------------------
diff --git a/assimilation_code/modules/io/io_filenames_mod.f90 b/assimilation_code/modules/io/io_filenames_mod.f90
index 5a936389dd..f2ada9499a 100644
--- a/assimilation_code/modules/io/io_filenames_mod.f90
+++ b/assimilation_code/modules/io/io_filenames_mod.f90
@@ -35,7 +35,7 @@ module io_filenames_mod
use types_mod, only : r4, r8, MISSING_R8, MAX_NUM_DOMS, digits12
use utilities_mod, only : file_exist, E_ERR, E_MSG, E_WARN, error_handler,&
- nc_check, open_file, close_file, find_textfile_dims, &
+ open_file, close_file, find_textfile_dims, &
do_output
use time_manager_mod, only : time_type
use mpi_utilities_mod, only : my_task_id
@@ -45,6 +45,7 @@ module io_filenames_mod
get_FillValue, get_xtype, get_add_offset, get_scale_factor, &
get_has_missing_value, do_io_update
use ensemble_manager_mod, only : ensemble_type
+use netcdf_utilities_mod, only : nc_check
use netcdf
@@ -180,7 +181,7 @@ module io_filenames_mod
end type
-character(len=512) :: msgstring, msgstring2, msgstring3 ! message handler
+character(len=512) :: msgstring
contains
@@ -268,7 +269,7 @@ subroutine io_filenames_init(file_info, ncopies, cycling, single_file, &
character(len=*), optional, intent(in) :: root_name !< base if restart_files not given
logical, optional, intent(in) :: check_output_compatibility !< ensure netCDF variables exist in output BEFORE spending a ton of core hours
-integer :: ndomains, idom, esize
+integer :: ndomains, esize
file_info%single_file = single_file
file_info%cycling = cycling
@@ -303,6 +304,7 @@ subroutine io_filenames_init(file_info, ncopies, cycling, single_file, &
esize = SIZE(restart_files,1)
file_info%stage_metadata%filenames(1:esize,:) = restart_files(:,:)
endif
+
if(present(root_name)) file_info%root_name = root_name
if(present(check_output_compatibility)) file_info%check_output_compatibility = check_output_compatibility
file_info%initialized = .true.
@@ -321,7 +323,6 @@ subroutine check_file_info_variable_shape(file_info, ens_handle)
type(ensemble_type), intent(in) :: ens_handle
integer :: num_domains, idom, icopy, my_copy
-character(len=256) :: filename
num_domains = get_num_domains()
@@ -350,7 +351,7 @@ subroutine set_member_file_metadata(file_info, ens_size, my_copy_start)
character(len=256) :: fname, desc
character(len=128) :: stage_name, basename
-integer :: nlines, icopy, iunit, ios, idom
+integer :: icopy, idom
integer :: offset
offset = my_copy_start - 1
diff --git a/assimilation_code/modules/io/state_structure_mod.f90 b/assimilation_code/modules/io/state_structure_mod.f90
index f68af3095b..bd2dea58ff 100644
--- a/assimilation_code/modules/io/state_structure_mod.f90
+++ b/assimilation_code/modules/io/state_structure_mod.f90
@@ -59,13 +59,15 @@ module state_structure_mod
!> variables after reading from a netcdf file. There may be calculations in model_mod
!> that are assuming a transformed order which no longer exists.
-use utilities_mod, only : E_ERR, error_handler, nc_check, do_output
+use utilities_mod, only : E_ERR, error_handler, do_output
use obs_kind_mod, only : get_name_for_quantity, get_index_for_quantity
use types_mod, only : r8, r4, i8, digits12, MISSING_R8, MISSING_R4, MISSING_I, &
obstypelength, MAX_NUM_DOMS
+use netcdf_utilities_mod, only : nc_check
+
use sort_mod, only : index_sort
use netcdf
@@ -343,7 +345,7 @@ function add_domain_from_file(info_file, num_vars, var_names, kind_list, clamp_v
enddo
! load up variable id's and sizes
-call load_state_variable_info(state%domain(dom_id))
+call load_state_variable_info(state%domain(dom_id),dom_id)
! load up the domain unique dimension info
call load_unique_dim_info(dom_id)
@@ -485,9 +487,10 @@ end function add_domain_blank
!> Load metadata from netcdf file info state_strucutre
-subroutine load_state_variable_info(domain)
+subroutine load_state_variable_info(domain, domain_index)
type(domain_type), intent(inout) :: domain
+integer, intent(in) :: domain_index
! netcdf variables
integer :: ret, ncfile
@@ -505,7 +508,7 @@ subroutine load_state_variable_info(domain)
if ( domain%unlimDimID /= -1 ) domain%has_unlimited = .true.
! get variable ids
-call load_variable_ids(ncfile, domain)
+call load_variable_ids(ncfile, domain, domain_index)
! get all variable sizes, only readers store dimensions?
call load_variable_sizes(ncfile, domain)
@@ -521,10 +524,11 @@ end subroutine load_state_variable_info
!> Load netcdf variable ids
-subroutine load_variable_ids(ncfile, domain)
+subroutine load_variable_ids(ncfile, domain, domain_index)
integer, intent(in) :: ncfile ! netdcf file id - should this be part of the domain handle?
type(domain_type), intent(inout) :: domain
+integer, intent(in) :: domain_index
integer :: ret ! netcdf return value
integer :: ivar, num_vars
@@ -536,7 +540,8 @@ subroutine load_variable_ids(ncfile, domain)
ret = nf90_inq_varid(ncfile, domain%variable(ivar)%varname, &
domain%variable(ivar)%io_info%varid)
- write(string1,*)'domain variable number ',ivar,' "'//trim(domain%variable(ivar)%varname)//'" from file "'//trim(domain%info_file)//'"'
+ write(string1,*)'domain ',domain_index,', variable #',ivar,' "', &
+ trim(domain%variable(ivar)%varname)//'" from file "'//trim(domain%info_file)//'"'
call nc_check(ret, 'load_variable_ids, nf90_inq_var_id', string1)
enddo
@@ -1722,7 +1727,7 @@ end subroutine set_dart_kinds
!-------------------------------------------------------------------------------
!> Returns the variable dart kind index
-
+!>@todo need to switch all kinds to qty
function get_kind_index(dom_id, var_id)
integer, intent(in) :: dom_id ! domain
diff --git a/assimilation_code/modules/io/state_vector_io_mod.f90 b/assimilation_code/modules/io/state_vector_io_mod.f90
index 53762a3024..5cd6a4432d 100644
--- a/assimilation_code/modules/io/state_vector_io_mod.f90
+++ b/assimilation_code/modules/io/state_vector_io_mod.f90
@@ -51,7 +51,7 @@ module state_vector_io_mod
all_copies_to_all_vars, all_vars_to_all_copies, &
get_var_owner_index
-use utilities_mod, only : error_handler, nc_check, check_namelist_read, &
+use utilities_mod, only : error_handler, check_namelist_read, &
find_namelist_in_file, nmlfileunit, do_nml_file, &
do_nml_term, register_module, to_upper, E_MSG, E_ERR
@@ -68,16 +68,14 @@ module state_vector_io_mod
use state_structure_mod, only : get_num_domains
-use netcdf
-
implicit none
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
private
@@ -210,13 +208,13 @@ subroutine read_state(state_ens_handle, file_info, read_time_from_file, time, &
call print_inflation_source(file_info, post_inflate_handle, 'Posterior')
! If inflation is single state space read from a file, the copies array is filled here.
- call fill_single_ss_inflate_from_read(state_ens_handle, prior_inflate_handle, post_inflate_handle)
+ call fill_single_inflate_val_from_read(state_ens_handle, prior_inflate_handle, post_inflate_handle)
! If inflation is from a namelist value it is set here.
!>@todo FIXME: ditto here - the output should be from a routine
!> in the adaptive_inflate_mod.f90 code
- call fill_ss_from_nameslist_value(state_ens_handle, prior_inflate_handle)
- call fill_ss_from_nameslist_value(state_ens_handle, post_inflate_handle)
+ call fill_inf_from_namelist_value(state_ens_handle, prior_inflate_handle)
+ call fill_inf_from_namelist_value(state_ens_handle, post_inflate_handle)
endif
@@ -350,10 +348,10 @@ end subroutine write_restart_direct
!> to all other tasks who then update their copies array.
!> Note filling both mean and sd values if at least one of mean
!> or sd is read from file. If one is set from a namelist the copies
-!> array is overwritten in fill_ss_from_namelist value
+!> array is overwritten in fill_inf_from_namelist_value()
!>@todo We need to refactor this, not sure where it is being used
-subroutine fill_single_ss_inflate_from_read(ens_handle, &
+subroutine fill_single_inflate_val_from_read(ens_handle, &
prior_inflate_handle, post_inflate_handle)
type(ensemble_type), intent(inout) :: ens_handle
@@ -455,7 +453,7 @@ subroutine fill_single_ss_inflate_from_read(ens_handle, &
endif
-end subroutine fill_single_ss_inflate_from_read
+end subroutine fill_single_inflate_val_from_read
!-----------------------------------------------------------------------
@@ -463,13 +461,12 @@ end subroutine fill_single_ss_inflate_from_read
!> fill copies array with namelist values for inflation if they do.
-subroutine fill_ss_from_nameslist_value(ens_handle, inflate_handle)
+subroutine fill_inf_from_namelist_value(ens_handle, inflate_handle)
type(ensemble_type), intent(inout) :: ens_handle
type(adaptive_inflate_type), intent(in) :: inflate_handle
character(len=32) :: label
-character(len=128) :: nmread
integer :: INF_MEAN_COPY, INF_SD_COPY
real(r8) :: inf_initial, sd_initial
@@ -490,29 +487,21 @@ subroutine fill_ss_from_nameslist_value(ens_handle, inflate_handle)
label = "Posterior"
else
write(msgstring, *) "state space inflation but neither prior or posterior"
- call error_handler(E_ERR, 'fill_ss_from_nameslist_value', msgstring, &
+ call error_handler(E_ERR, 'fill_inf_from_namelist_value', msgstring, &
source, revision, revdate)
endif
if (.not. mean_from_restart(inflate_handle)) then
inf_initial = get_inflate_mean(inflate_handle)
- ! THIS IS NOW PRINTED OUT IN THE log_inflation_info() routine
- !write(nmread, '(A, F12.6)') 'mean read from namelist as ', inf_initial
- !call error_handler(E_MSG, trim(label) // ' inflation:', trim(nmread), &
- ! source, revision, revdate)
ens_handle%copies(INF_MEAN_COPY, :) = inf_initial
endif
if (.not. sd_from_restart(inflate_handle)) then
sd_initial = get_inflate_sd(inflate_handle)
- ! THIS IS NOW PRINTED OUT IN THE log_inflation_info() routine
- !write(nmread, '(A, F12.6)') 'sd read from namelist as ', sd_initial
- !call error_handler(E_MSG, trim(label) // ' inflation:', trim(nmread), &
- ! source, revision, revdate)
ens_handle%copies(INF_SD_COPY, :) = sd_initial
endif
-end subroutine fill_ss_from_nameslist_value
+end subroutine fill_inf_from_namelist_value
!-----------------------------------------------------------
!> set stage names
diff --git a/assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90 b/assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90
index 96fa4a1759..8be407ad65 100644
--- a/assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90
+++ b/assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90
@@ -22,10 +22,18 @@ module obs_kind_mod
implicit none
private
-public :: get_name_for_type_of_obs, assimilate_this_type_of_obs, &
- evaluate_this_type_of_obs, get_quantity_for_type_of_obs, get_index_for_type_of_obs, &
- write_type_of_obs_table, read_type_of_obs_table, get_type_of_obs_from_menu, map_type_of_obs_table, &
- use_ext_prior_this_type_of_obs, get_name_for_quantity, get_index_for_quantity
+public :: get_name_for_type_of_obs, &
+ assimilate_this_type_of_obs, &
+ evaluate_this_type_of_obs, &
+ get_quantity_for_type_of_obs, &
+ get_index_for_type_of_obs, &
+ write_type_of_obs_table, &
+ read_type_of_obs_table, &
+ get_type_of_obs_from_menu, &
+ map_type_of_obs_table, &
+ use_ext_prior_this_type_of_obs, &
+ get_name_for_quantity, &
+ get_index_for_quantity
! Added by nsc to try to limit the number of global vars exported from
! this program. i do not like this terminology, but since we are still
@@ -43,6 +51,12 @@ module obs_kind_mod
! DART system. Future versions of the preprocess program will be able to
! generate this table automatically.
+!>@todo FIXME: replace this list with a formatted comment
+!>and have an input to preprocess have a kinds type include list.
+!>it can default to 'all' but it could be grouped by atmosphere,
+!>ocean, land, chemistry, etc? if you ignore duplicates, these
+!>could be overlapping groups of any resolution you want.
+!
! Definition and public access to the observation types/kinds
! Unique index values associated with each observation type and
! kind strings are defined here.
@@ -438,7 +452,9 @@ module obs_kind_mod
QTY_SOM_TEMPERATURE = 353, &
QTY_SEAICE_FY = 354, &
QTY_SEAICE_AGREG_FY = 355, &
- QTY_SEAICE_AGREG_SURFACETEMP = 356
+ QTY_SEAICE_AGREG_SURFACETEMP = 356, &
+ QTY_SEAICE_AGREG_FREEBOARD = 357, &
+ QTY_SEAICE_CATEGORY = 358
integer, parameter, public :: &
QTY_SEA_SURFACE_ANOMALY = 360
@@ -452,10 +468,15 @@ module obs_kind_mod
QTY_CWP_PATH = 363, &
QTY_CWP_PATH_ZERO = 364
+! WACCAM
+integer, parameter, public :: &
+ QTY_ION_O_MIXING_RATIO = 365, &
+ QTY_ATOMIC_H_MIXING_RATIO = 366
+
! max_defined_quantities is private to this module. see comment below near the max_obs_specific
! declaration for more info about publics and private values.
-integer, parameter :: max_defined_quantities = 364
+integer, parameter :: max_defined_quantities = 366
!----------------------------------------------------------------------------
! This list is autogenerated by the 'preprocess' program. To add new
@@ -473,10 +494,10 @@ module obs_kind_mod
!----------------------------------------------------------------------------
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
logical, save :: module_initialized = .false.
@@ -856,12 +877,16 @@ subroutine initialize_module
obs_kind_names(354) = obs_kind_type(QTY_SEAICE_FY, 'QTY_SEAICE_FY')
obs_kind_names(355) = obs_kind_type(QTY_SEAICE_AGREG_FY, 'QTY_SEAICE_AGREG_FY')
obs_kind_names(356) = obs_kind_type(QTY_SEAICE_AGREG_SURFACETEMP,'QTY_SEAICE_AGREG_SURFACETEMP')
+obs_kind_names(357) = obs_kind_type(QTY_SEAICE_AGREG_FREEBOARD,'QTY_SEAICE_AGREG_FREEBOARD')
+obs_kind_names(358) = obs_kind_type(QTY_SEAICE_CATEGORY, 'QTY_SEAICE_CATEGORY')
obs_kind_names(360) = obs_kind_type(QTY_SEA_SURFACE_ANOMALY, 'QTY_SEA_SURFACE_ANOMALY')
obs_kind_names(361) = obs_kind_type(QTY_LARGE_SCALE_STATE, 'QTY_LARGE_SCALE_STATE')
obs_kind_names(362) = obs_kind_type(QTY_SMALL_SCALE_STATE, 'QTY_SMALL_SCALE_STATE')
obs_kind_names(363) = obs_kind_type(QTY_CWP_PATH, 'QTY_CWP_PATH')
obs_kind_names(364) = obs_kind_type(QTY_CWP_PATH_ZERO, 'QTY_CWP_PATH_ZERO')
+obs_kind_names(365) = obs_kind_type(QTY_ION_O_MIXING_RATIO, 'QTY_ION_O_MIXING_RATIO')
+obs_kind_names(366) = obs_kind_type(QTY_ATOMIC_H_MIXING_RATIO, 'QTY_ATOMIC_H_MIXING_RATIO')
! count here, then output below
diff --git a/assimilation_code/modules/observations/forward_operator_mod.f90 b/assimilation_code/modules/observations/forward_operator_mod.f90
index 2d6c35dc1f..723927fa88 100644
--- a/assimilation_code/modules/observations/forward_operator_mod.f90
+++ b/assimilation_code/modules/observations/forward_operator_mod.f90
@@ -67,7 +67,7 @@ module forward_operator_mod
! Module storage for writing error messages
-character(len = 255) :: msgstring
+character(len = 256) :: msgstring, msgstring2
contains
@@ -143,7 +143,7 @@ subroutine get_obs_ens_distrib_state(ens_handle, obs_fwd_op_ens_handle, &
ens_size = ens_handle%num_copies - ens_handle%num_extras
-if(get_allow_transpose(ens_handle)) then ! giant if for transpose or distribtued forward op
+if(get_allow_transpose(ens_handle)) then ! giant if for transpose or distributed forward op
my_copy_indices(:) = ens_handle%my_copies(1:num_copies_to_calc) ! var-complete forward operators
@@ -236,7 +236,7 @@ subroutine get_obs_ens_distrib_state(ens_handle, obs_fwd_op_ens_handle, &
qc_ens_handle%vars(j, 1:num_copies_to_calc) = istatus(:)
call check_forward_operator_istatus(num_copies_to_calc, assimilate_this_ob, &
- evaluate_this_ob, istatus, expected_obs)
+ evaluate_this_ob, istatus, expected_obs, keys(j))
end do ALL_OBSERVATIONS
@@ -303,7 +303,7 @@ subroutine get_obs_ens_distrib_state(ens_handle, obs_fwd_op_ens_handle, &
qc_ens_handle%copies(:, j) = istatus
call check_forward_operator_istatus(num_copies_to_calc, assimilate_this_ob, evaluate_this_ob, &
- istatus, expected_obs)
+ istatus, expected_obs, thiskey(1))
end do MY_OBSERVATIONS
@@ -406,6 +406,7 @@ subroutine get_expected_obs_distrib_state(seq, keys, state_time, isprior, &
type(obs_type) :: obs
type(obs_def_type) :: obs_def
+character(len=32) :: state_size_string, obs_key_string, identity_obs_string
integer :: obs_kind_ind
integer :: num_obs, i
@@ -428,10 +429,15 @@ subroutine get_expected_obs_distrib_state(seq, keys, state_time, isprior, &
! Check in kind for negative for identity obs
if(obs_kind_ind < 0) then
- if ( -obs_kind_ind > state_ens_handle%num_vars ) call error_handler(E_ERR, &
- 'get_expected_obs', &
- 'identity obs is outside of state vector ', &
- source, revision, revdate)
+ if ( -obs_kind_ind > state_ens_handle%num_vars ) then
+ write(state_size_string, *) state_ens_handle%num_vars
+ write(obs_key_string, *) keys(i)
+ write(identity_obs_string, *) -obs_kind_ind
+ write(msgstring, *) 'unable to compute forward operator for obs number '//trim(adjustl(obs_key_string))
+ write(msgstring2, *) 'identity index '//trim(adjustl(identity_obs_string))//&
+ ' must be between 1 and the state size of '//trim(adjustl(state_size_string))
+ call error_handler(E_ERR, 'get_expected_obs', msgstring, source, revision, revdate, text2=msgstring2)
+ endif
expected_obs = get_state(-1*int(obs_kind_ind,i8), state_ens_handle)
@@ -441,8 +447,8 @@ subroutine get_expected_obs_distrib_state(seq, keys, state_time, isprior, &
else ! do forward operator for this kind
- call get_expected_obs_from_def_distrib_state(state_ens_handle, num_ens, copy_indices, keys(i), obs_def, obs_kind_ind, &
- state_time, isprior, &
+ call get_expected_obs_from_def_distrib_state(state_ens_handle, num_ens, copy_indices, keys(i), &
+ obs_def, obs_kind_ind, state_time, isprior, &
assimilate_this_ob, evaluate_this_ob, expected_obs, istatus)
endif
@@ -502,14 +508,15 @@ end subroutine assim_or_eval
!> * Successful istatus but missing_r8 for forward operator
!> * Negative istatus
!> This routine calls the error handler (E_ERR) if either of these happen.
-subroutine check_forward_operator_istatus(num_fwd_ops, assimilate_ob, evaluate_ob, istatus, expected_obs)
+
+subroutine check_forward_operator_istatus(num_fwd_ops, assimilate_ob, evaluate_ob, istatus, expected_obs, thiskey)
integer, intent(in) :: num_fwd_ops
logical, intent(in) :: assimilate_ob
logical, intent(in) :: evaluate_ob
integer, intent(in) :: istatus(num_fwd_ops)
real(r8), intent(in) :: expected_obs(num_fwd_ops)
-
+integer, intent(in) :: thiskey
integer :: copy
@@ -520,12 +527,16 @@ subroutine check_forward_operator_istatus(num_fwd_ops, assimilate_ob, evaluate_o
if(istatus(copy) == 0) then
if ((assimilate_ob .or. evaluate_ob) .and. (expected_obs(copy) == missing_r8)) then
write(msgstring, *) 'istatus was 0 (OK) but forward operator returned missing value.'
- call error_handler(E_ERR,'filter_main', msgstring, source, revision, revdate)
+ write(msgstring2, *) 'observation number ', thiskey
+ call error_handler(E_ERR,'check_forward_operator_istatus', msgstring, &
+ source, revision, revdate, text2=msgstring2)
endif
! Negative istatus
else if (istatus(copy) < 0) then
write(msgstring, *) 'istatus must not be <0 from forward operator. 0=OK, >0 for error'
- call error_handler(E_ERR,'filter_main', msgstring, source, revision, revdate)
+ write(msgstring2, *) 'observation number ', thiskey
+ call error_handler(E_ERR,'check_forward_operator_istatus', msgstring, &
+ source, revision, revdate, text2=msgstring2)
endif
enddo
diff --git a/assimilation_code/modules/observations/obs_sequence_mod.f90 b/assimilation_code/modules/observations/obs_sequence_mod.f90
index dee15cfebf..567826ebd8 100644
--- a/assimilation_code/modules/observations/obs_sequence_mod.f90
+++ b/assimilation_code/modules/observations/obs_sequence_mod.f90
@@ -4,11 +4,13 @@
!
! $Id$
-!> \file obs_sequence_mod.f90 modifing this to have distributed identity obs
-!> \dir obs_sequence modifing obs_sequence to have distributed identity obs
-
-!> @brief For observations sequence stuff
+!> @{
+!> @brief Manage lists of observations
+!>
+!> Time-ordered sequences of observations.
!> get expected obs is in here
+!> @}
+
module obs_sequence_mod
! WARNING OPERATOR OVERLOAD FOR EQUIVALENCE???
@@ -26,10 +28,10 @@ module obs_sequence_mod
use obs_def_mod, only : obs_def_type, get_obs_def_time, read_obs_def, &
write_obs_def, destroy_obs_def, copy_obs_def, &
interactive_obs_def, get_obs_def_location, &
- get_obs_def_type_of_obs, get_obs_def_key, &
- operator(/=), print_obs_def
-use obs_kind_mod, only : write_type_of_obs_table, read_type_of_obs_table, max_defined_types_of_obs, &
- get_index_for_type_of_obs
+ get_obs_def_type_of_obs, get_obs_def_key, &
+ operator(==), operator(/=), print_obs_def
+use obs_kind_mod, only : write_type_of_obs_table, read_type_of_obs_table, &
+ max_defined_types_of_obs, get_index_for_type_of_obs
use time_manager_mod, only : time_type, operator(>), operator(<), &
operator(>=), operator(/=), set_time, &
operator(-), operator(+), operator(==)
@@ -44,16 +46,15 @@ module obs_sequence_mod
interface assignment(=)
module procedure copy_obs
end interface
-
interface operator(==)
module procedure eq_obs
end interface
-
interface operator(/=)
module procedure ne_obs
end interface
+
! Public interfaces for obs sequences
public :: obs_sequence_type, init_obs_sequence, interactive_obs_sequence, &
get_num_copies, get_num_qc, get_num_obs, get_max_num_obs, &
@@ -72,7 +73,7 @@ module obs_sequence_mod
public :: obs_type, init_obs, destroy_obs, get_obs_def, set_obs_def, &
get_obs_values, set_obs_values, replace_obs_values, get_qc, set_qc, &
read_obs, write_obs, replace_qc, interactive_obs, copy_obs, assignment(=), &
- get_obs_key, copy_partial_obs, print_obs, eq_obs, ne_obs
+ get_obs_key, copy_partial_obs, print_obs
! Public interfaces for obs covariance modeling
public :: obs_cov_type
@@ -1276,7 +1277,6 @@ subroutine read_obs_seq_header(file_name, num_copies, num_qc, num_obs, &
logical, optional, intent(in) :: close_the_file
character(len=16) :: label(2)
-character(len=12) :: header
integer :: ios
! always false now, should be deprecated
@@ -1297,21 +1297,24 @@ subroutine read_obs_seq_header(file_name, num_copies, num_qc, num_obs, &
! header string 'obs_sequence'
ios = check_obs_seq_header(file_id, read_format)
-if(ios /= 0) then
+if(ios /= 0) then ! try reading binary formats
call close_file(file_id)
-read_format = 'unformatted'
+ read_format = 'unformatted'
file_id = open_file(file_name, form=read_format, action='read', convert=read_binary_file_format)
+ ios = check_obs_seq_header(file_id, read_format)
+
+ if(ios /= 0) then ! try the other flavor
- ios = check_obs_seq_header(file_id, read_format)
- if(ios /= 0) then
+ !>@todo Can we check the other binary file endianness ... can only be native, big or little ...
+ !> could remove obs_sequence_nml:read_binary_file_format
! the file exists but isn't recognizable as one of our obs_seq files.
! it could be the wrong byte order, or just not an obs_seq file.
write(string1, *) 'File "', trim(file_name), '" is not recognized as a DART observation sequence file.'
write(string2, *) 'Attempted to read both as a formatted (ascii) and unformatted (binary) file.'
write(string3, *) 'For binary files, endian selection was "'//trim(read_binary_file_format)//'"'
- call error_handler(E_ERR, 'read_obs_seq_header', string1, &
+ call error_handler(E_ERR, 'read_obs_seq_header', string1, &
source, revision, revdate, text2=string2, text3=string3)
endif
endif
@@ -1324,10 +1327,10 @@ subroutine read_obs_seq_header(file_name, num_copies, num_qc, num_obs, &
! Read in the rest of the header information
if (read_format == 'formatted') then
-read(file_id, *) label(1), num_copies, label(2), num_qc
-read(file_id, *) label(1), num_obs, label(2), max_num_obs
+ read(file_id, *) label(1), num_copies, label(2), num_qc
+ read(file_id, *) label(1), num_obs, label(2), max_num_obs
else
-read(file_id) num_copies, num_qc, num_obs, max_num_obs
+ read(file_id) num_copies, num_qc, num_obs, max_num_obs
endif
! Close the file if requested by optional argument
@@ -1336,6 +1339,7 @@ subroutine read_obs_seq_header(file_name, num_copies, num_qc, num_obs, &
endif
end subroutine read_obs_seq_header
+
!-------------------------------------------------
! ok, this needs some explanation. for a binary formatted file,
@@ -2146,6 +2150,7 @@ subroutine copy_obs(obs1, obs2)
obs1%values = obs2%values
obs1%qc = obs2%qc
+
obs1%prev_time = obs2%prev_time
obs1%next_time = obs2%next_time
obs1%cov_group = obs2%cov_group
@@ -2201,7 +2206,7 @@ end subroutine print_obs
function eq_obs(obs1, obs2)
-! This routine could be overloaded with the == operator
+! This routine is overloaded with the == operator
type(obs_type), intent(in) :: obs1
type(obs_type), intent(in) :: obs2
@@ -2237,7 +2242,7 @@ end function eq_obs
function ne_obs(obs1, obs2)
-! This routine could be overloaded with the /= operator
+! This routine is overloaded with the /= operator
type(obs_type), intent(in) :: obs1
type(obs_type), intent(in) :: obs2
diff --git a/assimilation_code/modules/utilities/cray_win_mod.f90 b/assimilation_code/modules/utilities/cray_win_mod.f90
index dbe8609363..200e79f4e2 100644
--- a/assimilation_code/modules/utilities/cray_win_mod.f90
+++ b/assimilation_code/modules/utilities/cray_win_mod.f90
@@ -181,9 +181,9 @@ subroutine free_state_window(state_ens_handle, fwd_op_ens_handle, qc_ens_handle)
if(get_allow_transpose(state_ens_handle)) then ! the forward operators were done var complete
!transpose back if allowing transposes
if (present(fwd_op_ens_handle)) &
- call all_vars_to_all_copies(fwd_op_ens_handle)
+ call all_vars_to_all_copies(fwd_op_ens_handle)
if (present(qc_ens_handle)) &
- call all_vars_to_all_copies(qc_ens_handle)
+ call all_vars_to_all_copies(qc_ens_handle)
else
! close mpi window
call mpi_win_free(state_win, ierr)
diff --git a/assimilation_code/modules/utilities/ensemble_manager_mod.f90 b/assimilation_code/modules/utilities/ensemble_manager_mod.f90
index dc0927cdd5..5ee3a5652d 100644
--- a/assimilation_code/modules/utilities/ensemble_manager_mod.f90
+++ b/assimilation_code/modules/utilities/ensemble_manager_mod.f90
@@ -298,7 +298,7 @@ subroutine get_copy(receiving_pe, ens_handle, copy, vars, mtime)
endif
! Make sure that vars has enough space to handle the answer
-if(ens_handle%my_pe == receiving_pe) then !HK I think only the reciever needs the space
+if(ens_handle%my_pe == receiving_pe) then !HK I think only the receiver needs the space
if(size(vars) < ens_handle%num_vars) then
write(msgstring, *) 'Size of vars: ', size(vars), ' Must be at least ', ens_handle%num_vars
call error_handler(E_ERR,'get_copy', msgstring, source, revision, revdate)
@@ -319,7 +319,7 @@ subroutine get_copy(receiving_pe, ens_handle, copy, vars, mtime)
endif
! Otherwise, must wait to receive vars and time from storing pe
- call receive_from(map_pe_to_task(ens_handle, owner), vars, mtime)
+ call receive_from(map_pe_to_task(ens_handle, owner), vars, mtime)
endif
!----- Block of code that must be done by PE that stores the copy IF it is NOT receiver -----
@@ -751,10 +751,12 @@ subroutine set_up_ens_distribution(ens_handle)
if(ens_handle%transpose_type == 2) then
allocate(ens_handle%vars(ens_handle%num_vars, ens_handle%my_num_copies))
+ ens_handle%vars = MISSING_R8
endif
if(ens_handle%transpose_type == 3) then
allocate(ens_handle%vars(ens_handle%num_vars,1))
+ ens_handle%vars = MISSING_R8
endif
! Set everything to missing value
@@ -834,6 +836,19 @@ function get_max_num_vars(ens_handle, num_vars)
integer :: get_max_num_vars
!!!integer, intent(in) :: distribution_type
+!could this be instead:
+!
+! get_max_num_vars = num_vars / num_pes ! integer math rounds down
+! if (get_max_num_vars * num_pes /= num_vars) &
+! get_max_num_vars = get_max_num_vars + 1
+!
+! if num_vars divides evenly into the num_pes we use
+! the exact size. otherwise if uneven we add one.
+! this number has to be the same on all PEs because it
+! sets the send/recv size. it doesn't matter which pes
+! have extra values, just that is any of them do then
+! everyone uses the larger number.
+
get_max_num_vars = num_vars / num_pes + 1
end function get_max_num_vars
diff --git a/assimilation_code/modules/utilities/fixsystem b/assimilation_code/modules/utilities/fixsystem
index 8104f758f7..1192f9d4c0 100755
--- a/assimilation_code/modules/utilities/fixsystem
+++ b/assimilation_code/modules/utilities/fixsystem
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/bin/sh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -37,11 +37,25 @@ for f in mpi_utilities_mod.f90 null_mpi_utilities_mod.f90
do
# figure out what state the source file is in before we start
- export bline="`fgrep SYSTEM_BLOCK_EDIT ${f} | grep START | head -n 1`"
- if [ "`echo $bline | grep COMMENTED_OUT`" != "" ]; then
- export before=out
- elif [ "`echo $bline | grep COMMENTED_IN`" != "" ]; then
- export before=in
+ export bline1="`fgrep SYSTEM_BLOCK_EDIT ${f} | grep START | head -n 1`"
+ if [ "`echo $bline1 | grep COMMENTED_OUT`" != "" ]; then
+ export before1=out
+ elif [ "`echo $bline1 | grep COMMENTED_IN`" != "" ]; then
+ export before1=in
+ else
+ echo ${f} not found, or does not have the right comment string to
+ echo automatically change the system interface block via script.
+ echo Please restore original file from the subversion repository
+ echo and try again.
+ exit 1
+ fi
+
+ # NAG sections have both in and out - but NAG_BLOCK_EDIT is key
+ export bline2="`fgrep NAG_BLOCK_EDIT ${f} | grep START | head -n 1`"
+ if [ "`echo $bline2 | grep COMMENTED_OUT`" != "" ]; then
+ export before2=out
+ elif [ "`echo $bline2 | grep COMMENTED_IN`" != "" ]; then
+ export before2=in
else
echo ${f} not found, or does not have the right comment string to
echo automatically change the system interface block via script.
@@ -50,20 +64,15 @@ do
exit 1
fi
+ # no args given - error. required now.
if [ $# = 0 ]; then
- # no args given, swap to the other configuration. deprecated
- # and eventually a single argument will become required.
- if [ $before = out ]; then
- export todo=in
- export compiler=non-gfortran
- elif [ $before = in ]; then
- export todo=out
- export compiler=gfortran
- else
- echo Internal error; should not happen. Contact DART support.
+ echo invalid usage, 1 argument required by $0
+ echo "usage: $0 [ your_fortran_command_name | -help ]"
+ echo " e.g. $0 gfortran"
+ echo " or $0 ifort "
+ echo " or $0 pgf90 "
+ echo " etc."
exit 1
- fi
-
elif [ $# = 1 ]; then
# single arg: the name of your fortran compiler command
if ([ "$1" = help ] || [ "$1" = -help ] || [ "$1" = --help ]); then
@@ -74,9 +83,14 @@ do
echo " etc."
exit 1
elif ([ "$1" = gfortran ] || [ "$1" = nagfor ]); then
- export todo=out
+ export todo1=out
+ export todo2=out
+ elif [ "$1" = nagfor ]; then
+ export todo1=out
+ export todo2=in
else
- export todo=in
+ export todo1=in
+ export todo2=out
fi
export compiler=$1
@@ -92,11 +106,8 @@ do
fi
# if we are already in the right state, loop to next file
- if ([ $before = out ] && [ $todo = out ]); then continue; fi
- if ([ $before = in ] && [ $todo = in ]); then continue; fi
+ if ([ $before1 = $todo1 ] && [ $before2 = $todo2 ]); then continue; fi
- # we do have something do to
-
# save original copy for backup if one does not already exist.
if [ ! -f ${f}.orig ]; then
cp -p ${f} ${f}.orig
@@ -108,15 +119,34 @@ do
mv ${f} tempfile
# removing comment chars, enabling interface block code
- if [ $todo = in ]; then
+ if [ $todo1 = in ]; then
sed -e '/SYSTEM_BLOCK_EDIT START COMMENTED_OUT/,/SYSTEM_BLOCK_EDIT END COMMENTED_OUT/s/^!//' \
-e '/\(SYSTEM_BLOCK_EDIT [A-Z][A-Z]*\) COMMENTED_OUT/s//\1 COMMENTED_IN/' tempfile > ${f}
+ mv ${f} tempfile
fi
# adding comment chars, disabling interface block code
- if [ $todo = out ]; then
+ if [ $todo1 = out ]; then
sed -e '/SYSTEM_BLOCK_EDIT START COMMENTED_IN/,/SYSTEM_BLOCK_EDIT END COMMENTED_IN/s/^/!/' \
-e '/\(SYSTEM_BLOCK_EDIT [A-Z][A-Z]*\) COMMENTED_IN/s//\1 COMMENTED_OUT/' tempfile > ${f}
+ mv ${f} tempfile
+ fi
+
+ # changing comment chars, enabling NAG specific block code
+ # non-nag section headers cannot match nag headers.
+ if [ $todo2 = in ]; then
+ sed -e '/NAG_BLOCK_EDIT START COMMENTED_OUT/,/NAG_BLOCK_EDIT END COMMENTED_OUT/s/^!//' \
+ -e '/\(NAG_BLOCK_EDIT [A-Z][A-Z]*\) COMMENTED_OUT/s//\1 COMMENTED_IN/' \
+ -e '/OTHER_BLOCK_EDIT START COMMENTED_IN/,/OTHER_BLOCK_EDIT END COMMENTED_IN/s/^/!/' \
+ -e '/\(OTHER_BLOCK_EDIT [A-Z][A-Z]*\) COMMENTED_IN/s//\1 COMMENTED_OUT/' tempfile > ${f}
+ fi
+
+ # changing comment chars, disabling NAG specific block code
+ if [ $todo2 = out ]; then
+ sed -e '/NAG_BLOCK_EDIT START COMMENTED_IN/,/NAG_BLOCK_EDIT END COMMENTED_IN/s/^/!/' \
+ -e '/\(NAG_BLOCK_EDIT [A-Z][A-Z]*\) COMMENTED_IN/s//\1 COMMENTED_OUT/' \
+ -e '/OTHER_BLOCK_EDIT START COMMENTED_OUT/,/OTHER_BLOCK_EDIT END COMMENTED_OUT/s/^!//' \
+ -e '/\(OTHER_BLOCK_EDIT [A-Z][A-Z]*\) COMMENTED_OUT/s//\1 COMMENTED_IN/' tempfile > ${f}
fi
\rm -f tempfile
diff --git a/assimilation_code/modules/utilities/mpi_utilities_mod.f90 b/assimilation_code/modules/utilities/mpi_utilities_mod.f90
index 56dbfadc2a..27f5e070db 100644
--- a/assimilation_code/modules/utilities/mpi_utilities_mod.f90
+++ b/assimilation_code/modules/utilities/mpi_utilities_mod.f90
@@ -39,11 +39,10 @@ module mpi_utilities_mod
use mpi
! the NAG compiler needs these special definitions enabled
-! but we don't preprocess this file (why?) so you have to
-! edit this by hand for NAG.
-!#ifdef __NAG__
- !use F90_unix_proc, only : sleep, system, exit
+! !!NAG_BLOCK_EDIT START COMMENTED_OUT
+! !#ifdef __NAG__
+! use F90_unix_proc, only : sleep, system, exit
!! block for NAG compiler
! PURE SUBROUTINE SLEEP(SECONDS,SECLEFT)
! INTEGER,INTENT(IN) :: SECONDS
@@ -57,7 +56,8 @@ module mpi_utilities_mod
! SUBROUTINE EXIT(STATUS)
! INTEGER,OPTIONAL :: STATUS
!! end block
-!#endif
+! !#endif
+! !!NAG_BLOCK_EDIT END COMMENTED_OUT
implicit none
private
@@ -73,6 +73,7 @@ module mpi_utilities_mod
! block below. Please leave the BLOCK comment lines unchanged.
! !!SYSTEM_BLOCK_EDIT START COMMENTED_OUT
+! !#if .not. defined (__GFORTRAN__) .and. .not. defined(__NAG__)
! ! interface block for getting return code back from system() routine
! interface
! function system(string)
@@ -81,6 +82,7 @@ module mpi_utilities_mod
! end function system
! end interface
! ! end block
+! !#endif
! !!SYSTEM_BLOCK_EDIT END COMMENTED_OUT
@@ -111,18 +113,20 @@ module mpi_utilities_mod
all_reduce_min_max ! deprecated, replace by broadcast_minmax
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
logical :: module_initialized = .false.
-character(len = 129) :: saved_progname = ''
-character(len = 129) :: shell_name = '' ! if needed, add ksh, tcsh, bash, etc
+character(len = 256) :: saved_progname = ''
+character(len = 128) :: shell_name = '' ! if needed, add ksh, tcsh, bash, etc
integer :: head_task = 0 ! def 0, but N-1 if reverse_task_layout true
logical :: print4status = .true. ! minimal messages for async4 handshake
+logical :: given_communicator = .false. ! if communicator passed in, use it
+
character(len = 256) :: errstring, errstring1
! for broadcasts, pack small messages into larger ones. remember that the
@@ -167,7 +171,7 @@ module mpi_utilities_mod
! NAMELIST: change the following from .false. to .true. to enable
! the reading of this namelist. This is the only place you need
! to make this change.
-logical :: use_namelist = .false.
+logical :: read_namelist = .false.
namelist /mpi_utilities_nml/ reverse_task_layout, all_tasks_print, &
verbose, async2_verbose, async4_verbose, &
@@ -180,17 +184,20 @@ module mpi_utilities_mod
! mpi cover routines
!-----------------------------------------------------------------------------
-subroutine initialize_mpi_utilities(progname, alternatename)
- character(len=*), intent(in), optional :: progname
- character(len=*), intent(in), optional :: alternatename
+!-----------------------------------------------------------------------------
+
+!> Initialize MPI and query it for global information. Make a duplicate
+!> communicator so that any user code which wants to call MPI will not
+!> interfere with any outstanding asynchronous requests, accidental tag
+!> matches, etc. This routine must be called before any other routine in
+!> this file, and it should not be called more than once (but it does have
+!> defensive code in case that happens.)
+subroutine initialize_mpi_utilities(progname, alternatename, communicator)
-! Initialize MPI and query it for global information. Make a duplicate
-! communicator so that any user code which wants to call MPI will not
-! interfere with any outstanding asynchronous requests, accidental tag
-! matches, etc. This routine must be called before any other routine in
-! this file, and it should not be called more than once (but it does have
-! defensive code in case that happens.)
+character(len=*), intent(in), optional :: progname
+character(len=*), intent(in), optional :: alternatename
+integer, intent(in), optional :: communicator
integer :: errcode, iunit
logical :: already
@@ -202,6 +209,10 @@ subroutine initialize_mpi_utilities(progname, alternatename)
return
endif
+! prevent any other code from calling into this init
+! routine and causing overlapping code execution
+module_initialized = .true.
+
! some implementations of mpich need this to happen before any I/O is done.
! this makes the startup sequence very tricky.
! still, allow for the possibility that the user code has already initialized
@@ -220,17 +231,21 @@ subroutine initialize_mpi_utilities(progname, alternatename)
endif
endif
-call MPI_Comm_rank(MPI_COMM_WORLD, myrank, errcode)
+if (.not. present(communicator)) then
+ ! give this a temporary initial value, in case we call the abort code.
+ ! later we will dup the world comm and use a private comm for our comms.
+ my_local_comm = MPI_COMM_WORLD
+else
+ my_local_comm = communicator
+ given_communicator = .true.
+endif
+
+call MPI_Comm_rank(my_local_comm, myrank, errcode)
if (errcode /= MPI_SUCCESS) then
write(*, *) 'MPI_Comm_rank returned error code ', errcode
call exit(-99)
endif
-! give this a temporary initial value, in case we call the abort code.
-! later down, we will dup the world comm and use a private comm for
-! our communication.
-my_local_comm = MPI_COMM_WORLD
-
! pass the arguments through so the utilities can log the program name
! only PE0 gets to output, whenever possible.
if (myrank == 0) then
@@ -249,25 +264,23 @@ subroutine initialize_mpi_utilities(progname, alternatename)
endif
endif
-if ( .not. module_initialized ) then
- ! Initialize the module with utilities
- call register_module(source, revision, revdate)
- module_initialized = .true.
-endif
+! if logging, add this info to the log
+! (must come after regular utils are initialized)
+call register_module(source, revision, revdate)
! this must come AFTER the standard utils are initialized.
! Read the DART namelist for the mpi_utilities.
-if (use_namelist) then
+if (read_namelist) then
call find_namelist_in_file('input.nml', 'mpi_utilities_nml', iunit)
read(iunit, nml = mpi_utilities_nml, iostat = errcode)
call check_namelist_read(iunit, errcode, "mpi_utilities_nml")
else
- errstring = ' !must edit mpi_utilities/mpi_utilities_mod.f90 to enable this namelist'
+ errstring = ' !must edit assimilation_code/modules/utilities/mpi_utilities_mod.f90 to enable this namelist'
if (do_nml_file()) write(nmlfileunit, '(A)') trim(errstring)
if (do_nml_term()) write( * , '(A)') trim(errstring)
endif
-! Record the namelist values used for the run ...
+! Record the namelist values used for the run
if (do_nml_file()) write(nmlfileunit, nml=mpi_utilities_nml)
if (do_nml_term()) write( * , nml=mpi_utilities_nml)
@@ -275,7 +288,7 @@ subroutine initialize_mpi_utilities(progname, alternatename)
! duplicate the world communicator to isolate us from any other user
! calls to MPI. All subsequent mpi calls here will use the local communicator
! and not the global world comm.
-if (create_local_comm) then
+if (.not. given_communicator .and. create_local_comm) then
call MPI_Comm_dup(MPI_COMM_WORLD, my_local_comm, errcode)
if (errcode /= MPI_SUCCESS) then
write(errstring, '(a,i8)') 'MPI_Comm_dup returned error code ', errcode
@@ -366,16 +379,16 @@ end subroutine initialize_mpi_utilities
!-----------------------------------------------------------------------------
+!> Shut down MPI cleanly. This must be done before the program exits; on
+!> some implementations of MPI the final I/O flushes are not done until this
+!> is called. The optional argument can prevent us from calling MPI_Finalize,
+!> so that user code can continue to use MPI after this returns. Calling other
+!> routines in this file after calling finalize will invalidate your warranty.
+
subroutine finalize_mpi_utilities(callfinalize, async)
logical, intent(in), optional :: callfinalize
integer, intent(in), optional :: async
-! Shut down MPI cleanly. This must be done before the program exits; on
-! some implementations of MPI the final I/O flushes are not done until this
-! is called. The optional argument can prevent us from calling MPI_Finalize,
-! so that user code can continue to use MPI after this returns. Calling other
-! routines in this file after calling finalize will invalidate your warranty.
-
integer :: errcode
logical :: dofinalize
@@ -402,12 +415,15 @@ subroutine finalize_mpi_utilities(callfinalize, async)
! close down at the same time.
call task_sync()
-! Release the private communicator we created at init time.
-if (my_local_comm /= MPI_COMM_WORLD) then
- call MPI_Comm_free(my_local_comm, errcode)
- if (errcode /= MPI_SUCCESS) then
- write(errstring, '(a,i8)') 'MPI_Comm_free returned error code ', errcode
- call error_handler(E_ERR,'finalize_mpi_utilities', errstring, source, revision, revdate)
+if (.not. given_communicator) then
+ ! Release the private communicator we created at init time.
+ if (my_local_comm /= MPI_COMM_WORLD) then
+ call MPI_Comm_free(my_local_comm, errcode)
+ if (errcode /= MPI_SUCCESS) then
+ write(errstring, '(a,i8)') 'MPI_Comm_free returned error code ', errcode
+ call error_handler(E_ERR,'finalize_mpi_utilities', errstring, &
+ source, revision, revdate)
+ endif
endif
my_local_comm = MPI_COMM_WORLD
endif
@@ -440,10 +456,10 @@ end subroutine finalize_mpi_utilities
!-----------------------------------------------------------------------------
-function task_count()
+!> Return the total number of MPI tasks. e.g. if the number of tasks is 4,
+!> it returns 4. (The actual task numbers are 0-3.)
-! Return the total number of MPI tasks. e.g. if the number of tasks is 4,
-! it returns 4. (The actual task numbers are 0-3.)
+function task_count()
integer :: task_count
@@ -459,10 +475,10 @@ end function task_count
!-----------------------------------------------------------------------------
-function my_task_id()
+!> Return my unique task id. Values run from 0 to N-1 (where N is the
+!> total number of MPI tasks.
-! Return my unique task id. Values run from 0 to N-1 (where N is the
-! total number of MPI tasks.
+function my_task_id()
integer :: my_task_id
@@ -478,10 +494,10 @@ end function my_task_id
!-----------------------------------------------------------------------------
-subroutine task_sync()
+!> Synchronize all tasks. This subroutine does not return until all tasks
+!> execute this line of code.
-! Synchronize all tasks. This subroutine does not return until all tasks
-! execute this line of code.
+subroutine task_sync()
integer :: errcode
@@ -504,18 +520,18 @@ end subroutine task_sync
!-----------------------------------------------------------------------------
+!> Send the srcarray to the destination id.
+!> If time is specified, it is also sent in a separate communications call.
+!> This is a synchronous call; it will not return until the destination has
+!> called receive to accept the data. If the send_to/receive_from calls are
+!> not paired correctly the code will hang.
+
subroutine send_to(dest_id, srcarray, time, label)
integer, intent(in) :: dest_id
real(r8), intent(in) :: srcarray(:)
type(time_type), intent(in), optional :: time
character(len=*), intent(in), optional :: label
-! Send the srcarray to the destination id.
-! If time is specified, it is also sent in a separate communications call.
-! This is a synchronous call; it will not return until the destination has
-! called receive to accept the data. If the send_to/receive_from calls are
-! not paired correctly the code will hang.
-
integer :: tag, errcode
integer :: itime(2)
integer :: itemcount, offset, nextsize
@@ -626,18 +642,18 @@ end subroutine send_to
!-----------------------------------------------------------------------------
+!> Receive data into the destination array from the src task.
+!> If time is specified, it is received in a separate communications call.
+!> This is a synchronous call; it will not return until the source has
+!> sent the data. If the send_to/receive_from calls are not paired correctly
+!> the code will hang.
+
subroutine receive_from(src_id, destarray, time, label)
integer, intent(in) :: src_id
real(r8), intent(inout) :: destarray(:)
type(time_type), intent(out), optional :: time
character(len=*), intent(in), optional :: label
-! Receive data into the destination array from the src task.
-! If time is specified, it is received in a separate communications call.
-! This is a synchronous call; it will not return until the source has
-! sent the data. If the send_to/receive_from calls are not paired correctly
-! the code will hang.
-
integer :: tag, errcode
integer :: itime(2)
integer :: status(MPI_STATUS_SIZE)
@@ -755,39 +771,19 @@ subroutine receive_from(src_id, destarray, time, label)
end subroutine receive_from
-
!-----------------------------------------------------------------------------
-! TODO: do i need to overload this for both integer and real?
-! do i need to handle 1D, 2D, 3D inputs?
-
-subroutine transpose_array
-
-! not implemented here yet. will have arguments -- several of them.
-
-if ( .not. module_initialized ) then
- write(errstring, *) 'initialize_mpi_utilities() must be called first'
- call error_handler(E_ERR,'transpose_array', errstring, source, revision, revdate)
-endif
-
-write(errstring, *) 'not implemented yet'
-call error_handler(E_ERR,'transpose_array', errstring, source, revision, revdate)
-
-end subroutine transpose_array
+! NOTE: so far we only seem to be sending real data, not integer, and 1D arrays.
+! this could be overloaded to send 2D arrays, and ints if needed.
-
-!-----------------------------------------------------------------------------
-! TODO: do i need to overload this for both integer and real?
-! do i need to handle 2D inputs?
+!> The data array values on the root task will be broadcast to every other
+!> task. When this routine returns, all tasks will have the contents of the
+!> root array in their own arrays. Thus 'array' is intent(in) on root, and
+!> intent(out) on all other tasks.
subroutine array_broadcast(array, root)
real(r8), intent(inout) :: array(:)
integer, intent(in) :: root
-! The data array values on the root task will be broadcast to every other
-! task. When this routine returns, all tasks will have the contents of the
-! root array in their own arrays. Thus 'array' is intent(in) on root, and
-! intent(out) on all other tasks.
-
integer :: itemcount, errcode, offset, nextsize
real(r8), allocatable :: tmpdata(:)
@@ -863,131 +859,14 @@ subroutine array_broadcast(array, root)
end subroutine array_broadcast
-!-----------------------------------------------------------------------------
-! TODO: do i need to overload this for both integer and real?
-! do i need to handle 2D inputs?
-
-subroutine array_distribute(srcarray, root, dstarray, dstcount, how, which)
- real(r8), intent(in) :: srcarray(:)
- integer, intent(in) :: root
- real(r8), intent(out) :: dstarray(:)
- integer, intent(out) :: dstcount
- integer, intent(in) :: how
- integer, intent(out) :: which(:)
-
-! 'srcarray' on the root task will be distributed across all the tasks
-! into 'dstarray'. dstarray must be large enough to hold each task's share
-! of the data. The actual number of values returned on each task will be
-! passed back in the 'count' argument. 'how' is a flag to select how to
-! distribute the data (round-robin, contiguous chunks, etc). 'which' is an
-! integer index array which lists which of the original values were selected
-! and put into 'dstarray'.
-
-real(r8), allocatable :: localchunk(:)
-integer :: srccount, leftover
-integer :: i, tag, errcode
-logical :: iamroot
-integer :: status(MPI_STATUS_SIZE)
-
-if ( .not. module_initialized ) then
- write(errstring, *) 'initialize_mpi_utilities() must be called first'
- call error_handler(E_ERR,'array_distribute', errstring, source, revision, revdate)
-endif
-
-! simple idiotproofing
-if ((root < 0) .or. (root >= total_tasks)) then
- write(errstring, '(a,i8,a,i8)') "root task id ", root, &
- "must be >= 0 and < ", total_tasks
- call error_handler(E_ERR,'array_broadcast', errstring, source, revision, revdate)
-endif
-
-iamroot = (root == myrank)
-tag = 1
-
-srccount = size(srcarray)
-
-! TODO: right now this code does contig chunks only
-! TODO: it should select on the 'how' argument
-dstcount = srccount / total_tasks
-leftover = srccount - (dstcount * total_tasks)
-if (myrank == total_tasks-1) dstcount = dstcount + leftover
-
-
-! idiotproofing, continued...
-if (size(dstarray) < dstcount) then
- write(errstring, '(a,i8,a,i8)') "size of dstarray is", size(dstarray), &
- " but must be >= ", dstcount
- call error_handler(E_ERR,'array_broadcast', errstring, source, revision, revdate)
-endif
-if (size(which) < dstcount) then
- write(errstring, '(a,i8,a,i8)') "size of which is", size(which), &
- " but must be >= ", dstcount
- call error_handler(E_ERR,'array_broadcast', errstring, source, revision, revdate)
-endif
-
-! TODO: this code is separate from the 'dstcount' computation because we
-! need to test to be sure the user has passed us in arrays large enough to
-! hold the data, but then this section needs to have a select (how) and set
-! the corresponding index numbers accordingly.
-which(1:dstcount) = (/ (i, i= myrank *dstcount, (myrank+1)*dstcount - 1) /)
-if (size(which) > dstcount) which(dstcount+1:) = -1
-
-
-if (.not.iamroot) then
-
- ! my task is receiving data.
- call MPI_Recv(dstarray, dstcount, datasize, root, MPI_ANY_TAG, &
- my_local_comm, status, errcode)
- if (errcode /= MPI_SUCCESS) then
- write(errstring, '(a,i8)') 'MPI_Recv returned error code ', errcode
- call error_handler(E_ERR,'array_broadcast', errstring, source, revision, revdate)
- endif
-
-else
- ! my task must send to everyone else and copy to myself.
- allocate(localchunk(dstcount), stat=errcode)
- if (errcode /= 0) then
- write(errstring, *) 'allocation error of allocatable array'
- call error_handler(E_ERR,'array_broadcast', errstring, source, revision, revdate)
- endif
-
- do i=0, total_tasks-1
- ! copy correct data from srcarray to localchunk for each destination
- if (i == myrank) then
- ! this is my task, so do a copy from localchunk to dstarray
- dstarray(1:dstcount) = localchunk(1:dstcount)
- else
- ! call MPI to send the data to the remote task
- call MPI_Ssend(localchunk, dstcount, datasize, i, tag, &
- my_local_comm, errcode)
- if (errcode /= MPI_SUCCESS) then
- write(errstring, '(a,i8)') 'MPI_Ssend returned error code ', errcode
- call error_handler(E_ERR,'array_broadcast', errstring, source, revision, revdate)
- endif
- endif
- tag = tag + 1
- enddo
-
- deallocate(localchunk, stat=errcode)
- if (errcode /= 0) then
- write(errstring, *) 'deallocation error of allocatable array'
- call error_handler(E_ERR,'array_broadcast', errstring, source, revision, revdate)
- endif
-endif
-
-! set any additional space which wasn't filled with zeros.
-if (size(dstarray) > dstcount) dstarray(dstcount+1:) = 0.0
-
-end subroutine array_distribute
-
!-----------------------------------------------------------------------------
! DART-specific cover utilities
!-----------------------------------------------------------------------------
-function iam_task0()
+!> Return .TRUE. if my local task id is 0, .FALSE. otherwise.
+!> (Task numbers in MPI start at 0, contrary to the rules of polite fortran.)
-! Return .TRUE. if my local task id is 0, .FALSE. otherwise.
-! (Task numbers in MPI start at 0, contrary to the rules of polite fortran.)
+function iam_task0()
logical :: iam_task0
@@ -1001,23 +880,24 @@ function iam_task0()
end function iam_task0
!-----------------------------------------------------------------------------
+
+!> this must be paired with the same number of broadcast_recv()s on all
+!> other tasks. it will not return until all tasks in the communications
+!> group have made the call.
+!>
+!> cover routine for array broadcast. one additional sanity check -- make
+!> sure the 'from' matches my local task id. also, these arrays are
+!> intent(in) here, but they call a routine which is intent(inout) so they
+!> must be the same here.
+
subroutine broadcast_send(from, array1, array2, array3, array4, array5, &
scalar1, scalar2, scalar3, scalar4, scalar5)
integer, intent(in) :: from
- ! really only intent(in) here, but must match array_broadcast() call.
+! arrays are really only intent(in) here, but must match array_broadcast() call.
real(r8), intent(inout) :: array1(:)
real(r8), intent(inout), optional :: array2(:), array3(:), array4(:), array5(:)
real(r8), intent(inout), optional :: scalar1, scalar2, scalar3, scalar4, scalar5
-! this must be paired with the same number of broadcast_recv()s on all
-! other tasks. it will not return until all tasks in the communications
-! group have made the call.
-
-! cover routine for array broadcast. one additional sanity check -- make
-! sure the 'from' matches my local task id. also, these arrays are
-! intent(in) here, but they call a routine which is intent(inout) so they
-! must be the same here.
-
real(r8) :: packbuf1(PACKLIMIT1), packbuf2(PACKLIMIT2)
real(r8) :: local(5)
logical :: doscalar, morethanone
@@ -1077,24 +957,26 @@ subroutine broadcast_send(from, array1, array2, array3, array4, array5, &
end subroutine broadcast_send
!-----------------------------------------------------------------------------
+
+!> this must be paired with a single broadcast_send() on one other task, and
+!> broadcast_recv() on all other tasks, and it must match exactly the number
+!> of args in the sending call.
+!> it will not return until all tasks in the communications group have
+!> made the call.
+!>
+!> cover routine for array broadcast. one additional sanity check -- make
+!> sure the 'from' is not the same as my local task id. these arrays are
+!> intent(out) here, but they call a routine which is intent(inout) so they
+!> must be the same here.
+
subroutine broadcast_recv(from, array1, array2, array3, array4, array5, &
scalar1, scalar2, scalar3, scalar4, scalar5)
integer, intent(in) :: from
- ! really only intent(out) here, but must match array_broadcast() call.
+! arrays are really only intent(out) here, but must match array_broadcast() call.
real(r8), intent(inout) :: array1(:)
real(r8), intent(inout), optional :: array2(:), array3(:), array4(:), array5(:)
real(r8), intent(inout), optional :: scalar1, scalar2, scalar3, scalar4, scalar5
-! this must be paired with broadcast_send() on all other tasks, and it must
-! match exactly the number of args in the sending call.
-! it will not return until all tasks in the communications group have
-! made the call.
-
-! cover routine for array broadcast. one additional sanity check -- make
-! sure the 'from' is not the same as my local task id. these arrays are
-! intent(out) here, but they call a routine which is intent(inout) so they
-! must be the same here.
-
real(r8) :: packbuf1(PACKLIMIT1), packbuf2(PACKLIMIT2)
real(r8) :: local(5)
logical :: doscalar, morethanone
@@ -1154,6 +1036,11 @@ subroutine broadcast_recv(from, array1, array2, array3, array4, array5, &
end subroutine broadcast_recv
!-----------------------------------------------------------------------------
+
+!> figure out how many items are in the specified arrays, total.
+!> also note if there's more than a single array (array1) to send,
+!> and if there are any scalars specified.
+
subroutine countup(array1, array2, array3, array4, array5, &
scalar1, scalar2, scalar3, scalar4, scalar5, &
numitems, morethanone, doscalar)
@@ -1163,10 +1050,6 @@ subroutine countup(array1, array2, array3, array4, array5, &
integer, intent(out) :: numitems
logical, intent(out) :: morethanone, doscalar
-! figure out how many items are in the specified arrays, total.
-! also note if there's more than a single array (array1) to send,
-! and if there are any scalars specified.
-
morethanone = .false.
numitems = size(array1)
@@ -1215,6 +1098,9 @@ subroutine countup(array1, array2, array3, array4, array5, &
end subroutine countup
!-----------------------------------------------------------------------------
+
+!> pack multiple small arrays into a single buffer before sending.
+
subroutine packit(buf, array1, array2, array3, array4, array5, doscalar, &
scalar1, scalar2, scalar3, scalar4, scalar5)
real(r8), intent(out) :: buf(:)
@@ -1284,6 +1170,9 @@ subroutine packit(buf, array1, array2, array3, array4, array5, doscalar, &
end subroutine packit
!-----------------------------------------------------------------------------
+
+!> unpack multiple small arrays from a single buffer after receiving.
+
subroutine unpackit(buf, array1, array2, array3, array4, array5, doscalar, &
scalar1, scalar2, scalar3, scalar4, scalar5)
real(r8), intent(in) :: buf(:)
@@ -1353,6 +1242,9 @@ subroutine unpackit(buf, array1, array2, array3, array4, array5, doscalar, &
end subroutine unpackit
!-----------------------------------------------------------------------------
+
+!> for any values specified, pack into a single array
+
subroutine packscalar(local, scalar1, scalar2, scalar3, scalar4, scalar5)
real(r8), intent(out) :: local(5)
real(r8), intent(in), optional :: scalar1, scalar2, scalar3, scalar4, scalar5
@@ -1368,6 +1260,9 @@ subroutine packscalar(local, scalar1, scalar2, scalar3, scalar4, scalar5)
end subroutine packscalar
!-----------------------------------------------------------------------------
+
+!> for any values specified, unpack from a single array
+
subroutine unpackscalar(local, scalar1, scalar2, scalar3, scalar4, scalar5)
real(r8), intent(in) :: local(5)
real(r8), intent(out), optional :: scalar1, scalar2, scalar3, scalar4, scalar5
@@ -1380,10 +1275,12 @@ subroutine unpackscalar(local, scalar1, scalar2, scalar3, scalar4, scalar5)
end subroutine unpackscalar
+!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
! overloaded global reduce routines
-! The external32 representations of the datatypes returned by MPI_TYPE_CREATE_F90_REAL/COMPLEX/INTEGER are given by the following rules.
+! The external32 representations of the datatypes returned by
+! MPI_TYPE_CREATE_F90_REAL/COMPLEX/INTEGER are given by the following rules.
! For MPI_TYPE_CREATE_F90_REAL:
!
! if (p > 33) or (r > 4931) then external32 representation
@@ -1404,6 +1301,10 @@ end subroutine unpackscalar
!
!
!-----------------------------------------------------------------------------
+
+!> take values from each task, add them, and return
+!> the sum to all tasks. integer version
+
subroutine sum_across_tasks_int4(addend, sum)
integer, intent(in) :: addend
integer, intent(out) :: sum
@@ -1411,8 +1312,6 @@ subroutine sum_across_tasks_int4(addend, sum)
integer :: errcode
integer :: localaddend(1), localsum(1)
-! cover routine for MPI all-reduce
-
if ( .not. module_initialized ) then
write(errstring, *) 'initialize_mpi_utilities() must be called first'
call error_handler(E_ERR,'sum_across_tasks', errstring, source, revision, revdate)
@@ -1434,6 +1333,10 @@ subroutine sum_across_tasks_int4(addend, sum)
end subroutine sum_across_tasks_int4
!-----------------------------------------------------------------------------
+
+!> take values from each task, add them, and return
+!> the sum to all tasks. long integer version.
+
subroutine sum_across_tasks_int8(addend, sum)
integer(i8), intent(in) :: addend
integer(i8), intent(out) :: sum
@@ -1441,8 +1344,6 @@ subroutine sum_across_tasks_int8(addend, sum)
integer :: errcode
integer(i8) :: localaddend(1), localsum(1)
-! cover routine for MPI all-reduce
-
if ( .not. module_initialized ) then
write(errstring, *) 'initialize_mpi_utilities() must be called first'
call error_handler(E_ERR,'sum_across_tasks', errstring, source, revision, revdate)
@@ -1463,6 +1364,10 @@ subroutine sum_across_tasks_int8(addend, sum)
end subroutine sum_across_tasks_int8
!-----------------------------------------------------------------------------
+
+!> take values from each task, add them, and return
+!> the sum to all tasks. real version.
+
subroutine sum_across_tasks_real(addend, sum)
real(r8), intent(in) :: addend
real(r8), intent(out) :: sum
@@ -1470,8 +1375,6 @@ subroutine sum_across_tasks_real(addend, sum)
integer :: errcode
real(r8) :: localaddend(1), localsum(1)
-! cover routine for MPI all-reduce
-
if ( .not. module_initialized ) then
write(errstring, *) 'initialize_mpi_utilities() must be called first'
call error_handler(E_ERR,'sum_across_tasks', errstring, source, revision, revdate)
@@ -1493,22 +1396,129 @@ subroutine sum_across_tasks_real(addend, sum)
end subroutine sum_across_tasks_real
!-----------------------------------------------------------------------------
-! pipe-related utilities
+
+!> Sum array items across all tasks and send
+!> results in an array of same size to one task.
+
+subroutine send_sum_to(local_val, task, global_val)
+
+real(r8), intent(in) :: local_val(:) !> addend vals on each task
+integer, intent(in) :: task !> task to collect on
+real(r8), intent(out) :: global_val(:) !> results returned only on given task
+
+integer :: errcode
+
+if ( .not. module_initialized ) then
+ write(errstring, *) 'initialize_mpi_utilities() must be called first'
+ call error_handler(E_ERR,'send_sum_to', errstring, source, revision, revdate)
+endif
+
+! collect values on a single given task
+call mpi_reduce(local_val(:), global_val(:), size(global_val), datasize, MPI_SUM, &
+ task, get_dart_mpi_comm(), errcode)
+
+end subroutine send_sum_to
+
!-----------------------------------------------------------------------------
+!> Collect global min and max values on one task.
+
+subroutine send_minmax_to(minmax, task, global_val)
+
+real(r8), intent(in) :: minmax(2) !> min max on each task
+integer, intent(in) :: task !> task to collect on
+real(r8), intent(out) :: global_val(2) !> results returned only on given task
+
+integer :: errcode
+
+if ( .not. module_initialized ) then
+ write(errstring, *) 'initialize_mpi_utilities() must be called first'
+ call error_handler(E_ERR,'send_minmax_to', errstring, source, revision, revdate)
+endif
+
+! collect values on a single given task
+call mpi_reduce(minmax(1:1), global_val(1:1), 1, datasize, MPI_MIN, task, get_dart_mpi_comm(), errcode)
+call mpi_reduce(minmax(2:2), global_val(2:2), 1, datasize, MPI_MAX, task, get_dart_mpi_comm(), errcode)
+
+end subroutine send_minmax_to
+
!-----------------------------------------------------------------------------
-subroutine block_task()
-! block by reading a named pipe file until some other task
-! writes a string into it. this ensures the task is not
-! spinning and using CPU cycles, but is asleep waiting in
-! the kernel. one subtlety with this approach is that even
-! though named pipes are created in the filesystem, they are
-! implemented in the kernel, so on a multiprocessor machine
-! the write into the pipe file must occur on the same PE as
-! the reader is waiting. see the 'wakeup_filter' program for
-! the MPI job which spreads out on all the PEs for this job
-! and writes into the file from the correct PE.
+!> cover routine which is deprecated. when all user code replaces this
+!> with broadcast_minmax(), remove this.
+
+subroutine all_reduce_min_max(min_var, max_var, num_elements)
+
+integer, intent(in) :: num_elements
+real(r8), intent(inout) :: min_var(num_elements)
+real(r8), intent(inout) :: max_var(num_elements)
+
+call broadcast_minmax(min_var, max_var, num_elements)
+
+end subroutine all_reduce_min_max
+
+!-----------------------------------------------------------------------------
+
+!> Find min and max of each element of an array, put the result on every task.
+!> Overwrites arrays min_var, max_var with the minimum and maximum for each
+!> element across all tasks.
+
+subroutine broadcast_minmax(min_var, max_var, num_elements)
+
+integer, intent(in) :: num_elements
+real(r8), intent(inout) :: min_var(num_elements)
+real(r8), intent(inout) :: max_var(num_elements)
+
+integer :: errcode
+
+if ( .not. module_initialized ) then
+ write(errstring, *) 'initialize_mpi_utilities() must be called first'
+ call error_handler(E_ERR,'broadcast_minmax', errstring, source, revision, revdate)
+endif
+
+call mpi_allreduce(MPI_IN_PLACE, min_var, num_elements, datasize, MPI_MIN, get_dart_mpi_comm(), errcode)
+call mpi_allreduce(MPI_IN_PLACE, max_var, num_elements, datasize, MPI_MAX, get_dart_mpi_comm(), errcode)
+
+end subroutine broadcast_minmax
+
+!-----------------------------------------------------------------------------
+!> Broadcast logical
+
+subroutine broadcast_flag(flag, root)
+
+logical, intent(inout) :: flag
+integer, intent(in) :: root !> relative to get_dart_mpi_comm()
+
+integer :: errcode
+
+if ( .not. module_initialized ) then
+ write(errstring, *) 'initialize_mpi_utilities() must be called first'
+ call error_handler(E_ERR,'broadcast_flag', errstring, source, revision, revdate)
+endif
+
+call MPI_Bcast(flag, 1, MPI_LOGICAL, root, my_local_comm, errcode)
+
+end subroutine broadcast_flag
+
+!-----------------------------------------------------------------------------
+! pipe-related utilities - used in 'async4' handshakes between mpi jobs
+! and scripting to allow filter and an mpi model to alternate execution.
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+
+!> block by reading a named pipe file until some other task
+!> writes a string into it. this ensures the task is not
+!> spinning and using CPU cycles, but is asleep waiting in
+!> the kernel. one subtlety with this approach is that even
+!> though named pipes are created in the filesystem, they are
+!> implemented in the kernel, so on a multiprocessor machine
+!> the write into the pipe file must occur on the same PE as
+!> the reader is waiting. see the 'wakeup_filter' program for
+!> the MPI job which spreads out on all the PEs for this job
+!> and writes into the file from the correct PE.
+
+subroutine block_task()
character(len = 32) :: fifo_name, filter_to_model, model_to_filter, non_pipe
integer :: rc
@@ -1538,12 +1548,12 @@ subroutine block_task()
if (async4_verbose) then
write(*,*) 'checking master task host'
- rc = system('echo master task running on host `hostname`'//' '//char(0))
+ rc = shell_execute('echo master task running on host `hostname`')
if (rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
endif
if (async4_verbose .or. print4status) write(*,*) 'MPI job telling script to advance model'
- rc = system('echo advance > '//trim(non_pipe)//' '//char(0))
+ rc = shell_execute('echo advance > '//trim(non_pipe))
if (async4_verbose .and. rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
endif
@@ -1552,16 +1562,16 @@ subroutine block_task()
if (async4_verbose) then
write(*,*) 'checking master task host'
- rc = system('echo master task running on host `hostname`'//' '//char(0))
+ rc = shell_execute('echo master task running on host `hostname`')
if (rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
endif
if (async4_verbose .or. print4status) write(*,*) 'MPI job telling script to advance model'
- rc = system('echo advance > '//trim(filter_to_model)//' '//char(0))
+ rc = shell_execute('echo advance > '//trim(filter_to_model))
if (async4_verbose .and. rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
if (async4_verbose) write(*,*) 'MPI job now waiting to read from lock file'
- rc = system('cat < '//trim(model_to_filter)//'> /dev/null '//char(0))
+ rc = shell_execute('cat < '//trim(model_to_filter)//'> /dev/null')
if (async4_verbose .and. rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
else
@@ -1573,24 +1583,24 @@ subroutine block_task()
if (async4_verbose) then
write(*,*) 'checking slave task host'
- rc = system('echo '//trim(fifo_name)//' accessed from host `hostname`'//' '//char(0))
+ rc = shell_execute('echo '//trim(fifo_name)//' accessed from host `hostname`')
if (rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
endif
if (async4_verbose) write(*,*) 'removing any previous lock file: '//trim(fifo_name)
- rc = system('rm -f '//trim(fifo_name)//' '//char(0))
+ rc = shell_execute('rm -f '//trim(fifo_name))
if (async4_verbose .and. rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
if (async4_verbose) write(*,*) 'made fifo, named: '//trim(fifo_name)
- rc = system('mkfifo '//trim(fifo_name)//' '//char(0))
+ rc = shell_execute('mkfifo '//trim(fifo_name))
if (async4_verbose .and. rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
if (async4_verbose) write(*,*) 'ready to read from lock file: '//trim(fifo_name)
- rc = system('cat < '//trim(fifo_name)//'> /dev/null '//char(0))
+ rc = shell_execute('cat < '//trim(fifo_name)//'> /dev/null')
if (async4_verbose .and. rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
if (async4_verbose) write(*,*) 'got response, removing lock file: '//trim(fifo_name)
- rc = system('rm -f '//trim(fifo_name)//' '//char(0))
+ rc = shell_execute('rm -f '//trim(fifo_name))
if (async4_verbose .and. rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
endif
@@ -1608,10 +1618,11 @@ subroutine block_task()
end subroutine block_task
!-----------------------------------------------------------------------------
-subroutine restart_task()
-! companion to block_task. must be called by a different executable
-! and it writes into the named pipes to restart the waiting task.
+!> companion to block_task. must be called by a different executable
+!> and it writes into the named pipes to restart the waiting task.
+
+subroutine restart_task()
character(len = 32) :: fifo_name, model_to_filter
integer :: rc
@@ -1638,12 +1649,12 @@ subroutine restart_task()
if ((myrank == head_task) .and. .not. separate_node_sync) then
if (async4_verbose) then
- rc = system('echo master task running on host `hostname`'//' '//char(0))
+ rc = shell_execute('echo master task running on host `hostname`')
if (rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
endif
if (async4_verbose .or. print4status) write(*,*) 'script telling MPI job ok to restart'
- rc = system('echo restart > '//trim(model_to_filter)//' '//char(0))
+ rc = shell_execute('echo restart > '//trim(model_to_filter))
if (async4_verbose .and. rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
else
@@ -1654,12 +1665,12 @@ subroutine restart_task()
write(fifo_name,"(a,i5.5)") "filter_lock", myrank
if (async4_verbose) then
- rc = system('echo '//trim(fifo_name)//' accessed from host `hostname`'//' '//char(0))
+ rc = shell_execute('echo '//trim(fifo_name)//' accessed from host `hostname`')
if (rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
endif
if (async4_verbose) write(*,*) 'ready to write to lock file: '//trim(fifo_name)
- rc = system('echo restart > '//trim(fifo_name)//' '//char(0))
+ rc = shell_execute('echo restart > '//trim(fifo_name))
if (async4_verbose .and. rc /= 0) write(*, *) 'system command returned nonzero rc, ', rc
endif
@@ -1667,6 +1678,9 @@ subroutine restart_task()
end subroutine restart_task
!-----------------------------------------------------------------------------
+
+!> must be called when filter is exiting so calling script knows the job is over.
+
subroutine finished_task(async)
integer, intent(in) :: async
@@ -1691,9 +1705,9 @@ subroutine finished_task(async)
if (print4status .or. verbose) write(*,*) 'MPI task telling script we are done'
if (separate_node_sync) then
- rc = system('echo finished > '//trim(non_pipe)//' '//char(0))
+ rc = shell_execute('echo finished > '//trim(non_pipe))
else
- rc = system('echo finished > '//trim(filter_to_model)//' '//char(0))
+ rc = shell_execute('echo finished > '//trim(filter_to_model))
endif
@@ -1704,121 +1718,143 @@ end subroutine finished_task
!-----------------------------------------------------------------------------
! general system util wrappers.
!-----------------------------------------------------------------------------
+
+!> Use the system() command to execute a command string.
+!> Will wait for the command to complete and returns an
+!> error code unless you end the command with & to put
+!> it into background. Function which returns the rc
+!> of the command, 0 being all is ok.
+!>
+!> allow code to test the theory that maybe the system call is
+!> not reentrant on some platforms. if serialize is set and
+!> is true, do each call serially.
+
function shell_execute(execute_string, serialize)
character(len=*), intent(in) :: execute_string
logical, intent(in), optional :: serialize
integer :: shell_execute
-! Use the system() command to execute a command string.
-! Will wait for the command to complete and returns an
-! error code unless you end the command with & to put
-! it into background. Function which returns the rc
-! of the command, 0 being all is ok.
-
-! allow code to test the theory that maybe the system call is
-! not reentrant on some platforms. if serialize is set and
-! is true, do each call serially.
-
logical :: all_at_once
integer :: errcode, dummy(1)
integer :: status(MPI_STATUS_SIZE)
- if (verbose) async2_verbose = .true.
+if (verbose) async2_verbose = .true.
- ! default to everyone running concurrently, but if set and not true,
- ! serialize the calls to system() so they do not step on each other.
- if (present(serialize)) then
- all_at_once = .not. serialize
- else
- all_at_once = .TRUE.
- endif
-
- if (async2_verbose) write(*,*) "PE", myrank, ": system string is: ", trim(execute_string)
- shell_execute = -1
+! default to everyone running concurrently, but if set and not true,
+! serialize the calls to system() so they do not step on each other.
+if (present(serialize)) then
+ all_at_once = .not. serialize
+else
+ all_at_once = .TRUE.
+endif
- ! this is the normal (default) case
- if (all_at_once) then
+if (async2_verbose) write(*,*) "PE", myrank, ": system string is: ", trim(execute_string)
+shell_execute = -1
- ! all tasks call system at the same time
- !shell_execute = system(trim(execute_string)//' '//char(0))
- shell_execute = system(trim(shell_name)//' '//trim(execute_string)//' '//char(0))
- if (async2_verbose) write(*,*) "PE", myrank, ": execution returns, rc = ", shell_execute
+! this is the normal (default) case
+if (all_at_once) then
- return
- endif
+ ! all tasks call system at the same time
+ call do_system(execute_string, shell_execute)
+ if (async2_verbose) write(*,*) "PE", myrank, ": execution returns, rc = ", shell_execute
- ! only one task at a time calls system, and all wait their turn by
- ! making each task wait for a message from the (N-1)th task.
-
- ! this is used only to signal; the value it contains is unused.
- dummy = 0
+ return
+endif
- if (myrank == 0) then
+! only one task at a time calls system, and all wait their turn by
+! making each task wait for a message from the (N-1)th task.
- ! my turn to execute
- shell_execute = system(trim(shell_name)//' '//trim(execute_string)//' '//char(0))
- if (async2_verbose) write(*,*) "PE", myrank, ": execution returns, rc = ", shell_execute
-
- if (total_tasks > 1) then
- ! tell next task it can continue
- call MPI_Send(dummy, 1, MPI_INTEGER, 1, 1, my_local_comm, errcode)
- if (errcode /= MPI_SUCCESS) then
- write(errstring, '(a,i8)') 'MPI_Send returned error code ', &
- errcode
- call error_handler(E_ERR,'shell_execute', errstring, source, &
- revision, revdate)
- endif
- endif
+! this is used only to signal; the value it contains is unused.
+dummy = 0
- else if (myrank /= (total_tasks-1)) then
- ! wait for (me-1) to tell me it is my turn
- call MPI_Recv(dummy, 1, MPI_INTEGER, myrank-1, myrank, &
- my_local_comm, status, errcode)
- if (errcode /= MPI_SUCCESS) then
- write(errstring, '(a,i8)') 'MPI_Recv returned error code ', errcode
- call error_handler(E_ERR,'shell_execute', errstring, source, &
- revision, revdate)
- endif
+if (myrank == 0) then
- ! my turn to execute
- shell_execute = system(trim(shell_name)//' '//trim(execute_string)//' '//char(0))
- if (async2_verbose) write(*,*) "PE", myrank, ": execution returns, rc = ", shell_execute
+ ! my turn to execute
+ call do_system(execute_string, shell_execute)
+ if (async2_verbose) write(*,*) "PE", myrank, ": execution returns, rc = ", shell_execute
- ! and now tell (me+1) to go
- call MPI_Send(dummy, 1, MPI_INTEGER, myrank+1, myrank+1, my_local_comm, errcode)
+ if (total_tasks > 1) then
+ ! tell next task it can continue
+ call MPI_Send(dummy, 1, MPI_INTEGER, 1, 1, my_local_comm, errcode)
if (errcode /= MPI_SUCCESS) then
write(errstring, '(a,i8)') 'MPI_Send returned error code ', &
errcode
call error_handler(E_ERR,'shell_execute', errstring, source, &
revision, revdate)
endif
- else
- ! last task, no one else to send to.
- call MPI_Recv(dummy, 1, MPI_INTEGER, myrank-1, myrank, &
- my_local_comm, status, errcode)
- if (errcode /= MPI_SUCCESS) then
- write(errstring, '(a,i8)') 'MPI_Recv returned error code ', errcode
- call error_handler(E_ERR,'shell_execute', errstring, source, &
- revision, revdate)
- endif
+ endif
- ! my turn to execute
- shell_execute = system(trim(shell_name)//' '//trim(execute_string)//' '//char(0))
- if (async2_verbose) write(*,*) "PE", myrank, ": execution returns, rc = ", shell_execute
+else if (myrank /= (total_tasks-1)) then
+ ! wait for (me-1) to tell me it is my turn
+ call MPI_Recv(dummy, 1, MPI_INTEGER, myrank-1, myrank, &
+ my_local_comm, status, errcode)
+ if (errcode /= MPI_SUCCESS) then
+ write(errstring, '(a,i8)') 'MPI_Recv returned error code ', errcode
+ call error_handler(E_ERR,'shell_execute', errstring, source, &
+ revision, revdate)
+ endif
+
+ ! my turn to execute
+ call do_system(execute_string, shell_execute)
+ if (async2_verbose) write(*,*) "PE", myrank, ": execution returns, rc = ", shell_execute
+ ! and now tell (me+1) to go
+ call MPI_Send(dummy, 1, MPI_INTEGER, myrank+1, myrank+1, my_local_comm, errcode)
+ if (errcode /= MPI_SUCCESS) then
+ write(errstring, '(a,i8)') 'MPI_Send returned error code ', &
+ errcode
+ call error_handler(E_ERR,'shell_execute', errstring, source, &
+ revision, revdate)
endif
-
+else
+ ! last task, no one else to send to.
+ call MPI_Recv(dummy, 1, MPI_INTEGER, myrank-1, myrank, &
+ my_local_comm, status, errcode)
+ if (errcode /= MPI_SUCCESS) then
+ write(errstring, '(a,i8)') 'MPI_Recv returned error code ', errcode
+ call error_handler(E_ERR,'shell_execute', errstring, source, &
+ revision, revdate)
+ endif
+
+ ! my turn to execute
+ call do_system(execute_string, shell_execute)
+ if (async2_verbose) write(*,*) "PE", myrank, ": execution returns, rc = ", shell_execute
+
+endif
end function shell_execute
!-----------------------------------------------------------------------------
+
+!> wrapper so you only have to make this work in a single place
+!> 'shell_name' is a namelist item and normally is the null string.
+!> on at least on cray system, the compute nodes only had one type
+!> of shell and you had to specify it.
+
+subroutine do_system(execute, rc)
+
+character(len=*), intent(in) :: execute
+integer, intent(out) :: rc
+
+! !!NAG_BLOCK_EDIT START COMMENTED_OUT
+! call system(trim(shell_name)//' '//trim(execute)//' '//char(0), errno=rc)
+! !!NAG_BLOCK_EDIT END COMMENTED_OUT
+! !!OTHER_BLOCK_EDIT START COMMENTED_IN
+ rc = system(trim(shell_name)//' '//trim(execute)//' '//char(0))
+! !!OTHER_BLOCK_EDIT END COMMENTED_IN
+
+end subroutine do_system
+
+!-----------------------------------------------------------------------------
+
+!> Wrapper for the sleep command. Argument is a real
+!> in seconds. Different systems have different lower
+!> resolutions for the minimum time it will sleep.
+!> Subroutine, no return value.
+
subroutine sleep_seconds(naplength)
- real(r8), intent(in) :: naplength
-! Wrapper for the sleep command. Argument is a real
-! in seconds. Different systems have different lower
-! resolutions for the minimum time it will sleep.
-! Subroutine, no return value.
+real(r8), intent(in) :: naplength
integer :: sleeptime
@@ -1874,105 +1910,16 @@ end function read_mpi_timer
!-----------------------------------------------------------------------------
+!> return our communicator
+
function get_dart_mpi_comm()
integer :: get_dart_mpi_comm
-! return our private communicator (or world, if no private created)
get_dart_mpi_comm = my_local_comm
end function get_dart_mpi_comm
!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
-! Collect sum across tasks for a given array.
-subroutine send_sum_to(local_val, task, global_val)
-
-real(r8), intent(in) :: local_val(:) !> min max on each task
-integer, intent(in) :: task !> task to collect on
-real(r8), intent(out) :: global_val(:) !> only concerned with this on task collecting result
-
-integer :: errcode
-
-if ( .not. module_initialized ) then
- write(errstring, *) 'initialize_mpi_utilities() must be called first'
- call error_handler(E_ERR,'send_sum_to', errstring, source, revision, revdate)
-endif
-
-! collect values on a single given task
-call mpi_reduce(local_val(:), global_val(:), size(global_val), datasize, MPI_SUM, task, get_dart_mpi_comm(), errcode)
-
-end subroutine send_sum_to
-
-!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
-! Collect min and max on task.
-subroutine send_minmax_to(minmax, task, global_val)
-
-real(r8), intent(in) :: minmax(2) !> min max on each task
-integer, intent(in) :: task !> task to collect on
-real(r8), intent(out) :: global_val(2) !> only concerned with this on task collecting result
-
-integer :: errcode
-
-if ( .not. module_initialized ) then
- write(errstring, *) 'initialize_mpi_utilities() must be called first'
- call error_handler(E_ERR,'send_minmax_to', errstring, source, revision, revdate)
-endif
-
-! collect values on a single given task
-call mpi_reduce(minmax(1:1), global_val(1:1), 1, datasize, MPI_MIN, task, get_dart_mpi_comm(), errcode)
-call mpi_reduce(minmax(2:2), global_val(2:2), 1, datasize, MPI_MAX, task, get_dart_mpi_comm(), errcode)
-
-end subroutine send_minmax_to
-
-!-----------------------------------------------------------------------------
-! cover routine which is deprecated. when all user code replaces this
-! with broadcast_minmax(), remove this.
-subroutine all_reduce_min_max(min_var, max_var, num_elements)
-
-integer, intent(in) :: num_elements
-real(r8), intent(inout) :: min_var(num_elements)
-real(r8), intent(inout) :: max_var(num_elements)
-
-call broadcast_minmax(min_var, max_var, num_elements)
-
-end subroutine all_reduce_min_max
-
-!-----------------------------------------------------------------------------
-! Find min and max of each element of an array, put the result on every task.
-! Overwrites arrays min_var, max_var with the minimum and maximum for each
-! element across all tasks.
-subroutine broadcast_minmax(min_var, max_var, num_elements)
-
-integer, intent(in) :: num_elements
-real(r8), intent(inout) :: min_var(num_elements)
-real(r8), intent(inout) :: max_var(num_elements)
-
-integer :: errcode
-
-if ( .not. module_initialized ) then
- write(errstring, *) 'initialize_mpi_utilities() must be called first'
- call error_handler(E_ERR,'broadcast_minmax', errstring, source, revision, revdate)
-endif
-
-!>@todo FIXME shouldn't this use datasize in a single call, like the code above?
-! call mpi_allreduce(MPI_IN_PLACE, min_var, num_elements, datasize, MPI_MIN, get_dart_mpi_comm(), errcode)
-! call mpi_allreduce(MPI_IN_PLACE, max_var, num_elements, datasize, MPI_MAX, get_dart_mpi_comm(), errcode)
-
-if (datasize == mpi_real8) then
-
- call mpi_allreduce(MPI_IN_PLACE, min_var, num_elements, mpi_real8, MPI_MIN, get_dart_mpi_comm(), errcode)
- call mpi_allreduce(MPI_IN_PLACE, max_var, num_elements, mpi_real8, MPI_MAX, get_dart_mpi_comm(), errcode)
-
-else ! single precision
-
- call mpi_allreduce(MPI_IN_PLACE, min_var, num_elements, mpi_real4, MPI_MIN, get_dart_mpi_comm(), errcode)
- call mpi_allreduce(MPI_IN_PLACE, max_var, num_elements, mpi_real4, MPI_MAX, get_dart_mpi_comm(), errcode)
-
-endif
-
-end subroutine broadcast_minmax
-
!-----------------------------------------------------------------------------
! One sided communication
@@ -1991,8 +1938,8 @@ subroutine get_from_mean(owner, window, mindex, x)
! => Don't do anything with x in between mpi_get and mpi_win_lock
! Note to programmer: openmpi 1.10.0 does not
-! allow scalars in mpi calls. openmpi 1.10.1 fixes
-! this.
+! allow scalars in mpi calls. openmpi 1.10.1 fixes this.
+
target_disp = (mindex - 1)
call mpi_win_lock(MPI_LOCK_SHARED, owner, 0, window, errcode)
call mpi_get(x, 1, datasize, owner, target_disp, 1, datasize, window, errcode)
@@ -2017,7 +1964,6 @@ subroutine get_from_fwd(owner, window, mindex, num_rows, x)
! to have occured until the call to mpi_win_unlock.
! => Don't do anything with x in between mpi_get and mpi_win_lock
-
target_disp = (mindex - 1)*num_rows
call mpi_win_lock(MPI_LOCK_SHARED, owner, 0, window, errcode)
call mpi_get(x, num_rows, datasize, owner, target_disp, num_rows, datasize, window, errcode)
@@ -2028,47 +1974,28 @@ end subroutine get_from_fwd
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
-! Broadcast logical
-subroutine broadcast_flag(flag, root)
-
-logical, intent(inout) :: flag
-integer, intent(in) :: root !> relative to get_dart_mpi_comm()
-
-integer :: errcode
-
-if ( .not. module_initialized ) then
- write(errstring, *) 'initialize_mpi_utilities() must be called first'
- call error_handler(E_ERR,'broadcast_flag', errstring, source, revision, revdate)
-endif
-
-call MPI_Bcast(flag, 1, MPI_LOGICAL, root, my_local_comm, errcode)
-
-end subroutine broadcast_flag
-
-!-----------------------------------------------------------------------------
end module mpi_utilities_mod
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
-! NOTE -- non-module code, so this subroutine can be called from the
-! utilities module, which this module uses (and cannot have circular refs)
+!> NOTE: non-module code, so this subroutine can be called from the
+!> utilities module, which this module uses (and cannot have circular refs)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
+!> In case of error, call this instead of the fortran intrinsic exit().
+!> It will signal the other MPI tasks that something bad happened and they
+!> should also exit.
+
subroutine exit_all(exit_code)
use mpi_utilities_mod, only : get_dart_mpi_comm
integer, intent(in) :: exit_code
-! In case of error, call this instead of the fortran intrinsic exit().
-! It will signal the other MPI tasks that something bad happened and they
-! should also exit.
-
integer :: ierror
-! if we made a local communicator, call abort on it.
-! otherwise call abort on the world comm.
+! call abort on our communicator
!print *, 'calling abort on comm ', get_dart_mpi_comm()
call MPI_Abort(get_dart_mpi_comm(), exit_code, ierror)
@@ -2077,6 +2004,8 @@ subroutine exit_all(exit_code)
end subroutine exit_all
+!-----------------------------------------------------------------------------
+
!
! $URL$
! $Id$
diff --git a/assimilation_code/modules/utilities/no_cray_win_mod.f90 b/assimilation_code/modules/utilities/no_cray_win_mod.f90
index 6f203861c0..42e17900cc 100644
--- a/assimilation_code/modules/utilities/no_cray_win_mod.f90
+++ b/assimilation_code/modules/utilities/no_cray_win_mod.f90
@@ -155,9 +155,11 @@ subroutine free_state_window(state_ens_handle, fwd_op_ens_handle, qc_ens_handle)
integer :: ierr
if(get_allow_transpose(state_ens_handle)) then ! the forward operators were done var complete
- !transpose back
- if (present(fwd_op_ens_handle)) call all_vars_to_all_copies(fwd_op_ens_handle)
- if (present(qc_ens_handle)) call all_vars_to_all_copies(qc_ens_handle)
+ !transpose back if present
+ if (present(fwd_op_ens_handle)) &
+ call all_vars_to_all_copies(fwd_op_ens_handle)
+ if (present(qc_ens_handle)) &
+ call all_vars_to_all_copies(qc_ens_handle)
else
! close mpi window
call mpi_win_free(state_win, ierr)
diff --git a/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90 b/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
index de7a5a7724..172b639c2c 100644
--- a/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+++ b/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
@@ -4,19 +4,29 @@
!
! $Id$
-!> A collection of interfaces that bypass calling MPI and
-!> allows programs to be compiled in a serial configuration.
-!> Uses only a single task. Does NOT require actual MPI libs.
+!> Substitute this code for mpi_utilities_mod.f90 if you do not want to
+!> have to link in an MPI library, and you only want to run single task.
+!> Many of the single task DART utility programs use this file instead of
+!> the parallel version. Note that this file has the same module name
+!> and the same external entry points as the real mpi_utilities_mod.f90
+!> file, so it will link correctly as a replacement file.
+!>
+!> Programs using this module instead of the actual MPI routines do not
+!> need to be compiled with the MPI wrapper commands (e.g. mpif90).
+!> In most cases it will be better to compile with the fortran compiler
+!> directly. (On some platforms this is required.)
module mpi_utilities_mod
-use types_mod, only : i8, r8, digits12
-use utilities_mod, only : register_module, error_handler, &
- initialize_utilities, get_unit, close_file, &
- E_ERR, E_WARN, E_MSG, E_DBG, finalize_utilities
+use types_mod, only : i8, r8, digits12
+use utilities_mod, only : register_module, error_handler, &
+ E_ERR, E_WARN, E_MSG, &
+ initialize_utilities, finalize_utilities
use time_manager_mod, only : time_type, set_time
+! the NAG compiler needs these special definitions enabled
+! !!NAG_BLOCK_EDIT START COMMENTED_OUT
!#ifdef __NAG__
!use F90_unix_proc, only : sleep, system, exit
!! block for NAG compiler
@@ -33,6 +43,7 @@ module mpi_utilities_mod
! INTEGER,OPTIONAL :: STATUS
!! end block
!#endif
+! !!NAG_BLOCK_EDIT END COMMENTED_OUT
implicit none
@@ -47,6 +58,7 @@ module mpi_utilities_mod
! block below. Please leave the BLOCK comment lines unchanged.
! !!SYSTEM_BLOCK_EDIT START COMMENTED_OUT
+! !#if .not. defined (__GFORTRAN__) .and. .not. defined(__NAG__)
! ! interface block for getting return code back from system() routine
! interface
! function system(string)
@@ -55,41 +67,47 @@ module mpi_utilities_mod
! end function system
! end interface
! ! end block
+! !#endif
! !!SYSTEM_BLOCK_EDIT END COMMENTED_OUT
+! allow global sum to be computed for integers, r4, and r8s
interface sum_across_tasks
module procedure sum_across_tasks_int4
module procedure sum_across_tasks_int8
module procedure sum_across_tasks_real
end interface
+
! ---- private data for mpi_utilities ----
-integer :: myrank ! my mpi number
-integer :: total_tasks ! total mpi tasks/procs
-integer :: comm_size ! if ens count < tasks, only the first N participate
-integer :: datasize ! should be an accessor function, not a public
+integer :: myrank = 0 ! my mpi number
+integer :: total_tasks = 1 ! total mpi tasks/procs
+integer :: my_local_comm = 0 ! duplicate communicator private to this file
+integer :: datasize = 8 ! which MPI type corresponds to our r8 definition
+
+
public :: initialize_mpi_utilities, finalize_mpi_utilities, &
task_count, my_task_id, block_task, restart_task, &
task_sync, array_broadcast, send_to, receive_from, iam_task0, &
broadcast_send, broadcast_recv, shell_execute, sleep_seconds, &
- sum_across_tasks, send_minmax_to, datasize, &
+ sum_across_tasks, get_dart_mpi_comm, datasize, send_minmax_to, &
get_from_fwd, get_from_mean, broadcast_minmax, broadcast_flag, &
start_mpi_timer, read_mpi_timer, send_sum_to, &
- all_reduce_min_max ! deprecated, replace with broadcast_minmax
+ all_reduce_min_max ! deprecated, replace by broadcast_minmax
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
-logical, save :: module_initialized = .false.
+logical :: module_initialized = .false.
-character(len = 129) :: saved_progname = ''
+character(len = 256) :: saved_progname = ''
+character(len = 128) :: shell_name = '' ! if needed, add ksh, tcsh, bash, etc
-character(len = 129) :: errstring
+character(len = 256) :: errstring
! Namelist input - placeholder for now; no options yet in this module.
!namelist /mpi_utilities_nml/ x
@@ -101,46 +119,38 @@ module mpi_utilities_mod
! mpi cover routines
!-----------------------------------------------------------------------------
-subroutine initialize_mpi_utilities(progname, alternatename)
- character(len=*), intent(in), optional :: progname
- character(len=*), intent(in), optional :: alternatename
+!> Initialize the utilities module, and print out a message including the
+!> program name.
+subroutine initialize_mpi_utilities(progname, alternatename, communicator)
-! Initialize MPI and query it for global information. Make a duplicate
-! communicator so that any user code which wants to call MPI will not
-! interfere with any outstanding asynchronous requests, accidental tag
-! matches, etc. This routine must be called before any other routine in
-! this file, and it should not be called more than once (but it does have
-! defensive code in case that happens.)
+character(len=*), intent(in), optional :: progname
+character(len=*), intent(in), optional :: alternatename
+integer, intent(in), optional :: communicator
if ( module_initialized ) then
- ! return without calling the code below multiple times
+ ! return without calling the code below multiple times. Print out a warning each
+ ! time this is called again because it may indicate an error in logic. In a well-
+ ! constructed program the initialize routine will only be called once.
write(errstring, *) 'initialize_mpi_utilities has already been called'
call error_handler(E_WARN,'initialize_mpi_utilities', errstring, source, revision, revdate)
return
endif
+module_initialized = .true.
+
+! Initialize the module with utilities
call initialize_utilities(progname, alternatename)
if (present(progname)) then
- if (len_trim(progname) < len(saved_progname)) then
+ if (len_trim(progname) <= len(saved_progname)) then
saved_progname = trim(progname)
else
saved_progname = progname(1:len(saved_progname))
endif
endif
-if ( .not. module_initialized ) then
- ! Initialize the module with utilities
- call register_module(source, revision, revdate)
- module_initialized = .true.
-endif
-
-myrank = 0
-total_tasks = 1
-
-! TODO: if there are fewer ensembles than tasks, all the collective routines
-! need to take that into account and not participate if they are > comm_size.
-comm_size = total_tasks
+! log info if requested
+call register_module(source, revision, revdate)
if (r8 /= digits12) then
datasize = 4
@@ -158,14 +168,13 @@ end subroutine initialize_mpi_utilities
!-----------------------------------------------------------------------------
+!> Shut down cleanly. Call normal utilities finalize if we have actually
+!> ever called initialize. Otherwise there is nothing to do in the null case.
+
subroutine finalize_mpi_utilities(callfinalize, async)
logical, intent(in), optional :: callfinalize
integer, intent(in), optional :: async
-! Shut down cleanly. Call normal utilities finalize if we have actually
-! ever called initialize. Otherwise there is nothing to do in the null case.
-
-
if ( .not. module_initialized ) return
if (saved_progname /= '') then
@@ -179,11 +188,9 @@ end subroutine finalize_mpi_utilities
!-----------------------------------------------------------------------------
-function task_count()
+!> Return the number of MPI tasks. For this code this is always 1.
-! Return the total number of MPI tasks. e.g. if the number of tasks is 4,
-! it returns 4. (The actual task numbers are 0-3.) For the null mpi utils,
-! this always returns 1.
+function task_count()
integer :: task_count
@@ -196,10 +203,9 @@ end function task_count
!-----------------------------------------------------------------------------
-function my_task_id()
+!> Return my unique task id. For this code this is always 0.
-! Return my unique task id. Values run from 0 to N-1 (where N is the
-! total number of MPI tasks. For the null mpi utils, this is always 0.
+function my_task_id()
integer :: my_task_id
@@ -212,112 +218,58 @@ end function my_task_id
!-----------------------------------------------------------------------------
-subroutine task_sync()
-
-! Synchronize all tasks. This subroutine does not return until all tasks
-! execute this line of code.
-
-if ( .not. module_initialized ) call initialize_mpi_utilities()
+!> A no-op for this code.
+subroutine task_sync()
end subroutine task_sync
!-----------------------------------------------------------------------------
+!> Send the srcarray to the destination task id.
+!> This communication style cannot be easily simulated correctly with one task.
+!> If called, always throw an error.
+
subroutine send_to(dest_id, srcarray, time, label)
integer, intent(in) :: dest_id
real(r8), intent(in) :: srcarray(:)
type(time_type), intent(in), optional :: time
character(len=*), intent(in), optional :: label
-! Send the srcarray to the destination id.
-! If time is specified, it is also sent in a separate communications call.
-! This is a synchronous call; it will not return until the destination has
-! called receive to accept the data. If the send_to/receive_from calls are
-! not paired correctly the code will hang.
-
-if ( .not. module_initialized ) call initialize_mpi_utilities()
-
-! simple idiotproofing
-if ((dest_id < 0) .or. (dest_id >= total_tasks)) then
- write(errstring, '(a,i8,a,i8)') "destination task id ", dest_id, &
- "must be >= 0 and < ", total_tasks
- call error_handler(E_ERR,'send_to', errstring, source, revision, revdate)
-endif
-
-! this style cannot be easily simulated correctly with one task.
-! always throw an error.
write(errstring, '(a)') "cannot call send_to() in the single process case"
-call error_handler(E_ERR,'send_to', errstring, source, revision, revdate)
+ call error_handler(E_ERR,'send_to', errstring, source, revision, revdate)
end subroutine send_to
!-----------------------------------------------------------------------------
+!> Receive the dstarray from the source task id.
+!> This communication style cannot be easily simulated correctly with one task.
+!> If called, always throw an error.
+
subroutine receive_from(src_id, destarray, time, label)
integer, intent(in) :: src_id
real(r8), intent(out) :: destarray(:)
type(time_type), intent(out), optional :: time
character(len=*), intent(in), optional :: label
-! Receive data into the destination array from the src task.
-! If time is specified, it is received in a separate communications call.
-! This is a synchronous call; it will not return until the source has
-! sent the data. If the send_to/receive_from calls are not paired correctly
-! the code will hang.
-
-if ( .not. module_initialized ) call initialize_mpi_utilities()
-
-! simple idiotproofing
-if ((src_id < 0) .or. (src_id >= total_tasks)) then
- write(errstring, '(a,i8,a,i8)') "source task id ", src_id, &
- "must be >= 0 and < ", total_tasks
- call error_handler(E_ERR,'receive_from', errstring, source, revision, revdate)
-endif
-
-! this style cannot be easily simulated correctly with one task.
-! always throw an error.
write(errstring, '(a)') "cannot call receive_from() in the single process case"
-call error_handler(E_ERR,'receive_from', errstring, source, revision, revdate)
-
-destarray = 0
-if (present(time)) time = set_time(0, 0)
+ call error_handler(E_ERR,'receive_from', errstring, source, revision, revdate)
end subroutine receive_from
!-----------------------------------------------------------------------------
-! TODO: do i need to overload this for both integer and real?
-! do i need to handle 1D, 2D, 3D inputs?
-subroutine transpose_array
-
-! not implemented here yet. will have arguments -- several of them.
-
-if ( .not. module_initialized ) call initialize_mpi_utilities()
-
-write(errstring, *) 'not implemented yet'
-call error_handler(E_ERR,'transpose_array', errstring, source, revision, revdate)
-
-end subroutine transpose_array
-
-
-!-----------------------------------------------------------------------------
-! TODO: do i need to overload this for both integer and real?
-! do i need to handle 2D inputs?
+!> The array already has the values, nothing to do. Not an error to call.
subroutine array_broadcast(array, root)
real(r8), intent(inout) :: array(:)
integer, intent(in) :: root
-! The data array values on the root task will be broadcast to every other
-! task. When this routine returns, all tasks will have the contents of the
-! root array in their own arrays. Thus 'array' is intent(in) on root, and
-! intent(out) on all other tasks.
-
if ( .not. module_initialized ) call initialize_mpi_utilities()
! simple idiotproofing
@@ -327,56 +279,20 @@ subroutine array_broadcast(array, root)
call error_handler(E_ERR,'array_broadcast', errstring, source, revision, revdate)
endif
-! array already has the values, nothing to do.
+! Data is already in array, so you can return here.
end subroutine array_broadcast
-!-----------------------------------------------------------------------------
-! TODO: do i need to overload this for both integer and real?
-! do i need to handle 2D inputs?
-
-subroutine array_distribute(srcarray, root, dstarray, dstcount, how, which)
-real(r8), intent(in) :: srcarray(:)
-integer, intent(in) :: root
-real(r8), intent(out) :: dstarray(:)
-integer, intent(out) :: dstcount
-integer, intent(in) :: how
-integer, intent(out) :: which(:)
-
-! 'srcarray' on the root task will be distributed across all the tasks
-! into 'dstarray'. dstarray must be large enough to hold each task's share
-! of the data. The actual number of values returned on each task will be
-! passed back in the 'count' argument. 'how' is a flag to select how to
-! distribute the data (round-robin, contiguous chunks, etc). 'which' is an
-! integer index array which lists which of the original values were selected
-! and put into 'dstarray'.
-
-integer :: i
-
-if ( .not. module_initialized ) call initialize_mpi_utilities()
-
-! simple idiotproofing
-if ((root < 0) .or. (root >= total_tasks)) then
- write(errstring, '(a,i8,a,i8)') "root task id ", root, &
- "must be >= 0 and < ", total_tasks
- call error_handler(E_ERR,'array_broadcast', errstring, source, revision, revdate)
-endif
-
-dstarray = srcarray
-dstcount = size(srcarray)
-which = (/ ((i), i=1,size(srcarray)) /)
-
-end subroutine array_distribute
-
!-----------------------------------------------------------------------------
! DART-specific cover utilities
!-----------------------------------------------------------------------------
-function iam_task0()
+!> Return .TRUE. if my local task id is 0, .FALSE. otherwise.
+!> (Task numbers in MPI start at 0, contrary to the rules of polite fortran.)
+!> This version always returns .TRUE. since there is only a single task ever.
-! Return .TRUE. if my local task id is 0, .FALSE. otherwise.
-! (Task numbers in MPI start at 0, contrary to the rules of polite fortran.)
+function iam_task0()
logical :: iam_task0
@@ -387,19 +303,18 @@ function iam_task0()
end function iam_task0
!-----------------------------------------------------------------------------
+
+!> Returns with nothing to do. Does validate the 'from' task id.
+!> Not an error to call.
+
subroutine broadcast_send(from, array1, array2, array3, array4, array5, &
scalar1, scalar2, scalar3, scalar4, scalar5)
integer, intent(in) :: from
- ! really only intent(in) here, but must match array_broadcast() call.
+! arrays are really only intent(in) here, but must match array_broadcast() call.
real(r8), intent(inout) :: array1(:)
real(r8), intent(inout), optional :: array2(:), array3(:), array4(:), array5(:)
real(r8), intent(inout), optional :: scalar1, scalar2, scalar3, scalar4, scalar5
-! cover routine for array broadcast. one additional sanity check -- make
-! sure the 'from' matches my local task id. also, these arrays are
-! intent(in) here, but they call a routine which is intent(inout) so they
-! must be the same here.
-
if ( .not. module_initialized ) call initialize_mpi_utilities()
! simple idiotproofing
@@ -416,19 +331,18 @@ subroutine broadcast_send(from, array1, array2, array3, array4, array5, &
end subroutine broadcast_send
!-----------------------------------------------------------------------------
+
+!> Returns with nothing to do. Does validate the 'from' task id.
+!> Not an error to call.
+
subroutine broadcast_recv(from, array1, array2, array3, array4, array5, &
scalar1, scalar2, scalar3, scalar4, scalar5)
integer, intent(in) :: from
- ! really only intent(out) here, but must match array_broadcast() call.
+! arrays are really only intent(out) here, but must match array_broadcast() call.
real(r8), intent(inout) :: array1(:)
real(r8), intent(inout), optional :: array2(:), array3(:), array4(:), array5(:)
real(r8), intent(inout), optional :: scalar1, scalar2, scalar3, scalar4, scalar5
-! cover routine for array broadcast. one additional sanity check -- make
-! sure the 'from' is not the same as my local task id. these arrays are
-! intent(out) here, but they call a routine which is intent(inout) so they
-! must be the same here.
-
if ( .not. module_initialized ) call initialize_mpi_utilities()
! simple idiotproofing
@@ -445,6 +359,8 @@ subroutine broadcast_recv(from, array1, array2, array3, array4, array5, &
end subroutine broadcast_recv
!-----------------------------------------------------------------------------
+!> return sum for various input types/kinds
+
subroutine sum_across_tasks_int4(addend, sum)
integer, intent(in) :: addend
integer, intent(out) :: sum
@@ -454,8 +370,9 @@ subroutine sum_across_tasks_int4(addend, sum)
end subroutine sum_across_tasks_int4
!-----------------------------------------------------------------------------
+
subroutine sum_across_tasks_int8(addend, sum)
- integer(i8), intent(in) :: addend
+ integer(i8), intent(in) :: addend
integer(i8), intent(out) :: sum
sum = addend
@@ -463,6 +380,7 @@ subroutine sum_across_tasks_int8(addend, sum)
end subroutine sum_across_tasks_int8
!-----------------------------------------------------------------------------
+
subroutine sum_across_tasks_real(addend, sum)
real(r8), intent(in) :: addend
real(r8), intent(out) :: sum
@@ -471,26 +389,93 @@ subroutine sum_across_tasks_real(addend, sum)
end subroutine sum_across_tasks_real
+!-----------------------------------------------------------------------------
+
+!> Sum array items across all tasks and send
+!> results in an array of same size to one task.
+
+subroutine send_sum_to(local_val, task, global_val)
+
+real(r8), intent(in) :: local_val(:) !> addend vals on each task
+integer, intent(in) :: task !> task to collect on
+real(r8), intent(out) :: global_val(:) !> results returned only on given task
+
+global_val(:) = local_val(:) ! only one task.
+
+end subroutine send_sum_to
+
+!-----------------------------------------------------------------------------
+
+!> Collect min and max on task.
+
+subroutine send_minmax_to(minmax, task, global_val)
+
+real(r8), intent(in) :: minmax(2) !> min max on each task
+integer, intent(in) :: task !> task to collect on
+real(r8), intent(out) :: global_val(2) !> results returned only on given task
+
+global_val(:) = minmax(:) ! only one task.
+
+end subroutine send_minmax_to
+
+!-----------------------------------------------------------------------------
+
+!> cover routine which is deprecated. when all user code replaces this
+!> with broadcast_minmax(), remove this.
+
+subroutine all_reduce_min_max(min_var, max_var, num_elements)
+
+integer, intent(in) :: num_elements
+real(r8), intent(inout) :: min_var(num_elements)
+real(r8), intent(inout) :: max_var(num_elements)
+
+call broadcast_minmax(min_var, max_var, num_elements)
+
+end subroutine all_reduce_min_max
+
+!-----------------------------------------------------------------------------
+
+!> Find min and max of each element of an array across tasks, put the result on every task.
+!> For this null_mpi_version min_var and max_var are unchanged because there is
+!> only 1 task.
+
+subroutine broadcast_minmax(min_var, max_var, num_elements)
+
+integer, intent(in) :: num_elements
+real(r8), intent(inout) :: min_var(num_elements)
+real(r8), intent(inout) :: max_var(num_elements)
+
+end subroutine broadcast_minmax
+
+!-----------------------------------------------------------------------------
+
+!> Broadcast logical
+
+subroutine broadcast_flag(flag, root)
+
+logical, intent(inout) :: flag
+integer, intent(in) :: root !> relative to get_dart_mpi_comm()
+
+integer :: errcode
+
+! does nothing because data is already there
+
+end subroutine broadcast_flag
+
!-----------------------------------------------------------------------------
! pipe-related utilities
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
-subroutine block_task()
+subroutine block_task()
-if ( .not. module_initialized ) call initialize_mpi_utilities()
-
-
end subroutine block_task
!-----------------------------------------------------------------------------
-subroutine restart_task()
-
-
-if ( .not. module_initialized ) call initialize_mpi_utilities()
+subroutine restart_task()
end subroutine restart_task
@@ -498,50 +483,64 @@ end subroutine restart_task
!-----------------------------------------------------------------------------
! general system util wrappers.
!-----------------------------------------------------------------------------
+
+!> Use the system() command to execute a command string.
+!> Will wait for the command to complete and returns an
+!> error code unless you end the command with & to put
+!> it into background. Function which returns the rc
+!> of the command, 0 being all is ok.
+
function shell_execute(execute_string, serialize)
character(len=*), intent(in) :: execute_string
logical, intent(in), optional :: serialize
integer :: shell_execute
-! Use the system() command to execute a command string.
-! Will wait for the command to complete and returns an
-! error code unless you end the command with & to put
-! it into background. Function which returns the rc
-! of the command, 0 being all is ok.
+!DEBUG: print *, "in-string is: ", trim(execute_string)
+
+call do_system(execute_string, shell_execute)
-! on some platforms/mpi implementations, the system() call
-! does not seem to be reentrant. if serialize is set and
-! is true, do each call serially.
+!DEBUG: print *, "execution returns, rc = ", shell_execute
+
+end function shell_execute
-character(len=255) :: doit
+!-----------------------------------------------------------------------------
- !print *, "in-string is: ", trim(execute_string)
+!> wrapper so you only have to make this work in a single place
+!> 'shell_name' is a namelist item and normally is the null string.
+!> on at least on cray system, the compute nodes only had one type
+!> of shell and you had to specify it.
- write(doit, "(a, 1x, a1)") trim(execute_string), char(0)
+subroutine do_system(execute, rc)
- !print *, "about to run: ", trim(doit)
- !print *, "input string length = ", len(trim(doit))
+character(len=*), intent(in) :: execute
+integer, intent(out) :: rc
- shell_execute = system(doit)
- print *, "execution returns, rc = ", shell_execute
+! !!NAG_BLOCK_EDIT START COMMENTED_OUT
+! call system(trim(shell_name)//' '//trim(execute)//' '//char(0), errno=rc)
+! !!NAG_BLOCK_EDIT END COMMENTED_OUT
+! !!OTHER_BLOCK_EDIT START COMMENTED_IN
+ rc = system(trim(shell_name)//' '//trim(execute)//' '//char(0))
+! !!OTHER_BLOCK_EDIT END COMMENTED_IN
-end function shell_execute
+end subroutine do_system
!-----------------------------------------------------------------------------
+
+!> Wrapper for the sleep command. Argument is a real
+!> in seconds. Different systems have different lower
+!> resolutions for the minimum time it will sleep.
+!> Subroutine, no return value.
+
subroutine sleep_seconds(naplength)
- real(r8), intent(in) :: naplength
-! Wrapper for the sleep command. Argument is a real
-! in seconds. Different systems have different lower
-! resolutions for the minimum time it will sleep.
-! Subroutine, no return value.
+real(r8), intent(in) :: naplength
- integer :: sleeptime
+integer :: sleeptime
- sleeptime = floor(naplength)
- if (sleeptime <= 0) sleeptime = 1
+sleeptime = floor(naplength)
+if (sleeptime <= 0) sleeptime = 1
- call sleep(sleeptime)
+call sleep(sleeptime)
end subroutine sleep_seconds
@@ -594,71 +593,18 @@ function read_mpi_timer(base)
end function read_mpi_timer
!-----------------------------------------------------------------------------
+!> Return the communicator number.
function get_dart_mpi_comm()
- integer :: get_dart_mpi_comm
-! return dummy value
-get_dart_mpi_comm = 0
+integer :: get_dart_mpi_comm
-end function get_dart_mpi_comm
+get_dart_mpi_comm = my_local_comm
-!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
-! Collect sum across tasks for a given array.
-subroutine send_sum_to(local_val, task, global_val)
-
-real(r8), intent(in) :: local_val(:) !> min max on each task
-integer, intent(in) :: task !> task to collect on
-real(r8), intent(out) :: global_val(:) !> only concerned with this on task collecting result
-
-integer :: errcode
-
-! collect values on a single given task
-global_val(:) = local_val(:) ! only one task.
-
-end subroutine send_sum_to
-
-!-----------------------------------------------------------------------------
-
-!-----------------------------------------------------------------------------
-! Collect min and max on task. This is for adaptive_inflate_mod
-subroutine send_minmax_to(minmax, task, global_val)
-
-real(r8), intent(in) :: minmax(2) ! min max on each task
-integer, intent(in) :: task ! task to collect on
-real(r8), intent(out) :: global_val(2) ! only concerned with this on task collecting result
-
-global_val(:) = minmax(:) ! only one task.
-
-end subroutine send_minmax_to
+end function get_dart_mpi_comm
!-----------------------------------------------------------------------------
-! cover routine which is deprecated. when all user code replaces this
-! with broadcast_minmax(), remove this.
-subroutine all_reduce_min_max(min_var, max_var, num_elements)
-
-integer, intent(in) :: num_elements
-real(r8), intent(inout) :: min_var(num_elements)
-real(r8), intent(inout) :: max_var(num_elements)
-
-call broadcast_minmax(min_var, max_var, num_elements)
-
-end subroutine all_reduce_min_max
-
-
!-----------------------------------------------------------------------------
-! Find min and max of each element of an array across tasks, put the result on every task.
-! For this null_mpi_version min_var and max_var are unchanged because there is
-! only 1 task.
-subroutine broadcast_minmax(min_var, max_var, num_elements)
-
-integer, intent(in) :: num_elements
-real(r8), intent(inout) :: min_var(num_elements)
-real(r8), intent(inout) :: max_var(num_elements)
-
-end subroutine broadcast_minmax
-
!-----------------------------------------------------------------------------
! One sided communication
@@ -667,7 +613,7 @@ subroutine get_from_mean(owner, window, mindex, x)
integer, intent(in) :: owner ! task in the window that owns the memory
integer, intent(in) :: window ! window object
integer, intent(in) :: mindex ! index in the tasks memory
-real(r8), intent(out) :: x ! result
+real(r8), intent(out) :: x ! result
call error_handler(E_ERR,'get_from_mean', 'cannot be used in serial mode', source, revision, revdate)
@@ -693,39 +639,34 @@ subroutine get_from_fwd(owner, window, mindex, num_rows, x)
end subroutine get_from_fwd
-
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
-! Broadcast logical
-subroutine broadcast_flag(flag, root)
-
-logical, intent(inout) :: flag
-integer, intent(in) :: root ! relative to get_dart_mpi_comm()
-
-end subroutine broadcast_flag
-
end module mpi_utilities_mod
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
-! NOTE -- non-module code, so this subroutine can be called from the
-! utilities module, which this module uses (and cannot have circular refs)
+!> NOTE: non-module code, so this subroutine can be called from the
+!> utilities module, which this module uses (and cannot have circular refs)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
+!> Call exit with the specified code. NOT PART of the mpi_utilities_mod, so
+!> this can be called from any code in the system.
subroutine exit_all(exit_code)
+! !!NAG_BLOCK_EDIT START COMMENTED_OUT
+! use F90_unix_proc, only : exit
+! !!NAG_BLOCK_EDIT END COMMENTED_OUT
integer, intent(in) :: exit_code
-! Call exit with the specified code.
-
call exit(exit_code)
end subroutine exit_all
+!-----------------------------------------------------------------------------
+
!
! $URL$
! $Id$
diff --git a/assimilation_code/modules/utilities/obs_impact_mod.f90 b/assimilation_code/modules/utilities/obs_impact_mod.f90
index f87e2d7830..dd6088e2c1 100644
--- a/assimilation_code/modules/utilities/obs_impact_mod.f90
+++ b/assimilation_code/modules/utilities/obs_impact_mod.f90
@@ -4,7 +4,7 @@
!
! $Id$
-!> This module supports the obs_impact_tool and reading in the
+!> This module supports both the obs_impact_tool and reading in the
!> table at runtime for use during the assimilation phase, to
!> alter the impact of observations on the state vector.
!>
@@ -16,18 +16,17 @@ module obs_impact_mod
use types_mod, only : r8, obstypelength, missing_r8
use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
- open_file, close_file, nc_check, get_next_filename, &
- find_namelist_in_file, check_namelist_read, &
- do_nml_file, do_nml_term, nmlfileunit, to_upper
+ open_file, close_file, get_next_filename, to_upper
use obs_kind_mod ! all qtys/types, so impossible to enumerate them here
use parse_args_mod, only : get_args_from_string
implicit none
private
-public :: create_impact_table, &
- allocate_impact_table, read_impact_table, free_impact_table, &
- get_impact_table_name
+public :: create_impact_table, &
+ allocate_impact_table, &
+ read_impact_table, &
+ free_impact_table
! version controlled file description for error handling, do not edit
character(len=256), parameter :: source = &
@@ -116,25 +115,18 @@ module obs_impact_mod
character(len=512) :: msgstring, msgstring2, msgstring3
-! namelist: input/output names, values, etc
-character(len=512) :: input_filename = ''
-character(len=512) :: output_filename = ''
-logical :: allow_any_impact_values = .false.
-logical :: debug = .false. ! .true. for more output
-
-! namelist
-namelist /obs_impact_tool_nml/ &
- input_filename, &
- output_filename, &
- allow_any_impact_values, &
- debug
+! .true. gives more output
+logical :: debug = .false.
contains
!----------------------------------------------------------------------
! TOOL:
-subroutine create_impact_table()
+subroutine create_impact_table(input_filename, output_filename, debug_flag)
+character(len=*), intent(in) :: input_filename
+character(len=*), intent(in) :: output_filename
+logical, intent(in), optional :: debug_flag
! this is the routine that reads in the config file
! and creates an output file that's suitable for reading
@@ -146,7 +138,7 @@ subroutine create_impact_table()
integer :: funit
! initialization and setup
-call initialize_module()
+call initialize_module(debug)
! set up space for the output table
call allocate_impact_table(table)
@@ -234,9 +226,6 @@ subroutine allocate_impact_table(table, ntypes, nqtys)
integer :: qty_count, type_count
-! initialization and setup
-!call initialize_module()
-
! output table is dimensioned (numtypes, 0:numqtys)
! space for results, and initial values
! default to 'unset'. at the end, anything unset will be
@@ -264,11 +253,12 @@ end subroutine allocate_impact_table
! type or qty names without a dictionary or state machine.
! RUNTIME:
-subroutine read_impact_table(sourcefile, table, allow_any_values)
+subroutine read_impact_table(sourcefile, table, allow_any_values, anyvals_string)
character(len=*), intent(in) :: sourcefile
real(r8), intent(inout) :: table(:,0:)
logical, intent(in) :: allow_any_values
+character(len=*), intent(in), optional :: anyvals_string
integer :: i, j
integer :: funit
@@ -305,7 +295,7 @@ subroutine read_impact_table(sourcefile, table, allow_any_values)
endif
!print *, trim(typename)//' '//trim(qtyname)//' ', rvalue
- call set_impact(table, typename, qtyname, rvalue, allow_any_values)
+ call set_impact(table, typename, qtyname, rvalue, allow_any_values, anyvals_string)
enddo readloop
call close_file(funit)
@@ -329,16 +319,17 @@ end subroutine read_impact_table
!----------------------------------------------------------------------
! RUNTIME:
-subroutine set_impact(table, typename, qtyname, rvalue, allow_any_values)
+subroutine set_impact(table, typename, qtyname, rvalue, allow_any_values, anyvals_string)
real(r8), intent(inout) :: table(:,0:)
character(len=*), intent(in) :: typename
character(len=*), intent(in) :: qtyname
real(r8), intent(in) :: rvalue
logical, intent(in) :: allow_any_values
+character(len=*), intent(in), optional :: anyvals_string
-! change this to false to allow any value between 0 and 1
-logical, save :: must_be_on_or_off = .true.
+! change this to true to force values to be 0 or 1
+logical, save :: fully_on_or_off = .false.
integer :: index1, index2
@@ -360,24 +351,29 @@ subroutine set_impact(table, typename, qtyname, rvalue, allow_any_values)
source, revision, revdate, text2=errline, text3=readbuf)
endif
-! options for the actual impact value here could be:
+! options for the actual impact value:
! 1. anything goes
-! 2. restrict range to between 0.0 and 1.0
-! 3. allow ONLY 0.0 or 1.0
+! 2. values restricted
+! a. must be 0.0 or 1.0 only
+! b. must be between 0.0 and 1.0 inclusive
if (.not. allow_any_values) then
- if (must_be_on_or_off) then
+ if (fully_on_or_off) then
if (rvalue /= 0.0_r8 .and. rvalue /= 1.0_r8) then
call error_handler(E_ERR, 'obs_impact', &
'impact values must be 0 or 1', &
- source, revision, revdate, text2=readbuf)
+ source, revision, revdate, text2=readbuf)
endif
else
+ if (present(anyvals_string)) then
+ msgstring3='set "'//trim(anyvals_string)//'=.true." in namelist to allow'
+ else
+ msgstring3=""
+ endif
if (rvalue < 0.0_r8 .or. rvalue > 1.0_r8) then
call error_handler(E_ERR, 'obs_impact', &
'impact values must be between 0 and 1, inclusive', &
- source, revision, revdate, text2=readbuf, &
- text3='set "allow_any_impact_values=.true." in namelist to allow')
+ source, revision, revdate, text2=readbuf, text3=msgstring3)
endif
endif
endif
@@ -412,38 +408,15 @@ end subroutine free_impact_table
!----------------------------------------------------------------------
! TOOL & RUNTIME:
-function get_impact_table_name()
-
-character(len=512) :: get_impact_table_name
-
-get_impact_table_name = output_filename
-
-end function get_impact_table_name
-
-!----------------------------------------------------------------------
-
-! TOOL & RUNTIME:
-subroutine initialize_module()
-
-integer :: funit
+subroutine initialize_module(debug_flag)
+logical, intent(in), optional :: debug_flag
if (module_initialized) return
module_initialized = .true.
call register_module(source, revision, revdate)
-! Read the namelist entry
-call find_namelist_in_file("input.nml", "obs_impact_tool_nml", funit)
-read(funit, nml = obs_impact_tool_nml, iostat = ios)
-call check_namelist_read(funit, ios, "obs_impact_tool_nml")
-
-! Record the namelist values used for the run ...
-if (do_nml_file()) write(nmlfileunit, nml=obs_impact_tool_nml)
-if (do_nml_term()) write( * , nml=obs_impact_tool_nml)
-
-if (debug) then
- call error_handler(E_MSG, 'obs_impact_tool', ' debug on')
-endif
+if (present(debug_flag)) debug = debug_flag
end subroutine initialize_module
@@ -492,6 +465,7 @@ subroutine init_strings_and_toc(toc, group_toc)
enddo
allocate(toc%toc_entries(ntoc))
+toc%toc_count = 0
call build_toc(qty_count, knownqtys, type_count, knowntypes, toc)
@@ -1457,17 +1431,6 @@ subroutine check_impact_line(wordcount, itemlist, wordarray, rvalue)
call extract_value(wordarray(3), rvalue)
-! FIXME: do this at runtime now. if you want to check values
-! at table build time, uncomment this code again.
-!if (.not. allow_any_impact_values) then
-! if (rvalue < 0.0_r8 .or. rvalue > 1.0_r8) then
-! call error_handler(E_ERR, 'check_impact_line', &
-! 'impact values must be between 0 and 1, inclusive', &
-! source, revision, revdate, text2=readbuf, &
-! text3='set "allow_any_impact_values=.true." in namelist to allow')
-! endif
-!endif
-
end subroutine check_impact_line
!----------------------------------------------------------------------
diff --git a/assimilation_code/modules/utilities/sort_mod.f90 b/assimilation_code/modules/utilities/sort_mod.f90
index 6c4ed9af03..7bef0da53a 100644
--- a/assimilation_code/modules/utilities/sort_mod.f90
+++ b/assimilation_code/modules/utilities/sort_mod.f90
@@ -4,6 +4,16 @@
!
! $Id$
+!> A selection of sorting routines. The simplest version sorts a given array
+!> of values and returns a copy of the array with the items in ascending sorted
+!> order. This works on integer and real(r8) arrays.
+!> Another version returns an integer index array. Accessing the original
+!> list using these indices will traverse the array in sorted order.
+!> The final version of the sort routine is similar to the index sort
+!> but a compare routine is supplied by the user, allowing this code
+!> to sort a list of any kinds of items.
+!>
+
module sort_mod
use types_mod, only : r8
@@ -12,7 +22,7 @@ module sort_mod
implicit none
private
-public :: slow_sort, slow_index_sort, sort, index_sort
+public :: sort, index_sort
! version controlled file description for error handling, do not edit
character(len=256), parameter :: source = &
@@ -22,116 +32,56 @@ module sort_mod
logical, save :: module_initialized = .false.
+!> single interface to sort real or integer arrays
+
interface sort
module procedure rsort
module procedure isort
end interface sort
+!> single interface to return indices in sorted order,
+!> leaving the original array in place.
+
interface index_sort
module procedure index_sort_real
module procedure index_sort_int
+ module procedure index_sort_user
end interface
contains
-!=======================================================================
+!-----------------------------------------------------------------------
+subroutine initialize_module()
-subroutine initialize_module
+if (module_initialized) return
call register_module(source, revision, revdate)
module_initialized = .true.
end subroutine initialize_module
+!-----------------------------------------------------------------------
-!=======================================================================
-
-! a silly, inefficient sort for real(r8) array data
-
-function slow_sort(x)
-
-implicit none
-
-real(r8), intent(in) :: x(:)
-real(r8) :: slow_sort(size(x))
-real(r8) :: tmp
-integer j, k
-
-if ( .not. module_initialized ) call initialize_module
-
-! Copy to slow_sort
-slow_sort = x
-
-! DO A SILLY N^2 SORT
-do j = 1, size(x) - 1
- do k = j + 1, size(x)
-! EXCHANGE TWO ELEMENTS IF THEY'RE IN THE WRONG ORDER
- if(slow_sort(j) .gt. slow_sort(k)) then
- tmp = slow_sort(k)
- slow_sort(k) = slow_sort(j)
- slow_sort(j) = tmp
- end if
- end do
-end do
-end function slow_sort
-
-!=======================================================================
-
- subroutine slow_index_sort(dist, index, num)
-
-! real(r8) indexed sort
-
- implicit none
-
- integer num, index(num)
- real(r8) dist(num)
- integer i, j, k, itmp
-
-if ( .not. module_initialized ) call initialize_module
-
-! INITIALIZE THE INDEX ARRAY TO INPUT ORDER
-do i = 1, num
- index(i) = i
-end do
-
-! DO A SILLY N^2 SORT
-do j = 1, num
- do k = 1, num - 1
-! EXCHANGE TWO ELEMENTS IF THEY RE IN THE WRONG ORDER
- if(dist(index(k)) > dist(index(k+1))) then
- itmp = index(k)
- index(k) = index(k+1)
- index(k+1) = itmp
- endif
- end do
-end do
-
-! TEMPORARY PRINT OUT TO CHECK SORT
-! do 30 j = 1, num
-! 30 write(*, *) j, dist(index(j))
-! return
- end subroutine slow_index_sort
-
-
-!=========================================================================
-
+!> Uses a heap sort algorithm on real(r8) array x(), returns sorted array.
+!> x() must be allocated or declared to be exactly the intended size;
+!> all items in x() are sorted.
+!>
+!> @param x the (real) array to sort
+!>
function rsort(x)
-! Uses a heap sort alogrithm on x, returns sorted array
-implicit none
-
real(r8), intent(in) :: x(:)
real(r8) :: rsort(size(x))
integer :: num, level, ind, i, j
real(r8) :: l_val
-! Get the size
+! Get the array size
num = size(x)
-! Initial copy over
+! Copy to output
rsort = x
! Only one element, just send it back
@@ -178,25 +128,27 @@ function rsort(x)
end function rsort
+!-------------------------------------------------------------------------
-!=========================================================================
-
+!> Uses a heap sort algorithm on integer array x(), returns sorted array.
+!> x() must be allocated or declared to be exactly the intended size;
+!> all items in x() are sorted.
+!>
+!> @param x the (integer) array to sort
+!>
function isort(x)
-! Uses a heap sort alogrithm on x, returns sorted array
-implicit none
-
integer, intent(in) :: x(:)
integer :: isort(size(x))
integer :: num, level, ind, i, j
integer :: l_val
-! Get the size
+! Get the array size
num = size(x)
-! Initial copy over
+! Copy to output
isort = x
! Only one element, just send it back
@@ -243,18 +195,23 @@ function isort(x)
end function isort
+!-------------------------------------------------------------------------
-!=========================================================================
-
-
-subroutine index_sort_real(x, index, num)
-
-! Uses a heap sort alogrithm on x, returns array of sorted indices
-implicit none
+!> Uses a heap sort algorithm on x(), returns integer array of sorted indices.
+!> x(num) array returned unchanged; index array doesn't need to be
+!> initialized before this call.
+!> usage: do i=1,num; x(indx(i)) is next item in sorted order; enddo
+!> This differs from index_sort_int only in the data type of the x() array.
+!>
+!> @param x the (real) array to sort
+!> @param indx the array of integer indices to be used to traverse the input array in sorted order
+!> @param num the length of x
+!>
+subroutine index_sort_real(x, indx, num)
integer, intent(in) :: num
real(r8), intent(in) :: x(num)
-integer, intent(out) :: index(num)
+integer, intent(out) :: indx(num)
integer :: ind, i, j, l_val_index, level
real(r8) :: l_val
@@ -262,9 +219,9 @@ subroutine index_sort_real(x, index, num)
if ( .not. module_initialized ) call initialize_module
-! INITIALIZE THE INDEX ARRAY TO INPUT ORDER
+! Initialize the index array to input order
do i = 1, num
- index(i) = i
+ indx(i) = i
end do
! Only one element, just send it back
@@ -278,17 +235,16 @@ subroutine index_sort_real(x, index, num)
! Keep going down levels until bottom
if(level > 1) then
level = level - 1
- l_val = x(index(level))
- l_val_index = index(level)
+ l_val = x(indx(level))
+ l_val_index = indx(level)
else
- l_val = x(index(ind))
- l_val_index = index(ind)
-
+ l_val = x(indx(ind))
+ l_val_index = indx(ind)
- index(ind) = index(1)
+ indx(ind) = indx(1)
ind = ind - 1
if(ind == 1) then
- index(1) = l_val_index
+ indx(1) = l_val_index
return
endif
endif
@@ -298,10 +254,10 @@ subroutine index_sort_real(x, index, num)
do while(j <= ind)
if(j < ind) then
- if(x(index(j)) < x(index(j + 1))) j = j + 1
+ if(x(indx(j)) < x(indx(j + 1))) j = j + 1
endif
- if(l_val < x(index(j))) then
- index(i) = index(j)
+ if(l_val < x(indx(j))) then
+ indx(i) = indx(j)
i = j
j = 2 * j
else
@@ -309,34 +265,39 @@ subroutine index_sort_real(x, index, num)
endif
end do
- index(i) = l_val_index
+ indx(i) = l_val_index
end do
end subroutine index_sort_real
+!-------------------------------------------------------------------------
-!=========================================================================
-
-
-subroutine index_sort_int(x, index, num)
+!> Uses a heap sort algorithm on x(), returns integer array of sorted indices.
+!> x(num) array returned unchanged; index array doesn't need to be
+!> initialized before this call.
+!> usage: do i=1,num; x(indx(i)) is next item in sorted order; enddo
+!> This differs from index_sort_real only in the data type of the x() array.
+!>
+!> @param x the (integer) array to sort
+!> @param indx the array of integer indices to be used to traverse the input array in sorted order
+!> @param num the length of x
+!>
-! Uses a heap sort alogrithm on x (an array of integers)
-! returns array of sorted indices and the sorted array
-implicit none
+subroutine index_sort_int(x, indx, num)
integer, intent(in) :: num
integer, intent(in) :: x(num)
-integer, intent(out) :: index(num)
+integer, intent(out) :: indx(num)
integer :: ind, i, j, l_val_index, level
integer :: l_val
if ( .not. module_initialized ) call initialize_module
-! INITIALIZE THE INDEX ARRAY TO INPUT ORDER
+! Initialize the index array to input order
do i = 1, num
- index(i) = i
+ indx(i) = i
end do
! Only one element, just send it back
@@ -350,17 +311,16 @@ subroutine index_sort_int(x, index, num)
! Keep going down levels until bottom
if(level > 1) then
level = level - 1
- l_val = x(index(level))
- l_val_index = index(level)
+ l_val = x(indx(level))
+ l_val_index = indx(level)
else
- l_val = x(index(ind))
- l_val_index = index(ind)
-
+ l_val = x(indx(ind))
+ l_val_index = indx(ind)
- index(ind) = index(1)
+ indx(ind) = indx(1)
ind = ind - 1
if(ind == 1) then
- index(1) = l_val_index
+ indx(1) = l_val_index
return
endif
endif
@@ -370,10 +330,10 @@ subroutine index_sort_int(x, index, num)
do while(j <= ind)
if(j < ind) then
- if(x(index(j)) < x(index(j + 1))) j = j + 1
+ if(x(indx(j)) < x(indx(j + 1))) j = j + 1
endif
- if(l_val < x(index(j))) then
- index(i) = index(j)
+ if(l_val < x(indx(j))) then
+ indx(i) = indx(j)
i = j
j = 2 * j
else
@@ -381,15 +341,105 @@ subroutine index_sort_int(x, index, num)
endif
end do
-
- index(i) = l_val_index
+ indx(i) = l_val_index
end do
end subroutine index_sort_int
+!-------------------------------------------------------------------------
+
+!> Uses a heap sort algorithm to compute a sorted array of indices. The
+!> actual items being sorted are opaque to this routine; the user supplies
+!> a sorting function which must have access to the original items. This
+!> routine only manipulates the integer index values which are then returned.
+!>
+!> The third argument is a user-supplied function which takes 2 integers (a,b)
+!> as arguments and return an integer code:
+!> -1 if mything(a) < mything(b)
+!> 0 if mything(a) == mything(b)
+!> 1 if mything(a) > mything(b)
+!> The function only gets the index numbers; the user code should use them
+!> to compare the items corresponding to those index numbers and return the
+!> ordering between them.
+!> This seems to work best when the comparefunc() is a public routine inside
+!> a module so the interface specification is known to the compiler.
+!>
+!> usage: do i=1,num; mything(indx(i)) is next item in sorted order; enddo
+!>
+!> @param indx the array of integers
+!> @param num the length of x
+!> @param comparefunc the name of the comparison function
+!>
+
+subroutine index_sort_user(indx, num, comparefunc)
+
+integer, intent(in) :: num
+integer, intent(out) :: indx(num)
+interface
+ integer function comparefunc(a, b)
+ integer, intent(in) :: a, b
+ end function comparefunc
+end interface
+
+integer :: ind, i, j, l_val_index, level
+integer :: compval
+
+if ( .not. module_initialized ) call initialize_module
+
+! Initialize the index array to input order
+do i = 1, num
+ indx(i) = i
+enddo
+
+! Only one element, just send it back
+if(num <= 1) return
+
+level = num / 2 + 1
+ind = num
+
+! Keep looping until finished
+do
+ ! Keep going down levels until bottom
+ if(level > 1) then
+ level = level - 1
+ l_val_index = indx(level)
+ else
+ l_val_index = indx(ind)
+
+ indx(ind) = indx(1)
+ ind = ind - 1
+ if(ind == 1) then
+ indx(1) = l_val_index
+ return
+ endif
+ endif
+
+ i = level
+ j = 2 * level
+
+ do while(j <= ind)
+ if(j < ind) then
+ compval = comparefunc(indx(j), indx(j+1))
+ if(compval < 0) j = j + 1
+ endif
+ compval = comparefunc(l_val_index, indx(j))
+ if(compval < 0) then
+ indx(i) = indx(j)
+ i = j
+ j = 2 * j
+ else
+ j = ind + 1
+ endif
+
+ enddo
+ indx(i) = l_val_index
+
+enddo
+
+end subroutine index_sort_user
-!=========================================================================
+!-------------------------------------------------------------------------
end module sort_mod
diff --git a/assimilation_code/modules/utilities/utilities_mod.f90 b/assimilation_code/modules/utilities/utilities_mod.f90
index 60a9906fec..9744373883 100644
--- a/assimilation_code/modules/utilities/utilities_mod.f90
+++ b/assimilation_code/modules/utilities/utilities_mod.f90
@@ -6,195 +6,56 @@
module utilities_mod
-!-----------------------------------------------------------------------
-!
-! A collection of simple useful routines:
-!
-! file_exist Function that returns if a given
-! file name exists
-!
-! get_unit Function that returns an available
-! Fortran unit number
-!
-! error_handler Print warning and error messages,
-! terminates program for error messages.
-!
-! open_file Opens a given file name for i/o and returns
-! a unit number. If the file is already open
-! the unit number is returned.
-!
-! close_file Closes the given unit_number. If the file is
-! already closed, nothing happens.
-!
-! initialize_utilities Call this routine once before using any
-! of the other routines in this file. If you
-! are using the MPI library, do not call this
-! routine -- call mpi_initialize_utilities instead.
-! It will call this routine as part of initializing
-! the MPI code.
-!
-! finalize_utilities Call this routine at the end of a program to close
-! the log file and flush pending output. For an MPI
-! program, call mpi_finalize_utilities instead.
-!
-! dump_unit_attributes A debug routine that dumps out a long list of
-! attributes that can be queried from an open file unit.
-!
-! set_output Set the status of printing. Can be set on a per-task
-! basis if you are running with multiple tasks.
-! By default all warnings and errors print no matter
-! which task executes the code; messages only print
-! from task 0 to avoid N copies of identical messages.
-!
-! do_output Logical function which returns whether informational
-! messages should be output. Controlled by the setting
-! made from set_output. Useful for messages which cannot
-! go through the normal error handler (e.g. namelists).
-!
-! find_namelist_in_file Opens the namelist file and verifies the given
-! namelist name exists. If found, rewind the file
-! and return true. Then a F90 namelist read command
-! can be used to read in the namelist values.
-! Otherwise, print an error message and terminate.
-!
-! check_namelist_read Confirms that a namelist read was successful.
-! If it failed print an error message and terminate.
-!
-! set_nml_output Set the status of printing namelist data. By default,
-! only print to the nml log file. Can be set to print
-! to stdout, both, or none. Argument is a string; valid
-! values are 'none', 'file', 'terminal', or 'both'.
-!
-! do_nml_file Logical function which returns whether informational
-! messages should be output to the file. Controlled
-! by a call to set_nml_output().
-!
-! do_nml_term Logical function which returns whether informational
-! messages should be output to * (unit 6?). Controlled
-! by a call to set_nml_output().
-!
-! set_tasknum Only called for an MPI job with multiple tasks.
-! Sets the 'multi-task' flag and records the local task
-! number for later error and info messages.
-!
-! nc_check Check netcdf return codes, and if not ok, extract
-! the netcdf error string and pass that to the error
-! handler routine. Two optional strings allow the caller
-! to provide the subroutine name and some context.
-!
-! write_time Writes a timestamp in a standard format.
-!
-! logfileunit Global integer unit numbers for the log file and
-! nmlfileunit for the namelist file (which defaults to same as log)
-!
-! to_upper converts a character string to uppercase.
-!
-! find_textfile_dims finds number of lines and max line length in a
-! text file. Used so we can record the namelist
-! file content in the netcdf output files.
-!
-! file_to_text converts the contents of a (hopefully small) file to
-! a single text variable ... to record in the
-! netcdf output files.
-!
-! get_next_filename returns the next filename, given the name of
-! an ascii file which contains a filename per line.
-! it returns an empty string at end of list.
-!
-! is_longitude_between checks whether a given longitude is between
-! the two given limits, starting at the first and
-! going EAST until reaching the second. the end
-! points are included. if min=max, all points are
-! considered inside. there is no rejection of the
-! input values based on range; they are all converted
-! to [0-360) by calling modulo() before starting.
-! default is degrees, but there is an optional
-! argument to select radians instead.
-!
-! ascii_file_format function that returns true if the string argument
-! is indicating the requested format is ascii/text.
-! false means unformatted/binary.
-!
-! nsc start 31jan07
-! idea - add some unit number routine here?
-! you can extract the filename associated with a fortran unit number
-! with the inquire function on the unit. this seems useful for
-! automatically generating filenames in messages. here is an example
-! of how that code works:
-!
-!character(len=128) :: filename
-!logical :: is_named
-!integer :: rc
-!
-!inquire(unitnum, named=is_named, name=filename, iostat=rc)
-!print *, 'is_named =', is_named, 'name = ', trim(filename)
-!if ((rc /= 0) .or. (.not. is_named)) filename = 'unknown file'
-!
-! nsc end 31jan07
-!
-!-----------------------------------------------------------------------
+!> general purpose lower level utility routines.
+!>
+!> probably large enough now this file should be split with the
+!> logging and error handing here, maybe the file routines in
+!> another util module?
use types_mod, only : r4, r8, digits12, i4, i8, PI, MISSING_R8, MISSING_I
-!>@todo FIXME netcdf is only needed for the nc_check() routine.
-!>when it moves to the netcdf_utilities_mod module remove the 'use'
-!>from here to simplify things.
-use netcdf
-
implicit none
private
! module local data
-integer, parameter :: E_DBG = -2, E_MSG = -1, E_ALLMSG = 0, E_WARN = 1, E_ERR = 2
-integer, parameter :: DEBUG = -1, MESSAGE = 0, WARNING = 1, FATAL = 2
+integer, parameter :: E_DBG = -2, E_MSG = -1, E_ALLMSG = 0, E_WARN = 1, E_ERR = 2
integer, parameter :: NML_NONE = 0, NML_FILE = 1, NML_TERMINAL = 2, NML_BOTH = 3
real(r8), parameter :: TWOPI = PI * 2.0_r8
-logical :: do_output_flag = .true.
-integer :: nml_flag = NML_FILE
-logical :: single_task = .true.
-integer :: task_number = 0
+logical :: do_output_flag = .false.
+integer :: nml_flag = NML_FILE
+logical :: single_task = .true.
+integer :: task_number = 0
logical :: module_initialized = .false.
-integer :: logfileunit = -1
-integer :: nmlfileunit = -1
+integer :: logfileunit = -1
+integer :: nmlfileunit = -1
-public :: file_exist, &
- get_unit, &
+
+public :: get_unit, &
open_file, &
close_file, &
- timestamp, &
- register_module, &
+ file_exist, &
error_handler, &
to_upper, &
squeeze_out_blanks, &
- nc_check, &
- next_file, &
+ nc_check, & ! remove this; moved to netcdf_utils
+ next_file, & ! deprecate this
logfileunit, &
nmlfileunit, &
find_textfile_dims, &
file_to_text, &
- initialize_utilities, &
- finalize_utilities, &
- dump_unit_attributes, &
- find_namelist_in_file, &
- check_namelist_read, &
- do_nml_term, &
+ timestamp, &
set_tasknum, &
set_output, &
do_output, &
set_nml_output, &
- do_nml_file, &
E_DBG, &
E_MSG, &
E_ALLMSG, &
E_WARN, &
E_ERR, &
- DEBUG, &
- MESSAGE, &
- WARNING, &
- FATAL, &
is_longitude_between, &
get_next_filename, &
ascii_file_format, &
@@ -203,7 +64,20 @@ module utilities_mod
scalar, &
string_to_real, &
string_to_integer, &
- string_to_logical
+ string_to_logical, &
+ find_enclosing_indices, &
+ find_first_occurrence, &
+ array_dump, &
+ dump_unit_attributes, &
+ ! lowest level routines
+ initialize_utilities, &
+ finalize_utilities, &
+ register_module, &
+ find_namelist_in_file, &
+ check_namelist_read, &
+ do_nml_file, &
+ do_nml_term, &
+ log_it
! this routine is either in the null_mpi_utilities_mod.f90, or in
! the mpi_utilities_mod.f90 file, but it is not a module subroutine.
@@ -223,10 +97,17 @@ end subroutine exit_all
! if so, make to_scalar_int explicitly I4, i guess.)
interface scalar
module procedure to_scalar_real
- module procedure to_scalar_int
+ module procedure to_scalar_int4
module procedure to_scalar_int8
end interface
+interface array_dump
+ module procedure array_1d_dump
+ module procedure array_2d_dump
+ module procedure array_3d_dump
+ module procedure array_4d_dump
+end interface
+
! version controlled file description for error handling, do not edit
character(len=256), parameter :: source = &
"$URL$"
@@ -260,540 +141,531 @@ end subroutine exit_all
contains
-!#######################################################################
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! base (lowest level) routines
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+
- subroutine initialize_utilities(progname, alternatename, output_flag)
- character(len=*), intent(in), optional :: progname
- character(len=*), intent(in), optional :: alternatename
- logical, intent(in), optional :: output_flag
- ! integer :: logfileunit -- public module variable
- integer :: iunit, io
+!-----------------------------------------------------------------------
+!>
- character(len=256) :: lname
- character(len=512) :: string1,string2,string3
+subroutine initialize_utilities(progname, alternatename, output_flag)
+character(len=*), intent(in), optional :: progname
+character(len=*), intent(in), optional :: alternatename
+logical, intent(in), optional :: output_flag
+integer :: iunit, io
- if ( module_initialized ) then ! nothing to do
+character(len=256) :: lname
- ! write(*,*)'Module initialized ... carry on.'
+if ( module_initialized ) return
+
+module_initialized = .true.
- return
- else ! initialize the module
-
- module_initialized = .true.
+! now default to false, and only turn on if i'm task 0
+! or the caller tells me to turn it on.
+if (present(output_flag)) then
+ do_output_flag = output_flag
+else
+ if (single_task .or. task_number == 0) do_output_flag = .true.
+endif
- if (present(output_flag)) do_output_flag = output_flag
+! Since the logfile is not open yet, the error terminations
+! must be handled differently than all other cases.
+! The routines that normally write to the logfile cannot
+! be used just yet. If we cannot open a logfile, we
+! always abort execution at this step.
- ! Since the logfile is not open yet, the error terminations
- ! must be handled differently than all other cases.
- ! The routines that normally write to the logfile cannot
- ! be used just yet. If we cannot open a logfile, we
- ! always abort execution at this step.
+!>@todo see if we like leaving this off
+!if ( present(progname) ) then
+! if (do_output_flag) write(*,*)'Starting program ',trim(progname)
+!endif
- if ( present(progname) ) then
- if (do_output_flag) write(*,*)'Starting program ',trim(adjustl(progname))
- endif
+! Read the namelist entry first before opening logfile, because
+! you can rename the logfile via a utilities namelist item.
- if (do_output_flag) write(*,*)'Initializing the utilities module.'
+call find_namelist_in_file("input.nml", "utilities_nml", iunit)
+read(iunit, nml = utilities_nml, iostat = io)
+call check_namelist_read(iunit, io, "utilities_nml")
- ! Read the namelist entry
- call find_namelist_in_file("input.nml", "utilities_nml", iunit, .false.)
- read(iunit, nml = utilities_nml, iostat = io)
- call check_namelist_read(iunit, io, "utilities_nml", .false.)
+! Check to make sure termlevel is set to a reasonable value
+call check_term_level(TERMLEVEL)
- ! Open the log file with the name from the namelist
- logfileunit = nextunit()
- if ( logfileunit < 0 ) then
- write(*,*)' unable to get a unit to use for the logfile.'
- write(*,*)' stopping.'
- call exit_all(77)
- endif
+! Open the log file with the name from the namelist
+! does not return here on failure.
+logfileunit = get_unit()
- if (present(alternatename)) then
- lname = alternatename
- else
- lname = logfilename
- endif
+! name of the log file
+lname = logfilename
+if (present(alternatename)) lname = alternatename
- if (do_output_flag) write(*,*)'Trying to log to unit ', logfileunit
- if (do_output_flag) write(*,*)'Trying to open file ', trim(adjustl(lname))
-
- open(logfileunit, file=trim(adjustl(lname)), form='formatted', &
- action='write', position='append', iostat = io )
- if ( io /= 0 ) then
- write(*,*)'FATAL ERROR in initialize_utilities'
- write(*,*)' ',trim(source)
- write(*,*)' ',trim(revision)
- write(*,*)' ',trim(revdate)
- write(*,*)' unable to open the logfile for writing.'
- write(*,*)' the logfile name is "',trim(lname),'"'
- write(*,*)' stopping.'
- call exit_all(77)
- endif
+open(logfileunit, file=lname, form='formatted', &
+ action='write', position='append', iostat = io )
+if ( io /= 0 ) call fatal_opening_log('initialize_utilities', lname)
- ! Log the run-time
-
- if (do_output_flag) then
- if ( present(progname) ) then
- call write_time (logfileunit, label='Starting ', &
- string1='Program '//trim(progname))
- call write_time ( label='Starting ', &
- string1='Program '//trim(progname))
- else
- call write_time (logfileunit, label='Starting ')
- call write_time ( label='Starting ')
- endif
- endif
+! Log the starting wall-clock time
+if (do_output_flag) then
+ if ( present(progname) ) then
+ call log_time (logfileunit, label='Starting ', &
+ string1='Program '//trim(progname))
+ else
+ call log_time (logfileunit, label='Starting ')
+ endif
+endif
- ! Check to make sure termlevel is set to a reasonable value
- call checkTermLevel
+! Echo the module information using normal mechanism
+call register_module(source, revision, revdate)
- ! Echo the module information using normal mechanism
- call register_module(source, revision, revdate)
+! Set the defaults for logging the namelist values
+call set_nml_output(write_nml)
- ! Set the defaults for logging the namelist values
- call set_nml_output(write_nml)
+! If nmlfilename != logfilename, open it. otherwise set nmlfileunit
+! to be same as logunit.
+if (do_nml_file()) then
+ if (nmlfilename /= lname) then
+
+ nmlfileunit = get_unit()
+ open(nmlfileunit, file=nmlfilename, form='formatted', &
+ position='append', iostat = io )
+ if ( io /= 0 ) then
+ call error_handler(E_ERR,'initialize_utilities', &
+ 'Cannot open namelist log file "'//trim(nmlfilename)//'"', &
+ source, revision, revdate)
+ endif
+
+ else
+ nmlfileunit = logfileunit
+ endif
+endif
- ! If nmlfilename != logfilename, open it. otherwise set nmlfileunit
- ! to be same as logunit.
- if (do_nml_file()) then
- if (trim(adjustl(nmlfilename)) /= trim(adjustl(lname))) then
- if (do_output_flag) &
- write(*,*)'Trying to open namelist log ', trim(adjustl(nmlfilename))
-
- nmlfileunit = nextunit()
- if (nmlfileunit < 0) &
- call error_handler(E_ERR,'initialize_utilities', &
- 'Cannot get unit for nm log file', source, revision, revdate)
-
- open(nmlfileunit, file=trim(adjustl(nmlfilename)), form='formatted', &
- position='append', iostat = io )
- if ( io /= 0 ) then
- call error_handler(E_ERR,'initialize_utilities', &
- 'Cannot open nm log file', source, revision, revdate)
- endif
-
- else
- nmlfileunit = logfileunit
- endif
- endif
+! Echo the namelist values for this module using normal mechanism
+! including a separator line for this run.
+if (do_output_flag) then
+ if (do_nml_file() .and. (nmlfileunit /= logfileunit)) then
+ if ( present(progname) ) then
+ write(nmlfileunit, *) '!Starting Program '//trim(progname)
+ else
+ write(nmlfileunit, *) '!Starting Program '
+ endif
+ endif
+ if (do_nml_file()) write(nmlfileunit, nml=utilities_nml)
+ if (do_nml_term()) write( * , nml=utilities_nml)
+endif
- ! Echo the namelist values for this module using normal mechanism
- ! including a separator line for this run.
- if (do_output_flag) then
- if (do_nml_file() .and. (nmlfileunit /= logfileunit)) then
- if ( present(progname) ) then
- write(nmlfileunit, *) '!Starting Program '//trim(progname)
- else
- write(nmlfileunit, *) '!Starting Program '
- endif
- endif
- if (do_nml_file()) write(nmlfileunit, nml=utilities_nml)
- if (do_nml_term()) write( * , nml=utilities_nml)
- endif
+! Record the values used for variable kinds
+if (do_output_flag .and. print_debug) call dump_varkinds()
+
+end subroutine initialize_utilities
- ! Record the values used for variable types:
- if (do_output_flag .and. print_debug) then
-
- write( * ,*) ! a little whitespace is nice
- write(logfileunit,*) ! a little whitespace is nice
-
- write(string1,*)'.. digits12 is ',digits12
- write(string2,*)'r8 is ',r8
- write(string3,*)'r4 is ',r4
- call error_handler(E_DBG, 'initialize_utilities', string1, &
- source, revision, revdate, text2=string2, text3=string3)
-
- write(string1,*)'.. integer is ',kind(iunit) ! any integer variable will do
- write(string2,*)'i8 is ',i8
- write(string3,*)'i4 is ',i4
- call error_handler(E_DBG, 'initialize_utilities', string1, &
- source, revision, revdate, text2=string2, text3=string3)
- endif
+!-----------------------------------------------------------------------
+!>
- endif
+subroutine finalize_utilities(progname)
+character(len=*), intent(in), optional :: progname
- contains
-
- function nextunit() result(iunit)
- integer :: iunit
-
- logical :: open
- integer :: i
-
- iunit = -1
- UnitLoop : do i = 10, 80
- inquire (i, opened=open)
- if (.not. open) then
- iunit = i
- exit UnitLoop
- endif
- enddo UnitLoop
- if ( iunit < 0 ) then
- write(*,*)'FATAL ERROR in initialize_utilities'
- write(*,*)' ',trim(source)
- write(*,*)' ',trim(revision)
- write(*,*)' ',trim(revdate)
- endif
- end function nextunit
-
- subroutine checktermlevel
- select case (TERMLEVEL)
- case (E_MSG)
- ! do nothing
- case (E_ALLMSG)
- ! do nothing
- case (E_WARN)
- ! do nothing
- case (E_ERR)
- ! do nothing
- case default
- print *, ' MESSAGE from initialize_utilities'
- print *, ' namelist input of TERMLEVEL is ',TERMLEVEL
- print *, ' possible values are ',E_MSG, E_ALLMSG, E_WARN, E_ERR
- if (TERMLEVEL < E_WARN ) TERMLEVEL = E_WARN
- if (TERMLEVEL > E_ERR ) TERMLEVEL = E_ERR
- print *, ' using ',TERMLEVEL
- end select
- end subroutine checktermlevel
-
- end subroutine initialize_utilities
-
-
-!#######################################################################
-
-
- subroutine finalize_utilities(progname)
- character(len=*), intent(in), optional :: progname
- ! integer :: logfileunit -- private module variable
-
- ! if called multiple times, just return
- if (.not. module_initialized) return
-
- if (do_output_flag) then
- if ( present(progname) ) then
- call write_time (logfileunit, label='Finished ', &
- string1='Program '//trim(progname))
- call write_time ( label='Finished ', &
- string1='Program '//trim(progname))
- else
- call write_time (logfileunit, label='Finished ')
- call write_time ( label='Finished ')
- endif
-
- if (do_nml_file() .and. (nmlfileunit /= logfileunit)) then
- if ( present(progname) ) then
- write(nmlfileunit, *) '!Finished Program '//trim(progname)
- else
- write(nmlfileunit, *) '!Finished Program '
- endif
- endif
- endif
+! if called multiple times, just return
+if (.not. module_initialized) return
- call close_file(logfileunit)
- if ((nmlfileunit /= logfileunit) .and. (nmlfileunit /= -1)) then
- call close_file(nmlfileunit)
- endif
+if (do_output_flag) then
+ if ( present(progname) ) then
+ call log_time (logfileunit, label='Finished ', &
+ string1='Program '//trim(progname))
+ else
+ call log_time (logfileunit, label='Finished ')
+ endif
+
+ if (do_nml_file() .and. (nmlfileunit /= logfileunit)) then
+ if ( present(progname) ) then
+ write(nmlfileunit, *) '!Finished Program '//trim(progname)
+ else
+ write(nmlfileunit, *) '!Finished Program '
+ endif
+ endif
+endif
+
+call close_file(logfileunit)
+if ((nmlfileunit /= logfileunit) .and. (nmlfileunit /= -1)) then
+ call close_file(nmlfileunit)
+endif
+
+module_initialized = .false.
+
+end subroutine finalize_utilities
+
+!-----------------------------------------------------------------------
+!> log the subversion information about the different source modules
+!> being used in this run.
- module_initialized = .false.
+subroutine register_module(src, rev, rdate)
+character(len=*), intent(in) :: src, rev, rdate
- end subroutine finalize_utilities
+if ( .not. do_output_flag) return
+if ( .not. module_details) return
+! you cannot have this routine call init because it calls
+! back into register module. this is an error if this
+! routine is called before initialize_utilities().
+! AND you cannot use the error handler because it hasn't
+! been initialized yet.
-!#######################################################################
+if ( .not. module_initialized ) call fatal_not_initialized('register_module')
+call log_it('')
+call log_it('Registering module :')
+call log_it(src)
+call log_it(rev)
+call log_it(rdate)
+call log_it('Registration complete.')
+call log_it('')
- subroutine register_module(src, rev, rdate)
- character(len=*), intent(in) :: src, rev, rdate
+end subroutine register_module
- if ( .not. module_initialized ) call initialize_utilities
- if ( .not. do_output_flag) return
- if ( .not. module_details) return
+!-----------------------------------------------------------------------
+!> unfortunately you can't pass a namelist as an argument, so all modules
+!> with namelists have to call write() themselves. so this routine and
+!> the next are logicals to say whether (and to where) they should write.
+!>
+!> return whether nml should be written to the nml file
+
+function do_nml_file ()
+
+logical :: do_nml_file
+
+if ( .not. module_initialized ) call initialize_utilities
+
+if ( .not. do_output()) then
+ do_nml_file = .false.
+else
+ do_nml_file = (nml_flag == NML_FILE .or. nml_flag == NML_BOTH)
+endif
+end function do_nml_file
- write(logfileunit,*)
- write(logfileunit,*)'Registering module :'
- write(logfileunit,*)trim(src)
- write(logfileunit,*)trim(rev)
- write(logfileunit,*)trim(rdate)
- write(logfileunit,*)'Registration complete.'
- write(logfileunit,*)
+!-----------------------------------------------------------------------
+!> return whether nml should be written to terminal
+!> for more details see above.
- write( * ,*)
- write( * ,*)'Registering module :'
- write( * ,*)trim(src)
- write( * ,*)trim(rev)
- write( * ,*)trim(rdate)
- write( * ,*)'Registration complete.'
- write( * ,*)
+function do_nml_term ()
- end subroutine register_module
+logical :: do_nml_term
+if ( .not. module_initialized ) call initialize_utilities
-!#######################################################################
+if ( .not. do_output()) then
+ do_nml_term = .false.
+else
+ do_nml_term = (nml_flag == NML_TERMINAL .or. nml_flag == NML_BOTH)
+endif
+end function do_nml_term
- subroutine timestamp(string1,string2,string3,pos)
- character(len=*), optional, intent(in) :: string1
- character(len=*), optional, intent(in) :: string2
- character(len=*), optional, intent(in) :: string3
- character(len=*), intent(in) :: pos
+!-----------------------------------------------------------------------
+!> Opens namelist_file_name if it exists on unit iunit, error if it
+!> doesn't exist.
+!> Searches file for a line containing ONLY the string &nml_name,
+!> for instance &filter_nml. If found, backs up one record and
+!> returns true. Otherwise, error message and terminates
+!>
- if ( .not. module_initialized ) call initialize_utilities
- if ( .not. do_output_flag) return
+subroutine find_namelist_in_file(namelist_file_name, nml_name, iunit)
- if (trim(adjustl(pos)) == 'end') then
- call finalize_utilities()
- else if (trim(adjustl(pos)) == 'brief') then
- call write_time (logfileunit, brief=.true., &
- string1=string1, string2=string2, string3=string3)
- call write_time ( brief=.true., &
- string1=string1, string2=string2, string3=string3)
-
- else
- call write_time (logfileunit, &
- string1=string1, string2=string2, string3=string3)
- call write_time (string1=string1, string2=string2, string3=string3)
-
+character(len=*), intent(in) :: namelist_file_name
+character(len=*), intent(in) :: nml_name
+integer, intent(out) :: iunit
+
+character(len=256) :: next_nml_string, test_string, string1
+integer :: io
+
+if (.not. module_initialized) call fatal_not_initialized('find_namelist_in_file')
+
+! Check for namelist file existence; no file is an error
+if(.not. file_exist(trim(namelist_file_name))) then
+
+ write(msgstring1, *) 'Namelist input file: ', namelist_file_name, ' must exist.'
+ call error_handler(E_ERR, 'find_namelist_in_file', msgstring1, &
+ source, revision, revdate)
+
+endif
+
+iunit = open_file(namelist_file_name, action = 'read')
+
+! Read each line until end of file is found
+! Look for the start of a namelist with &nml_name
+! Convert test string to all uppercase ... since that is
+! what happens if Fortran writes a namelist.
+
+string1 = adjustl(nml_name)
+call to_upper(string1) ! works in-place
+test_string = '&' // trim(string1)
+
+do
+ read(iunit, '(A)', iostat = io) next_nml_string
+ if(io /= 0) then
+ ! Reached end of file and didn't find this namelist
+ write(msgstring1, *) 'Namelist entry &', trim(nml_name), &
+ ' must exist in file ', trim(namelist_file_name)
+ call error_handler(E_ERR, 'find_namelist_in_file', msgstring1, &
+ source, revision, revdate)
+ else
+ ! see if this line starts the namelist we are asking for
+ string1 = adjustl(next_nml_string)
+ call to_upper(string1)
+
+ if(string1 == test_string) then
+ backspace(iunit)
+ return
endif
+ endif
+end do
- end subroutine timestamp
+! not reached
+end subroutine find_namelist_in_file
-!#######################################################################
+!-----------------------------------------------------------------------
- function file_exist (file_name)
+!> Confirms that a namelist read was successful. If it failed
+!> produces an error message and stops execution.
- character(len=*), intent(in) :: file_name
- logical :: file_exist
- integer :: trimlen
+subroutine check_namelist_read(iunit, iostat_in, nml_name)
- if ( .not. module_initialized ) call initialize_utilities
+integer, intent(in) :: iunit, iostat_in
+character(len=*), intent(in) :: nml_name
- trimlen = len_trim(file_name)
+character(len=256) :: nml_string
+integer :: io
- inquire (file=file_name(1:trimlen), exist=file_exist)
+if (.not. module_initialized) call fatal_not_initialized('check_namelist_read')
- end function file_exist
+! If the namelist read was successful, close the namelist file and we're done.
+if(iostat_in == 0) then
+ call close_file(iunit)
+ return
+endif
+! If it wasn't successful, print the line on which it failed
+backspace(iunit)
+read(iunit, '(A)', iostat = io) nml_string
-!#######################################################################
+! A failure in this read means that the namelist started but never terminated
+! Result was falling off the end, so backspace followed by read fails
+if(io /= 0) then
+ write(msgstring1, *) 'Namelist ', trim(nml_name), ' started but never terminated'
+else
+ ! Didn't fall off end so bad entry in the middle of namelist
+ write(msgstring1, *) 'INVALID NAMELIST ENTRY: ', trim(nml_string), ' in namelist ', trim(nml_name)
+endif
+call error_handler(E_ERR, 'check_namelist_read', msgstring1, &
+ source, revision, revdate)
- function get_unit () result (iunit)
+end subroutine check_namelist_read
- integer :: i, iunit
- logical :: available
+!-----------------------------------------------------------------------
+!> if trying to write an unformatted string, like "write(*,*)"
+!> to both standard output and the logfile, call this routine instead.
+!> it prevents you from having to maintain two copies of the same
+!> output message.
- if ( .not. module_initialized ) call initialize_utilities
+subroutine log_it(message)
+character(len=*), intent(in) :: message
-! ---- get available unit ----
+ write( * , *) trim(message)
+if (logfileunit >= 0) write(logfileunit, *) trim(message)
- iunit = -1
- do i = 10, 80
- inquire (i, opened=available)
- if (.not. available) then
- iunit = i
- exit
- endif
- enddo
+end subroutine log_it
- if (iunit == -1) call error_handler(E_ERR,'get_unit', &
- 'No available units.', source, revision, revdate)
- end function get_unit
+!-----------------------------------------------------------------------
+!> call this routine if you cannot open the log file.
+subroutine fatal_opening_log(from_routine, lname)
-!#######################################################################
+character(len=*), intent(in) :: from_routine
+character(len=*), intent(in) :: lname
+write(*,*)'FATAL ERROR in '//trim(from_routine)
+write(*,*)' unable to open the logfile for writing.'
+write(*,*)' the logfile name is "',trim(lname),'"'
+write(*,*)' ',trim(source)
+write(*,*)' ',trim(revision)
+write(*,*)' ',trim(revdate)
+write(*,*)' stopping.'
+call exit_all(66)
- subroutine dump_unit_attributes(iunit)
-!--------------------------------------------------------------------------------
-! subroutine dump_unit_attributes(iunit)
-!
-! Useful for dumping all the attributes for a file 'unit'
-! A debugging routine, really. TJH Oct 2004
+end subroutine fatal_opening_log
- integer, intent(in) :: iunit
+!-----------------------------------------------------------------------
+!> call this routine if you end up in a function or subroutine here
+!> that CANNOT be called before the initialize_utilities() or
+!> initialize_mpi_utilities() routine is called.
- logical :: exists, connected, named_file
- character(len=256) :: file_name
- character(len=512) :: str1
- character(len=32) :: srname
- character(len=32) :: ynu ! YES, NO, UNDEFINED ... among others
- integer :: ios, reclen, nextrecnum
+subroutine fatal_not_initialized(from_routine)
- if ( .not. module_initialized ) call initialize_utilities
+character(len=*), intent(in) :: from_routine
- srname = "dump_unit_attributes"
+write(*,*)'FATAL ERROR in '//trim(from_routine)
+write(*,*)' initialize_utilities() or initialize_mpi_utilities()'
+write(*,*)' must be called before calling '//trim(from_routine)//'().'
+write(*,*)' ',trim(source)
+write(*,*)' ',trim(revision)
+write(*,*)' ',trim(revdate)
+write(*,*)' stopping.'
+call exit_all(77)
-! --- start querying
+end subroutine fatal_not_initialized
- write(str1,*)'for unit ',iunit
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
+!-----------------------------------------------------------------------
+!> call this routine if you find an error before the logfile
+!> has been opened.
- inquire(iunit, opened = connected, iostat=ios)
- if ( connected .and. (ios == 0) ) &
- call error_handler(E_MSG, srname, ' connected', source, revision, revdate)
+subroutine fatal_error_w_no_log(from_routine, msg1, msg2, msg3)
- inquire(iunit, named = named_file, iostat=ios)
- if ( named_file .and. (ios == 0) ) &
- call error_handler(E_MSG, srname, ' file is named.', source, revision, revdate)
+character(len=*), intent(in) :: from_routine
+character(len=*), intent(in), optional :: msg1
+character(len=*), intent(in), optional :: msg2
+character(len=*), intent(in), optional :: msg3
- inquire(iunit, name = file_name, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'file name is ' // trim(adjustl(file_name))
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+write(*,*)'FATAL ERROR in '//trim(from_routine)
+if (present(msg1)) write(*,*) trim(msg1)
+if (present(msg2)) write(*,*) trim(msg2)
+if (present(msg2)) write(*,*) trim(msg3)
+write(*,*)' ',trim(source)
+write(*,*)' ',trim(revision)
+write(*,*)' ',trim(revdate)
+write(*,*)' stopping.'
+call exit_all(88)
- inquire(iunit, exist = exists, iostat=ios)
- if ( exists .and. (ios == 0) ) &
- call error_handler(E_MSG, srname, ' file exists', source, revision, revdate)
+end subroutine fatal_error_w_no_log
- inquire(iunit, recl = reclen, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'record length is ', reclen
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+!-----------------------------------------------------------------------
- inquire(iunit, nextrec = nextrecnum, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'next record is ', nextrecnum
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+subroutine check_term_level(level)
- inquire(iunit, access = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'access_type is ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+integer, intent(in) :: level
- inquire(iunit, sequential = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'is file sequential ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+if (.not. module_initialized) call fatal_not_initialized('check_term_level')
- inquire(iunit, direct = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'is file direct ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+select case (level)
+ case (E_MSG, E_ALLMSG, E_WARN, E_ERR, E_DBG)
+ ! ok, do nothing
+ case default
+ write(msgstring1, *) 'bad integer value for "termlevel", must be one of'
+ write(msgstring2, *) '-1 (E_MSG), 0 (E_ALLMSG), 1 (E_WARN), 2 (E_ERR), -2 (E_DBG)'
+ call error_handler(E_ERR,'check_term_level', msgstring1, &
+ source, revision, revdate, text2=msgstring2)
- inquire(iunit, form = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'file format ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+ end select
- inquire(iunit, action = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'action ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+end subroutine check_term_level
- inquire(iunit, read = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'read ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
- inquire(iunit, write = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'write ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! file and error handling
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
- inquire(iunit, readwrite = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'readwrite ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
- inquire(iunit, blank = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'blank ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+!-----------------------------------------------------------------------
+!>
- inquire(iunit, position = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'position ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+function file_exist (file_name)
- inquire(iunit, delim = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'delim ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+character(len=*), intent(in) :: file_name
+logical :: file_exist
- inquire(iunit, pad = ynu, iostat=ios)
- if ( ios == 0 ) then
- write(str1,*)'pad ', ynu
- call error_handler(E_MSG, srname, str1, source, revision, revdate)
- endif
+if ( .not. module_initialized ) call initialize_utilities
- end subroutine dump_unit_attributes
+inquire (file=file_name, exist=file_exist)
+end function file_exist
-!#######################################################################
+!-----------------------------------------------------------------------
+!>
- subroutine error_mesg (routine, message, level)
+! get available file unit number
+function get_unit()
+integer :: get_unit
-! ------------------------------------
-! | |
-! | a very simple error handler |
-! | |
-! ------------------------------------
-!
-! input:
-! routine name of the calling routine (character string)
-! message message written to standard output (character string)
-! level if not equal to zero then the program terminates
-!
- character(len=*), intent(in) :: routine, message
- integer, intent(in) :: level
+integer :: i, iunit
+logical :: open
- select case (iabs(level))
- case (0)
- if ( .not. do_output_flag) return
- print *, ' MESSAGE from ',routine(1:len_trim(routine))
- print *, ' ',message(1:len_trim(message))
- case (1)
- print *, ' WARNING in ',routine(1:len_trim(routine))
- print *, ' ',message(1:len_trim(message))
- case default
- print *, ' ERROR in ',routine(1:len_trim(routine))
- print *, ' ',message(1:len_trim(message))
- call exit_all(99)
- end select
+if ( .not. module_initialized ) call fatal_not_initialized('get_unit')
+
+iunit = -1
+do i = 10, 80
+ inquire (i, opened=open)
+ if (.not. open) then
+ get_unit = i
+ return
+ endif
+enddo
-! --------------------------------------------
+! if you get here it is an error
+write(msgstring1, *) 'Unable to find an available unit number between 10 and 80'
+call error_handler(E_ERR,'get_unit', msgstring1, source, revision, revdate)
- end subroutine error_mesg
+end function get_unit
-!#######################################################################
+!-----------------------------------------------------------------------
+!> write to log and/or standard output, messages, warnings, debug, errors
+!>
- subroutine error_handler(level, routine, text, src, rev, rdate, aut, text2, text3 )
-!----------------------------------------------------------------------
-! subroutine error_handler(level, routine, text, src, rev, rdate, aut , text2, text3)
-!
-! logs warning/error
-implicit none
+subroutine error_handler(level, routine, text, src, rev, rdate, aut, text2, text3 )
integer, intent(in) :: level
character(len=*), intent(in) :: routine, text
character(len=*), intent(in), optional :: src, rev, rdate, aut, text2, text3
-character(len=8) :: taskstr
+character(len=16) :: taskstr, msgtype
+character(len=256) :: wherefrom, wherecont
-if ( .not. module_initialized ) call initialize_utilities
+! the init code uses the error_handler so no trying to call init from here.
+if ( .not. module_initialized ) call fatal_not_initialized('error_handler')
+
+! handle the case where we have an error without an open log file.
+
+if (logfileunit < 0) call fatal_error_w_no_log(routine, text, text2, text3)
+
+! early returns:
+
+! messages only print if the 'do_output_flag' is on, which by default
+! is only task 0. debug messages only print if enabled.
+
+if (level == E_MSG .and. .not. do_output_flag) return
+if (level == E_DBG .and. .not. print_debug) return
+
+! if we get here, we're printing something. set up some strings
+! to make the code below simpler.
+
+if ( single_task ) then
+ taskstr = ''
+else
+ if (task_number == 0) then
+ write(taskstr, '(a)' ) "PE 0: "
+ else
+ write(taskstr, '(a,i5,a)' ) "PE ", task_number, ": "
+ endif
+endif
+
+! these are going to get used a lot below. make them
+! single strings so the code is easier to parse. but can't
+! add trailing blanks here because trim will strip them below.
+
+wherefrom = trim(taskstr)//' '//trim(routine)
+wherecont = trim(taskstr)//' '//trim(routine)//' ...'
+
+if (level == E_ERR) msgtype = 'ERROR FROM:'
+if (level == E_WARN) msgtype = 'WARNING FROM:'
+if (level == E_DBG) msgtype = 'DEBUG FROM:'
! current choice is to log all errors and warnings regardless
! of setting of output flag. messages only print from those
@@ -801,165 +673,38 @@ subroutine error_handler(level, routine, text, src, rev, rdate, aut, text2, text
select case(level)
case (E_MSG)
-
- if ( .not. do_output_flag) return
- if ( single_task ) then
- write( * , *) trim(routine),' ', trim(text)
- write(logfileunit, *) trim(routine),' ', trim(text)
- if ( present(text2)) then
- write( * , *) trim(routine),' ... ', trim(text2)
- write(logfileunit, *) trim(routine),' ... ', trim(text2)
- endif
- if ( present(text3)) then
- write( * , *) trim(routine),' ... ', trim(text3)
- write(logfileunit, *) trim(routine),' ... ', trim(text3)
- endif
- else
- ! FIXME: should they just all use i5? but most common case is only
- ! messages from PE0, so it's tempting not to waste all those columns.
- if (task_number == 0) then
- write(taskstr, '(a)' ) "PE 0"
- else
- write(taskstr, '(a,i5)' ) "PE ", task_number
- endif
- write( * , *) trim(taskstr),': ',trim(routine),' ', trim(text)
- write(logfileunit, *) trim(taskstr),': ',trim(routine),' ', trim(text)
- if ( present(text2)) then
- write( * , *) trim(taskstr),': ',trim(routine),' ... ', trim(text2)
- write(logfileunit, *) trim(taskstr),': ',trim(routine),' ... ', trim(text2)
- endif
- if ( present(text3)) then
- write( * , *) trim(taskstr),': ',trim(routine),' ... ', trim(text3)
- write(logfileunit, *) trim(taskstr),': ',trim(routine),' ... ', trim(text3)
- endif
- endif
+ call log_it(trim(wherefrom)//' '//trim(text))
+ if (present(text2)) call log_it(trim(wherecont)//' '//trim(text2))
+ if (present(text3)) call log_it(trim(wherecont)//' '//trim(text3))
case (E_ALLMSG)
if ( single_task ) then
- write( * , *) trim(routine),' ', trim(text)
- write(logfileunit, *) trim(routine),' ', trim(text)
- if ( present(text2)) then
- write( * , *) trim(routine),' ... ', trim(text2)
- write(logfileunit, *) trim(routine),' ... ', trim(text2)
- endif
- if ( present(text3)) then
- write( * , *) trim(routine),' ... ', trim(text3)
- write(logfileunit, *) trim(routine),' ... ', trim(text3)
- endif
+ call log_it(trim(wherefrom)//' '//trim(text))
+ if (present(text2)) call log_it(trim(wherecont)//' '//trim(text2))
+ if (present(text3)) call log_it(trim(wherecont)//' '//trim(text3))
else
- write(taskstr, '(a,i5)' ) "PE ", task_number
- write( * , *) trim(taskstr),': ',trim(routine),' ', trim(text)
- if ( present(text2)) then
- write( * , *) trim(taskstr),': ',trim(routine),' ... ', trim(text2)
- endif
- if ( present(text3)) then
- write( * , *) trim(taskstr),': ',trim(routine),' ... ', trim(text3)
- endif
+ ! this has a problem that multiple tasks are writing to the same logfile.
+ ! it's overwriting existing content. short fix is to NOT write ALLMSGs
+ ! to the log file, only stdout.
+ write(*,*) trim(trim(wherefrom)//' '//trim(text))
+ if (present(text2)) write(*,*) trim(trim(wherecont)//' '//trim(text2))
+ if (present(text3)) write(*,*) trim(trim(wherecont)//' '//trim(text3))
endif
- case (E_DBG)
- if (print_debug) then
-
- ! what about do_output_flag? want messages from all procs or just PE0?
-
- if ( single_task ) then
- write( * , *) 'DEBUG FROM: ', trim(routine),' ', trim(text)
- write(logfileunit, *) 'DEBUG FROM: ', trim(routine),' ', trim(text)
- if ( present(text2)) then
- write( * , *) 'DEBUG FROM: ', trim(routine),' ... ', trim(text2)
- write(logfileunit, *) 'DEBUG FROM: ', trim(routine),' ... ', trim(text2)
- endif
- if ( present(text3)) then
- write( * , *) 'DEBUG FROM: ', trim(routine),' ... ', trim(text3)
- write(logfileunit, *) 'DEBUG FROM: ', trim(routine),' ... ', trim(text3)
- endif
- else
- if (task_number == 0) then
- write(taskstr, '(a)' ) "PE 0"
- else
- write(taskstr, '(a,i5)' ) "PE ", task_number
- endif
- write( * , *) trim(taskstr),': DEBUG FROM: ',trim(routine),' ', trim(text)
- write(logfileunit, *) trim(taskstr),': DEBUG FROM: ',trim(routine),' ', trim(text)
- if ( present(text2)) then
- write( * , *) trim(taskstr),': DEBUG FROM: ',trim(routine),' ... ', trim(text2)
- write(logfileunit, *) trim(taskstr),': DEBUG FROM: ',trim(routine),' ... ', trim(text2)
- endif
- if ( present(text3)) then
- write( * , *) trim(taskstr),': DEBUG FROM: ',trim(routine),' ... ', trim(text3)
- write(logfileunit, *) trim(taskstr),': DEBUG FROM: ',trim(routine),' ... ', trim(text3)
- endif
- endif
- endif
+ case (E_DBG, E_WARN, E_ERR)
- case (E_WARN)
-
- write( * , *) 'WARNING FROM:'
- if ( .not. single_task ) &
- write( * , *) ' task id: ', task_number
- write( * , *) ' routine: ', trim(routine)
- write( * , *) ' message: ', trim(text)
- if ( present(text2)) &
- write( * , *) ' message: ... ', trim(text2)
- if ( present(text3)) &
- write( * , *) ' message: ... ', trim(text3)
- write( * , *) ' '
- write( * , *) ' source file: ', trim(src)
- write( * , *) ' file revision: ', trim(rev)
- write( * , *) ' revision date: ', trim(rdate)
- if(present(aut)) &
- write( * , *) ' last editor: ', trim(aut)
-
- write(logfileunit, *) 'WARNING FROM:'
- if ( .not. single_task ) &
- write(logfileunit, *) ' task id: ', task_number
- write(logfileunit, *) ' routine: ', trim(routine)
- write(logfileunit, *) ' message: ', trim(text)
- if ( present(text2)) &
- write(logfileunit, *) ' message: ... ', trim(text2)
- if ( present(text3)) &
- write(logfileunit, *) ' message: ... ', trim(text3)
- write(logfileunit, *) ' '
- write(logfileunit, *) ' source file: ', trim(src)
- write(logfileunit, *) ' file revision: ', trim(rev)
- write(logfileunit, *) ' revision date: ', trim(rdate)
- if(present(aut)) &
- write(logfileunit, *) ' last editor: ', trim(aut)
-
- case(E_ERR)
-
- write( * , *) 'ERROR FROM:'
- if ( .not. single_task ) &
- write( * , *) ' task id: ', task_number
- write( * , *) ' routine: ', trim(routine)
- write( * , *) ' message: ', trim(text)
- if ( present(text2)) &
- write( * , *) ' message: ... ', trim(text2)
- if ( present(text3)) &
- write( * , *) ' message: ... ', trim(text3)
- write( * , *) ' '
- write( * , *) ' source file: ', trim(src)
- write( * , *) ' file revision: ', trim(rev)
- write( * , *) ' revision date: ', trim(rdate)
- if(present(aut)) &
- write( * , *) ' last editor: ', trim(aut)
-
- write(logfileunit, *) 'ERROR FROM:'
- if ( .not. single_task ) &
- write(logfileunit, *) ' task id: ', task_number
- write(logfileunit, *) ' routine: ', trim(routine)
- write(logfileunit, *) ' message: ', trim(text)
- if ( present(text2)) &
- write(logfileunit, *) ' message: ... ', trim(text2)
- if ( present(text3)) &
- write(logfileunit, *) ' message: ... ', trim(text3)
- write(logfileunit, *) ' '
- write(logfileunit, *) ' source file: ', trim(src)
- write(logfileunit, *) ' file revision: ', trim(rev)
- write(logfileunit, *) ' revision date: ', trim(rdate)
- if(present(aut)) &
- write(logfileunit, *) ' last editor: ', trim(aut)
+ call log_it(msgtype)
+ call log_it(wherefrom)
+ call log_it(' routine: '//trim(routine))
+ call log_it(' message: '//trim(text))
+ if (present(text2)) call log_it(' message: ... '//trim(text2))
+ if (present(text3)) call log_it(' message: ... '//trim(text3))
+ call log_it('')
+ call log_it(' source file: '//trim(src))
+ call log_it(' file revision: '//trim(rev))
+ call log_it(' revision date: '//trim(rdate))
+ if(present(aut)) call log_it(' last editor: '//trim(aut))
end select
@@ -969,615 +714,531 @@ subroutine error_handler(level, routine, text, src, rev, rdate, aut, text2, text
end subroutine error_handler
-!#######################################################################
+!-----------------------------------------------------------------------
+!> open a file. assigns a unit number to be used for subsequent read/writes.
+!> can open an existing file, append to an existing file, overwrite an
+!> existing file, or create a new file. additional options for setting the
+!> record length on formatted files, and doing binary byte-swapping conversions.
+function open_file (fname, form, action, access, convert, delim, reclen, return_rc) result (iunit)
- function open_file (fname, form, action, access, convert, delim, reclen, return_rc) result (iunit)
+character(len=*), intent(in) :: fname
+character(len=*), intent(in), optional :: form, action, access, convert, delim
+integer, intent(in), optional :: reclen
+integer, intent(out), optional :: return_rc
+integer :: iunit
- character(len=*), intent(in) :: fname
- character(len=*), intent(in), optional :: form, action, access, convert, delim
- integer, intent(in), optional :: reclen
- integer, intent(out), optional :: return_rc
- integer :: iunit
+integer :: rc, rlen
+logical :: open, use_recl
+character(len=32) :: format, pos, act, stat, acc, conversion, del
- integer :: rc, rlen
- logical :: open, use_recl
- character(len=32) :: format, pos, act, stat, acc, conversion, del
+if ( .not. module_initialized ) call initialize_utilities
- if ( .not. module_initialized ) call initialize_utilities
+! if file already open, set iunit and return
+inquire (file=trim(fname), opened=open, number=iunit, iostat=rc)
+if (open) then
+ if (present(return_rc)) return_rc = rc
+ return
+endif
- ! if file already open, set iunit and return
- inquire (file=trim(fname), opened=open, number=iunit, iostat=rc)
- if (open) then
- if (present(return_rc)) return_rc = rc
- return
- endif
+! not already open, so open it.
+
+! set defaults, and then modify depending on what user requests
+! via the arguments. this combination of settings either creates
+! a new file or overwrites an existing file from the beginning.
+
+format = 'formatted'
+act = 'readwrite'
+pos = 'rewind'
+stat = 'unknown'
+acc = 'sequential'
+rlen = 1
+del = 'apostrophe'
+conversion = 'native'
+
+if (present(form)) format = form
+call to_upper(format)
+
+! change defaults based on intended action.
+if (present(action)) then
+ select case(action)
+
+ case ('read', 'READ')
+ ! open existing file. fail if not found. read from start.
+ act = 'read'
+ stat = 'old'
+
+ case ('write', 'WRITE')
+ ! create new file/replace existing file. write at start.
+ act = 'write'
+ stat = 'replace'
+
+ case ('append', 'APPEND')
+ ! create new/open existing file. write at end if existing.
+ act = 'readwrite'
+ pos = 'append'
+
+ case default
+ ! if the user specifies an action, make sure it is a valid one.
+ write(msgstring1,*) 'opening file "'//trim(fname)//'"'
+ write(msgstring2,*) 'unrecognized action, "'//trim(action)//'"; valid values: "read", "write", "append"'
+ call error_handler(E_ERR, 'open_file', msgstring1, source, revision, revdate, text2=msgstring2)
+ end select
+endif
+
+! from the ibm help pages:
+! valid values for access: SEQUENTIAL, DIRECT or STREAM.
+! If ACCESS= is DIRECT, RECL= must be specified.
+! If ACCESS= is STREAM, RECL= must not be specified.
+! SEQUENTIAL is the default, for which RECL= is optional
+! i can't see how to specify all the options in any kind of reasonable way.
+! but i need to be able to specify 'stream'... so here's a stab at it.
+
+if (present(access)) then
+ acc = access
+ call to_upper(acc)
+endif
+
+! recl can't apply to stream files, is required for direct,
+! and is optional for sequential. ugh.
+if (present(reclen)) then
+ rlen = reclen
+ use_recl = .true.
+else if (acc == 'DIRECT') then
+ use_recl = .true.
+else
+ use_recl = .false.
+endif
- ! not already open, so open it.
-
- ! set defaults, and then modify depending on what user requests
- ! via the arguments. this combination of settings either creates
- ! a new file or overwrites an existing file from the beginning.
-
- format = 'formatted'
- act = 'readwrite'
- pos = 'rewind'
- stat = 'unknown'
- acc = 'sequential'
- rlen = 1
- del = 'apostrophe'
- conversion = 'native'
-
- if (present(form)) format = form
- call to_upper(format)
-
- ! change defaults based on intended action.
- if (present(action)) then
- select case(action)
-
- case ('read', 'READ')
- ! open existing file. fail if not found. read from start.
- act = 'read'
- stat = 'old'
-
- case ('write', 'WRITE')
- ! create new file/replace existing file. write at start.
- act = 'write'
- stat = 'replace'
-
- case ('append', 'APPEND')
- ! create new/open existing file. write at end if existing.
- act = 'readwrite'
- pos = 'append'
-
- case default
- ! if the user specifies an action, make sure it is a valid one.
- write(msgstring1,*) 'opening file "'//trim(fname)//'"'
- write(msgstring2,*) 'unrecognized action, "'//trim(action)//'"; valid values: "read", "write", "append"'
- call error_handler(E_ERR, 'open_file', msgstring1, source, revision, revdate, text2=msgstring2)
- end select
+! endian-conversion only applies to binary files
+! valid values seem to be: 'native', 'big-endian', 'little-endian', and possibly 'cray'
+! depending on the compiler.
+if (present(convert)) then
+ if (format == 'FORMATTED') then
+ write(msgstring1,*) 'opening file "'//trim(fname)//'"'
+ write(msgstring2,*) 'cannot specify binary conversion on a formatted file'
+ call error_handler(E_ERR, 'open_file ', msgstring1, source, revision, revdate, text2=msgstring2)
endif
+ conversion = convert
+endif
- ! from the ibm help pages:
- ! valid values for access: SEQUENTIAL, DIRECT or STREAM.
- ! If ACCESS= is DIRECT, RECL= must be specified.
- ! If ACCESS= is STREAM, RECL= must not be specified.
- ! SEQUENTIAL is the default, for which RECL= is optional
- ! i can't see how to specify all the options in any kind of reasonable way.
- ! but i need to be able to specify 'stream'... so here's a stab at it.
-
- if (present(access)) then
- acc = access
- call to_upper(acc)
+! string delimiters only apply to ascii files
+if (present(delim)) then
+ if (format /= 'FORMATTED') then
+ write(msgstring1,*) 'opening file "'//trim(fname)//'"'
+ write(msgstring2,*) 'cannot specify a delimiter on an unformatted file'
+ call error_handler(E_ERR, 'open_file ', msgstring1, source, revision, revdate, text2=msgstring2)
endif
+ del = delim
+endif
+
+! ok, now actually open the file
- ! recl can't apply to stream files, is required for direct,
- ! and is optional for sequential. ugh.
- if (present(reclen)) then
- rlen = reclen
- use_recl = .true.
- else if (acc == 'DIRECT') then
- use_recl = .true.
+iunit = get_unit()
+
+if (format == 'FORMATTED') then
+ ! formatted file: only pass in recl if required
+ if (use_recl) then
+ open (iunit, file=trim(fname), form=format, access=acc, recl=rlen, &
+ delim=del, position=pos, action=act, status=stat, iostat=rc)
else
- use_recl = .false.
+ open (iunit, file=trim(fname), form=format, access=acc, &
+ delim=del, position=pos, action=act, status=stat, iostat=rc)
endif
-
- ! endian-conversion only applies to binary files
- ! valid values seem to be: 'native', 'big-endian', 'little-endian', and possibly 'cray'
- ! depending on the compiler.
- if (present(convert)) then
- if (format == 'FORMATTED') then
- write(msgstring1,*) 'opening file "'//trim(fname)//'"'
- write(msgstring2,*) 'cannot specify binary conversion on a formatted file'
- call error_handler(E_ERR, 'open_file ', msgstring1, source, revision, revdate, text2=msgstring2)
- endif
- conversion = convert
+else
+ ! unformatted file - again, only pass in recl if required
+ if (use_recl) then
+ open (iunit, file=trim(fname), form=format, access=acc, recl=rlen, &
+ convert=conversion, position=pos, action=act, status=stat, iostat=rc)
+ else
+ open (iunit, file=trim(fname), form=format, access=acc, &
+ convert=conversion, position=pos, action=act, status=stat, iostat=rc)
endif
+endif
+if (rc /= 0 .and. print_debug) call dump_unit_attributes(iunit)
- ! string delimiters only apply to ascii files
- if (present(delim)) then
- if (format /= 'FORMATTED') then
- write(msgstring1,*) 'opening file "'//trim(fname)//'"'
- write(msgstring2,*) 'cannot specify a delimiter on an unformatted file'
- call error_handler(E_ERR, 'open_file ', msgstring1, source, revision, revdate, text2=msgstring2)
- endif
- del = delim
- endif
+if (present(return_rc)) then
+ return_rc = rc
+ return
+endif
- ! ok, now actually open the file
+if (rc /= 0) then
+ write(msgstring1, *)'Cannot open file "'//trim(fname)//'" for '//trim(act)
+ write(msgstring2,*)'File may not exist or permissions may prevent the requested operation'
+ write(msgstring3,*)'Error code was ', rc
+ call error_handler(E_ERR, 'open_file: ', msgstring1, source, revision, revdate, &
+ text2=msgstring2, text3=msgstring3)
+endif
- iunit = get_unit()
+end function open_file
- if (format == 'FORMATTED') then
- ! formatted file: only pass in recl if required
- if (use_recl) then
- open (iunit, file=trim(fname), form=format, access=acc, recl=rlen, &
- delim=del, position=pos, action=act, status=stat, iostat=rc)
- else
- open (iunit, file=trim(fname), form=format, access=acc, &
- delim=del, position=pos, action=act, status=stat, iostat=rc)
- endif
- else
- ! unformatted file - again, only pass in recl if required
- if (use_recl) then
- open (iunit, file=trim(fname), form=format, access=acc, recl=rlen, &
- convert=conversion, position=pos, action=act, status=stat, iostat=rc)
- else
- open (iunit, file=trim(fname), form=format, access=acc, &
- convert=conversion, position=pos, action=act, status=stat, iostat=rc)
- endif
- endif
- if (rc /= 0 .and. print_debug) call dump_unit_attributes(iunit)
-
- if (present(return_rc)) then
- return_rc = rc
- return
- endif
-
- if (rc /= 0) then
- write(msgstring1, *)'Cannot open file "'//trim(fname)//'" for '//trim(act)
- write(msgstring2,*)'File may not exist or permissions may prevent the requested operation'
- write(msgstring3,*)'Error code was ', rc
- call error_handler(E_ERR, 'open_file: ', msgstring1, source, revision, revdate, &
- text2=msgstring2, text3=msgstring3)
- endif
-
- end function open_file
+!-----------------------------------------------------------------------
+!> Closes the given unit_number if that unit is open.
+!> Not an error to call on an already closed unit.
+!> Will print a message if the status of the unit cannot be determined.
-!#######################################################################
+subroutine close_file(iunit)
+integer, intent(in) :: iunit
- subroutine write_time (unit, label, string1, string2, string3, tz, brief)
+integer :: ios
+logical :: open
-! *** Write the current time to a log file or standard output ***
-!
-! in: unit number (default is * if not specified)
-! in: label (default is "Time is" if not specified)
-! in: string1,2,3 (no defaults)
-!
-! default output is a block of 3-4 lines, with dashed line separators
-! and up to 3 descriptive text strings.
-! if brief specified as true, only string1 printed if given,
-! and time printed on same line in YYYY/MM/DD HH:MM:SS format
-! with the tag 'TIME:' before it. should be easier to postprocess.
-
- integer, optional, intent(in) :: unit
- character(len=*), optional, intent(in) :: label
- character(len=*), optional, intent(in) :: string1
- character(len=*), optional, intent(in) :: string2
- character(len=*), optional, intent(in) :: string3
- logical, optional, intent(in) :: tz
- logical, optional, intent(in) :: brief
+if ( .not. module_initialized ) call initialize_utilities
+inquire (unit=iunit, opened=open, iostat=ios)
+if ( ios /= 0 ) then
+ write(msgstring1,*)'Unable to determine status of file unit ', iunit
+ call error_handler(E_MSG, 'close_file: ', msgstring1, source, revision, revdate)
+endif
- integer :: lunit
- character(len= 8) :: cdate
- character(len=10) :: ctime
- character(len= 5) :: zone
- integer, dimension(8) :: values
- logical :: oneline
+if (open) close(iunit)
- if (present(unit)) then
- lunit = unit
- else
- lunit = 6 ! this should be *
- endif
+end subroutine close_file
- call DATE_AND_TIME(cdate, ctime, zone, values)
+!-----------------------------------------------------------------------
+!> Function that returns .true. if this unit number refers to an open file.
- ! give up if no good values were returned
- if (.not. any(values /= -HUGE(0)) ) return
+function is_file_open(iunit)
- oneline = .false.
- if (present(brief)) oneline = brief
+integer, intent(in) :: iunit
+logical :: is_file_open
- if (oneline) then
- if (present(string1)) then
- write(lunit,'(A,1X,I4,5(A1,I2.2))') string1//' TIME:', &
- values(1), '/', values(2), '/', values(3), &
- ' ', values(5), ':', values(6), ':', values(7)
- else
- write(lunit,'(A,1X,I4,5(A1,I2.2))') 'TIME: ', &
- values(1), '/', values(2), '/', values(3), &
- ' ', values(5), ':', values(6), ':', values(7)
- endif
- else
- write(lunit,*)
- write(lunit,*)'--------------------------------------'
- if ( present(label) ) then
- write(lunit,*) label // '... at YYYY MM DD HH MM SS = '
- else
- write(lunit,*) 'Time is ... at YYYY MM DD HH MM SS = '
- endif
- write(lunit,'(17x,i4,5(1x,i2))') values(1), values(2), &
- values(3), values(5), values(6), values(7)
-
- if(present(string1)) write(lunit,*)trim(string1)
- if(present(string2)) write(lunit,*)trim(string2)
- if(present(string3)) write(lunit,*)trim(string3)
-
- if (present(tz)) then
- if ( values(4) /= -HUGE(0) .and. tz) &
- write(lunit,*)'time zone offset is ',values(4),' minutes.'
- endif
-
- write(lunit,*)'--------------------------------------'
- write(lunit,*)
- endif
+integer :: ios
+logical :: open
- end subroutine write_time
+if ( .not. module_initialized ) call initialize_utilities
+inquire (unit=iunit, opened=open, iostat=ios)
+if ( ios /= 0 ) then
+ write(msgstring1,*)'Unable to determine status of file unit ', iunit
+ call error_handler(E_MSG, 'is_file_open: ', msgstring1, source, revision, revdate)
+endif
-!#######################################################################
+is_file_open = open
+end function is_file_open
- subroutine set_output (doflag)
+!-----------------------------------------------------------------------
+!> Common routine for decoding read/write file format string.
+!> Returns .true. for formatted/ascii file, .false. is unformatted/binary
+!> Defaults (if fform not specified) to formatted/ascii.
-! *** set whether output is written to a log file or simply ignored ***
-!
-! in: doflag = whether to output log information or not
+function ascii_file_format(fform)
- logical, intent(in) :: doflag
+character(len=*), intent(in), optional :: fform
+logical :: ascii_file_format
-!! THIS ONE IS DIFFERENT. Set the flag FIRST before doing the
-!! standard initialization, so if you are turning off writing
-!! for some tasks you do not get output you are trying to avoid.
- do_output_flag = doflag
+if ( .not. module_initialized ) call initialize_utilities
- if ( .not. module_initialized ) call initialize_utilities
+! Default to formatted/ascii.
+if ( .not. present(fform)) then
+ ascii_file_format = .true.
+ return
+endif
- end subroutine set_output
+SELECT CASE (fform)
+ CASE("unf", "UNF", "unformatted", "UNFORMATTED")
+ ascii_file_format = .false.
+ CASE DEFAULT
+ ascii_file_format = .true.
+END SELECT
+end function ascii_file_format
-!#######################################################################
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! time and text/text file handling
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
- function do_output ()
+!-----------------------------------------------------------------------
+!>@todo FIXME: nsc opinion:
+!> 1. this routine should NOT support 'end' anymore. the calling code
+!> should call finalize_utilities() directly.
+!> 2. 'brief' format should be the default (easier to grep for and to
+!> sed for postprocessing)
+!> 3. write_time() should be able to take a string to write into
-! *** return whether output should be written from this task ***
-!
+subroutine timestamp(string1,string2,string3,pos)
- logical :: do_output
+ character(len=*), optional, intent(in) :: string1
+ character(len=*), optional, intent(in) :: string2
+ character(len=*), optional, intent(in) :: string3
+ character(len=*), intent(in) :: pos
if ( .not. module_initialized ) call initialize_utilities
+ if ( .not. do_output_flag) return
- do_output = do_output_flag
-
- end function do_output
-
-
-!#######################################################################
-
-
- subroutine set_nml_output (nmlstring)
-
-! *** set whether nml output is written to stdout file or only nml file
-!
-! in: doflag = whether to output nml information to stdout
-
- character(len=*), intent(in) :: nmlstring
+!>@todo remove this option after a few months of having it deprecated.
+ if (pos == 'end') then
+ call log_it('calling timestamp with the "end" option is deprecated')
+ call log_it('call finalize_utilities() directly instead.')
+ call finalize_utilities()
- if ( .not. module_initialized ) call initialize_utilities
+ else if (pos == 'brief') then
+ call log_time (logfileunit, brief=.true., &
+ string1=string1, string2=string2, string3=string3)
+
+ else
+ call log_time (logfileunit, &
+ string1=string1, string2=string2, string3=string3)
+ endif
- select case (nmlstring)
- case ('NONE', 'none')
- nml_flag = NML_NONE
- call error_handler(E_MSG, 'set_nml_output', &
- 'No echo of NML values')
+end subroutine timestamp
- case ('FILE', 'file')
- nml_flag = NML_FILE
- call error_handler(E_MSG, 'set_nml_output', &
- 'Echo NML values to log file only')
-
- case ('TERMINAL', 'terminal')
- nml_flag = NML_TERMINAL
- call error_handler(E_MSG, 'set_nml_output', &
- 'Echo NML values to terminal output only')
-
- case ('BOTH', 'both')
- nml_flag = NML_BOTH
- call error_handler(E_MSG, 'set_nml_output', &
- 'Echo NML values to both log file and terminal')
-
- case default
- call error_handler(E_ERR, 'set_nml_output', &
- 'unrecognized input string: '//trim(nmlstring), &
- source, revision, revdate)
-
- end select
+!-----------------------------------------------------------------------
+!> write time to standard output and also a unit number if specified.
+!>
+!> in: unit number to write to, in addition to unit 6
+!> in: label (default is "Time is" if not specified)
+!> in: string1,2,3 (no defaults)
+!>
+!>
+!> default output is a block of 3-4 lines, with dashed line separators
+!> and up to 3 descriptive text strings.
+!> if brief specified as true, only string1 printed if given,
+!> and time printed on same line in YYYY/MM/DD HH:MM:SS format
+!> with the tag 'TIME:' before it. should be easier to postprocess.
- end subroutine set_nml_output
+subroutine log_time(unit, label, string1, string2, string3, tz, brief)
+integer, optional, intent(in) :: unit
+character(len=*), optional, intent(in) :: label
+character(len=*), optional, intent(in) :: string1
+character(len=*), optional, intent(in) :: string2
+character(len=*), optional, intent(in) :: string3
+logical, optional, intent(in) :: tz
+logical, optional, intent(in) :: brief
-!#######################################################################
+integer :: stdout = 6
+if (present(unit)) &
+ call write_time(unit, label, string1, string2, string3, tz, brief)
- function do_nml_file ()
+call write_time(stdout, label, string1, string2, string3, tz, brief)
-! *** return whether nml should be written to nml file
-!
+end subroutine log_time
- logical :: do_nml_file
+!-----------------------------------------------------------------------
+!> write time to the given unit. should have option to write to a string.
+!> and brief should be the default. (my opinion. nsc)
+!>
+!> in: unit number (default is 6 if not specified)
+!> in: label (default is "Time is" if not specified)
+!> in: string1,2,3 (no defaults)
+!>
+!> default output is a block of 3-4 lines, with dashed line separators
+!> and up to 3 descriptive text strings.
+!> if brief specified as true, only string1 printed if given,
+!> and time printed on same line in YYYY/MM/DD HH:MM:SS format
+!> with the tag 'TIME:' before it. should be easier to postprocess.
- if ( .not. module_initialized ) call initialize_utilities
+subroutine write_time(unit, label, string1, string2, string3, tz, brief)
- if ( .not. do_output()) then
- do_nml_file = .false.
- else
- do_nml_file = (nml_flag == NML_FILE .or. nml_flag == NML_BOTH)
- endif
+integer, optional, intent(in) :: unit
+character(len=*), optional, intent(in) :: label
+character(len=*), optional, intent(in) :: string1
+character(len=*), optional, intent(in) :: string2
+character(len=*), optional, intent(in) :: string3
+logical, optional, intent(in) :: tz
+logical, optional, intent(in) :: brief
- end function do_nml_file
+integer :: lunit
+character(len= 8) :: cdate
+character(len=10) :: ctime
+character(len= 5) :: zone
+integer, dimension(8) :: values
+logical :: oneline
-!#######################################################################
+call DATE_AND_TIME(cdate, ctime, zone, values)
- function do_nml_term ()
+! give up if no good values were returned
+if (.not. any(values /= -HUGE(0)) ) return
-! *** return whether nml should be written to terminal
-!
+lunit = 6 ! normal fortran output unit
+if (present(unit)) lunit = unit
- logical :: do_nml_term
+oneline = .false.
+if (present(brief)) oneline = brief
- if ( .not. module_initialized ) call initialize_utilities
+!>@todo write into a string to avoid replicating complex lines
+!> add on the label if it's there separately.
- if ( .not. do_output()) then
- do_nml_term = .false.
+if (oneline) then
+ write(msgstring1,'(A,1X,I4,5(A1,I2.2))') 'TIME:', &
+ values(1), '/', values(2), '/', values(3), &
+ ' ', values(5), ':', values(6), ':', values(7)
+ if (present(string1)) then
+ write(lunit,'(A)') trim(string1)//' '//trim(msgstring1)
else
- do_nml_term = (nml_flag == NML_TERMINAL .or. nml_flag == NML_BOTH)
+ write(lunit,'(A)') trim(msgstring1)
endif
+else
+ write(lunit,*)
+ write(lunit,*)'--------------------------------------'
+ if ( present(label) ) then
+ write(lunit,*) label // '... at YYYY MM DD HH MM SS = '
+ else
+ write(lunit,*) 'Time is ... at YYYY MM DD HH MM SS = '
+ endif
+ write(lunit,'(17x,i4,5(1x,i2))') values(1), values(2), &
+ values(3), values(5), values(6), values(7)
- end function do_nml_term
-
+ if(present(string1)) write(lunit,*)trim(string1)
+ if(present(string2)) write(lunit,*)trim(string2)
+ if(present(string3)) write(lunit,*)trim(string3)
-!#######################################################################
+ if (present(tz)) then
+ if ( values(4) /= -HUGE(0) .and. tz) &
+ write(lunit,*)'time zone offset is ',values(4),' minutes.'
+ endif
+ write(lunit,*)'--------------------------------------'
+ write(lunit,*)
+endif
- subroutine set_tasknum (tasknum)
+end subroutine write_time
-! *** for multiple-task jobs, set the task number for error msgs ***
-!
-! in: tasknum = task number, 0 to N-1
+!-----------------------------------------------------------------------
+!> set whether output is written to a log file or simply ignored
+!>
+!> in: doflag = whether to output log information or not
- integer, intent(in) :: tasknum
- if ( .not. module_initialized ) call initialize_utilities
+subroutine set_output (doflag)
- single_task = .false.
- task_number = tasknum
+logical, intent(in) :: doflag
- end subroutine set_tasknum
+!! THIS ONE IS DIFFERENT. Set the flag FIRST before doing the
+!! standard initialization, so if you are turning off writing
+!! for some tasks you do not get output you are trying to avoid.
+do_output_flag = doflag
-!#######################################################################
+if ( .not. module_initialized ) call initialize_utilities
+end subroutine set_output
-subroutine close_file(iunit)
!-----------------------------------------------------------------------
-!
-! Closes the given unit_number if that unit is open.
-! Not an error to call on an already closed unit.
-! Will print a message if the status of the unit cannot be determined.
-!
+!> return whether output should be written from this task
-integer, intent(in) :: iunit
+function do_output ()
-integer :: ios
-logical :: open
+logical :: do_output
if ( .not. module_initialized ) call initialize_utilities
-inquire (unit=iunit, opened=open, iostat=ios)
-if ( ios /= 0 ) then
- write(msgstring1,*)'Unable to determine status of file unit ', iunit
- call error_handler(E_MSG, 'close_file: ', msgstring1, source, revision, revdate)
-endif
-
-if (open) close(iunit)
-
-end subroutine close_file
-
+do_output = do_output_flag
-!#######################################################################
+end function do_output
-
-subroutine find_namelist_in_file(namelist_file_name, nml_name, iunit, &
- write_to_logfile_in)
!-----------------------------------------------------------------------
-!
-! Opens namelist_file_name if it exists on unit iunit, error if it
-! doesn't exist.
-! Searches file for a line containing ONLY the string
-! &nml_name, for instance &filter_nml. If found, backs up one record and
-! returns true. Otherwise, error message and terminates
-!
-
-character(len=*), intent(in) :: namelist_file_name
-character(len=*), intent(in) :: nml_name
-integer, intent(out) :: iunit
-logical, optional, intent(in) :: write_to_logfile_in
-
-character(len=256) :: nml_string, test_string, string1
-integer :: io
-logical :: write_to_logfile
-
+!> set whether nml output is written to stdout file or only nml file
+!>
+!> in: doflag = whether to output nml information to stdout
-! Decide if there is a logfile or not
-write_to_logfile = .true.
-if(present(write_to_logfile_in)) write_to_logfile = write_to_logfile_in
+subroutine set_nml_output (nmlstring)
-! Check for file existence; no file is an error
-if(file_exist(trim(namelist_file_name))) then
+character(len=*), intent(in) :: nmlstring
- iunit = open_file(trim(namelist_file_name), action = 'read')
+! initialize_utilities calls this routine, so you cannot call
+! the init routine from here.
- ! Read each line until end of file is found
- ! Look for the start of a namelist with &nml_name
- ! Convert test string to all uppercase ... since that is
- ! what happens if Fortran writes a namelist.
+if ( .not. module_initialized ) call fatal_not_initialized('set_nml_output')
- string1 = adjustl(nml_name)
- call to_upper(string1) ! works in-place
- test_string = '&' // trim(string1)
+select case (nmlstring)
+ case ('NONE', 'none')
+ nml_flag = NML_NONE
+ call error_handler(E_MSG, 'set_nml_output', &
+ 'No echo of NML values')
- do
- read(iunit, '(A)', iostat = io) nml_string
- if(io /= 0) then
- ! No values for this namelist; error
- write(msgstring1, *) 'Namelist entry &', nml_name, ' must exist in ', namelist_file_name
- ! Can't write to logfile if it hasn't yet been opened
- if(write_to_logfile) then
- call error_handler(E_ERR, 'find_namelist_in_file', msgstring1, &
- source, revision, revdate)
- else
- write(*, *) 'FATAL ERROR before logfile initialization in utilities_mod'
- write(*, *) 'Error is in subroutine find_namelist_in_file'
- write(*, *) msgstring1
- write(*,*)' ',trim(source)
- write(*,*)' ',trim(revision)
- write(*,*)' ',trim(revdate)
- call exit_all(88)
- endif
- else
+ case ('FILE', 'file')
+ nml_flag = NML_FILE
+ call error_handler(E_MSG, 'set_nml_output', &
+ 'Echo NML values to log file only')
+
+ case ('TERMINAL', 'terminal')
+ nml_flag = NML_TERMINAL
+ call error_handler(E_MSG, 'set_nml_output', &
+ 'Echo NML values to terminal output only')
+
+ case ('BOTH', 'both')
+ nml_flag = NML_BOTH
+ call error_handler(E_MSG, 'set_nml_output', &
+ 'Echo NML values to both log file and terminal')
+
+ case default
+ call error_handler(E_ERR, 'set_nml_output', &
+ 'unrecognized input string: '//trim(nmlstring), &
+ source, revision, revdate)
+
+end select
- string1 = adjustl(nml_string)
- call to_upper(string1)
+end subroutine set_nml_output
- if(trim(string1) == trim(test_string)) then
- backspace(iunit)
- return
- endif
+!-----------------------------------------------------------------------
+!> for multiple-task jobs, set the task number for error msgs
+!>
+!> in: tasknum = task number, 0 to N-1
- endif
- end do
-else
- ! No namelist_file_name file is an error
- write(msgstring1, *) 'Namelist input file: ', namelist_file_name, ' must exist.'
- if(write_to_logfile) then
- call error_handler(E_ERR, 'find_namelist_in_file', msgstring1, &
- source, revision, revdate)
- else
- write(*, *) 'FATAL ERROR before logfile initialization in utilities_mod'
- write(*, *) 'Error is in subroutine find_namelist_in_file'
- write(*, *) msgstring1
- write(*,*)' ',trim(source)
- write(*,*)' ',trim(revision)
- write(*,*)' ',trim(revdate)
- call exit_all(88)
- endif
-endif
+subroutine set_tasknum (tasknum)
-end subroutine find_namelist_in_file
+integer, intent(in) :: tasknum
+if ( .not. module_initialized ) call initialize_utilities
-!#######################################################################
+single_task = .false.
+task_number = tasknum
+end subroutine set_tasknum
-subroutine check_namelist_read(iunit, iostat_in, nml_name, &
- write_to_logfile_in)
!-----------------------------------------------------------------------
-!
-! Confirms that a namelist read was successful. If it failed
-! produces an error message and stops execution.
-!
-
-integer, intent(in) :: iunit, iostat_in
-character(len=*), intent(in) :: nml_name
-logical, intent(in), optional :: write_to_logfile_in
-
-character(len=256) :: nml_string
-integer :: io
-logical :: write_to_logfile
-
-! Decide if there is a logfile or not
-write_to_logfile = .true.
-if(present(write_to_logfile_in)) write_to_logfile = write_to_logfile_in
-
-if(iostat_in == 0) then
- ! If the namelist read was successful, just close the file
- call close_file(iunit)
-else
- ! If it wasn't successful, print the line on which it failed
- backspace(iunit)
- read(iunit, '(A)', iostat = io) nml_string
- ! A failure in this read means that the namelist started but never terminated
- ! Result was falling off the end, so backspace followed by read fails
- if(io /= 0) then
- write(msgstring1, *) 'Namelist ', trim(nml_name), ' started but never terminated'
- if(write_to_logfile) then
- call error_handler(E_ERR, 'check_namelist_read', msgstring1, &
- source, revision, revdate)
- else
- write(*, *) 'FATAL ERROR before logfile initialization in utilities_mod'
- write(*, *) 'Error is in subroutine check_namelist_read'
- write(*, *) msgstring1
- write(*,*)' ',trim(source)
- write(*,*)' ',trim(revision)
- write(*,*)' ',trim(revdate)
- call exit_all(66)
- endif
- else
- ! Didn't fall off end so bad entry in the middle of namelist
- write(msgstring1, *) 'INVALID NAMELIST ENTRY: ', trim(nml_string), ' in namelist ', trim(nml_name)
- if(write_to_logfile) then
- call error_handler(E_ERR, 'check_namelist_read', msgstring1, &
- source, revision, revdate)
- else
- write(*, *) 'FATAL ERROR before logfile initialization in utilities_mod'
- write(*, *) 'Error is in subroutine check_namelist_read'
- write(*, *) msgstring1
- write(*,*)' ',trim(source)
- write(*,*)' ',trim(revision)
- write(*,*)' ',trim(revdate)
- call exit_all(66)
- endif
- endif
-endif
-
-end subroutine check_namelist_read
+!>@todo FIXME: remove this once all other code is calling
+!>this from the netcdf_utilities_mod instead.
-!#######################################################################
+subroutine nc_check(istatus, subr_name, context)
+use netcdf
- subroutine nc_check(istatus, subr_name, context)
- integer, intent (in) :: istatus
- character(len=*), intent(in) :: subr_name
- character(len=*), intent(in), optional :: context
+integer, intent (in) :: istatus
+character(len=*), intent(in) :: subr_name
+character(len=*), intent(in), optional :: context
- character(len=512) :: error_msg
-
- ! if no error, nothing to do here. we are done.
- if( istatus == nf90_noerr) return
+! if no error, nothing to do here. we are done.
+if(istatus == nf90_noerr) return
- ! something wrong. construct an error string and call the handler.
+! something wrong. construct an error string and call the handler.
- ! context is optional, but is very useful if specified.
- ! if context + error code > 129, the assignment will truncate.
- if (present(context) ) then
- error_msg = trim(context) // ': ' // trim(nf90_strerror(istatus))
- else
- error_msg = nf90_strerror(istatus)
- endif
+! context is optional, but is very useful if specified.
+! if context + error code > 512, the assignment will truncate.
+if (present(context) ) then
+ msgstring1 = trim(context) // ': ' // trim(nf90_strerror(istatus))
+else
+ msgstring1 = nf90_strerror(istatus)
+endif
- ! this does not return
- call error_mesg(subr_name, error_msg, FATAL)
+! this does not return
+call error_handler(E_ERR, 'nc_check', msgstring1, source, revision, revdate, &
+ text2=subr_name)
+end subroutine nc_check
- end subroutine nc_check
+!-----------------------------------------------------------------------
+!> convert a string to upper case *in place*
-!#######################################################################
+subroutine to_upper( string )
+character(len=*), intent(inout) :: string
-subroutine to_upper( string )
-! Converts 'string' to uppercase
-character(len=*), intent(INOUT) :: string
integer :: ismalla, ibiga, i
ismalla = ichar('a')
@@ -1592,8 +1253,7 @@ subroutine to_upper( string )
end subroutine to_upper
-!#######################################################################
-
+!-----------------------------------------------------------------------
!> copy instring to outstring, omitting all internal blanks
!> outstring must be at least as long as instring
@@ -1614,16 +1274,15 @@ subroutine squeeze_out_blanks(instring, outstring)
end subroutine squeeze_out_blanks
-
-!#######################################################################
-
+!-----------------------------------------------------------------------
+!> Determines the number of lines and maximum line length
+!> of an ascii file.
subroutine find_textfile_dims( fname, nlines, linelen )
-! Determines the number of lines and maximum line length
-! of the file. Sometimes you need to know this stuff.
-character(len=*), intent(IN) :: fname
-integer, intent(OUT) :: nlines
-integer, optional, intent(OUT) :: linelen
+
+character(len=*), intent(in) :: fname
+integer, intent(out) :: nlines
+integer, optional, intent(out) :: linelen
integer :: i, maxlen, mylen, ios, funit
@@ -1666,20 +1325,18 @@ subroutine find_textfile_dims( fname, nlines, linelen )
end subroutine find_textfile_dims
-!#######################################################################
-
+!-----------------------------------------------------------------------
+!> Reads a text file into a character variable.
+!> Initially needed to read a namelist file into a variable that could
+!> then be inserted into a netCDF file. Due to a quirk in the way Fortran
+!> and netCDF play together, I have not figured out how to dynamically
+!> create the minimal character length ... so any line longer than
+!> the declared length of the textblock variable is truncated.
subroutine file_to_text( fname, textblock )
-!
-! Reads a text file into a character variable.
-! Initially needed to read a namelist file into a variable that could
-! then be inserted into a netCDF file. Due to a quirk in the way Fortran
-! and netCDF play together, I have not figured out how to dynamically
-! create the minimal character length ... so any line longer than
-! the declared length of the textblock variable is truncated.
-character(len=*), intent(IN) :: fname
-character(len=*), dimension(:), intent(OUT) :: textblock
+character(len=*), intent(in) :: fname
+character(len=*), dimension(:), intent(out) :: textblock
integer :: i, ios, funit
integer :: mynlines, mylinelen, strlen
@@ -1702,7 +1359,7 @@ subroutine file_to_text( fname, textblock )
strlen = min(mylinelen, strlen)
-PARSELOOP : do i = 1,mynlines
+do i = 1,mynlines
read(funit, '(A)', iostat=ios) string
@@ -1714,32 +1371,29 @@ subroutine file_to_text( fname, textblock )
source, revision, revdate)
endif
-enddo PARSELOOP
+enddo
call close_file(funit)
end subroutine file_to_text
-
-!#######################################################################
-
+!-----------------------------------------------------------------------
+!> Arguments are the name of a file which contains a list of filenames.
+!> This routine opens the listfile, and returns the lineindex-th one.
+!> We agreed to support filenames/pathnames up to 256.
function get_next_filename( listname, lineindex )
-! Arguments are the name of a file which contains a list of filenames.
-! This routine opens the listfile, and returns the index-th one.
-!
character(len=*), intent(in) :: listname
integer, intent(in) :: lineindex
character(len=256) :: get_next_filename
integer :: i, ios, funit
+character(len=512) :: string
-character(len=512) :: string
-
-funit = open_file(listname, form="FORMATTED", action="READ")
+funit = open_file(listname, form="FORMATTED", action="READ")
-PARSELOOP : do i=1, lineindex
+do i=1, lineindex
read(funit, '(A)', iostat=ios) string
@@ -1750,23 +1404,26 @@ function get_next_filename( listname, lineindex )
return
endif
-enddo PARSELOOP
+enddo
+
+call close_file(funit)
+
-! check for length problems
-if (len_trim(string) > len(get_next_filename)) then
+! check for length problems after stripping off any leading blanks.
+! @todo FIXME define 256 as a constant - MAXFILENAMELEN or something
+if (len_trim(adjustl(string)) > 256) then
call error_handler(E_ERR, 'get_next_filename', &
'maximum filename length of 256 exceeded', &
source, revision, revdate)
endif
-get_next_filename = adjustl(string(1:len(get_next_filename)))
-call close_file(funit)
-end function get_next_filename
+get_next_filename = adjustl(string)
+end function get_next_filename
-!#######################################################################
+!-----------------------------------------------------------------------
!> this function is intended to be used when there are 2 ways to specify
!> an unknown number of input files, most likely in a namelist.
!>
@@ -1858,7 +1515,7 @@ function set_filename_list(name_array, listname, caller_name)
write(msgstring2,*)'reading file # ',fileindex
write(msgstring3,*)'reading file name "'//trim(name_array(fileindex))//'"'
call error_handler(E_ERR, caller_name, 'found no '//trim(fsource), &
- source,revision,revdate,text2=msgstring2,text3=msgstring3)
+ source,revision,revdate,text2=msgstring2,text3=msgstring3)
endif
! at the end of the list. return how many filenames were found,
@@ -1886,8 +1543,7 @@ function set_filename_list(name_array, listname, caller_name)
end function set_filename_list
-!#######################################################################
-
+!-----------------------------------------------------------------------
!> this function is intended to be used when there are 2 ways to specify
!> a KNOWN number of input files, most likely in a namelist.
!>
@@ -1989,7 +1645,7 @@ subroutine set_multiple_filename_lists(name_array, listname, nlists, nentries, &
if (max_num_input_files < nlists * nentries) then
write(msgstring1, *) 'list length = ', max_num_input_files, ' needs room for ', nlists * nentries
call error_handler(E_ERR, caller_name, 'internal error: name_array not long enough to hold lists', &
- source,revision,revdate, text2=msgstring1)
+ source,revision,revdate, text2=msgstring1)
endif
! loop over the inputs. if the names were already specified in the
@@ -2015,7 +1671,7 @@ subroutine set_multiple_filename_lists(name_array, listname, nlists, nentries, &
endif
call error_handler(E_ERR, caller_name, trim(msgstring1)//trim(fsource), &
- source,revision,revdate,text2=msgstring2,text3=msgstring3)
+ source,revision,revdate,text2=msgstring2,text3=msgstring3)
endif
enddo
@@ -2023,114 +1679,34 @@ subroutine set_multiple_filename_lists(name_array, listname, nlists, nentries, &
end subroutine set_multiple_filename_lists
-!#######################################################################
-
+!-----------------------------------------------------------------------
-function is_longitude_between (lon, minlon, maxlon, doradians, newlon)
+function next_file(fname,ifile)
-! uniform way to treat longitude ranges, in degrees, on a globe.
-! returns true if lon is between min and max, starting at min
-! and going EAST until reaching max. wraps across 0 longitude.
-! if min == max, all points are inside. includes edges.
-! if optional arg doradians is true, do computation in radians
-! between 0 and 2*PI instead of 360. if given, return the
-! 'lon' value possibly + 360 (or 2PI) which can be used for averaging
-! or computing on a consistent set of longitude values. after the
-! computation is done if the answer is > 360 (or 2PI), subtract that
-! value to get back into the 0 to 360 (or 2PI) range.
+! FIXME: THIS FUNCTION IS DEPRECATED AND SHOULD BE REMOVED.
+! FIXME: THIS FUNCTION IS DEPRECATED AND SHOULD BE REMOVED.
+! FIXME: THIS FUNCTION IS DEPRECATED AND SHOULD BE REMOVED.
+! (only used by obs_seq_to_netcdf currently.)
-real(r8), intent(in) :: lon, minlon, maxlon
-logical, intent(in), optional :: doradians
-real(r8), intent(out), optional :: newlon
-logical :: is_longitude_between
+!----------------------------------------------------------------------
+! The file name can take one of three forms:
+! /absolute/path/to/nirvana/obs_001/obs_seq.final (absolute path)
+! obs_0001/obs_seq.final (relative path)
+! obs_seq.final (no path ... local)
+!
+! If there is a '/' in the file name, we grab the portion before the
+! slash and look for an underscore. Anything following the underscore
+! is presumed to be the portion to increment.
+!
+! If there is no slash AND ifile is > 1 ... we have already read
+! the 'one and only' obs_seq.final file and we return 'done'.
+!----------------------------------------------------------------------
-real(r8) :: minl, maxl, lon2, circumf
+character(len=*), intent(in) :: fname
+integer, intent(in) :: ifile
-circumf = 360.0_r8
-if (present(doradians)) then
- if (doradians) circumf = TWOPI
-endif
-
-! ensure the valid region boundaries are between 0 and one circumference
-! (must use modulo() and not mod() so negative vals are handled ok)
-minl = modulo(minlon, circumf)
-maxl = modulo(maxlon, circumf)
-
-! boundary points are included in the valid region so if min=max
-! the 'region' is the entire globe and you can return early.
-if (minl == maxl) then
- is_longitude_between = .true.
- if (present(newlon)) newlon = lon
- return
-endif
-
-! ensure the test point is between 0 and one circumference
-lon2 = modulo(lon, circumf)
-
-! here's where the magic happens:
-! minl will be bigger than maxl if the region of interest crosses the prime
-! meridian (longitude = 0). in this case add one circumference to the
-! eastern boundary so maxl is guarenteed to be larger than minl (and valid
-! values are now between 0 and 2 circumferences).
-!
-! if the test point longitude is west of the minl boundary add one circumference
-! to it as well before testing against the bounds. values that were east of
-! longitude 0 but west of maxl will now be shifted so they are again correctly
-! within the new range; values that were west of the prime meridian but east
-! of minl will stay in range; values west of minl and east of maxl will be
-! correctly shifted out of range.
-
-if (minl > maxl) then
- maxl = maxl + circumf
- if (lon2 < minl) lon2 = lon2 + circumf
-endif
-
-is_longitude_between = ((lon2 >= minl) .and. (lon2 <= maxl))
-
-! if requested, return the value that was tested against the bounds, which
-! will always be between 0 and 2 circumferences and monotonically increasing
-! from minl to maxl. if the region of interest doesn't cross longitude 0
-! this value will be the same as the input value. if the region does
-! cross longitude 0 this value will be between 0 and 2 circumferences.
-! it's appropriate for averaging values together or comparing them against
-! other values returned from this routine with a simple greater than or less
-! than without further computation for longitude 0. to convert the values
-! back into the range from 0 to one circumference, compare it to the
-! circumference and if larger, subtract one circumference from the value.
-
-if (present(newlon)) newlon = lon2
-
-end function is_longitude_between
-
-
-!#######################################################################
-
-
-function next_file(fname,ifile)
-
-! FIXME: THIS FUNCTION IS DEPRECATED AND SHOULD BE REMOVED.
-! FIXME: THIS FUNCTION IS DEPRECATED AND SHOULD BE REMOVED.
-! FIXME: THIS FUNCTION IS DEPRECATED AND SHOULD BE REMOVED.
-
-!----------------------------------------------------------------------
-! The file name can take one of three forms:
-! /absolute/path/to/nirvana/obs_001/obs_seq.final (absolute path)
-! obs_0001/obs_seq.final (relative path)
-! obs_seq.final (no path ... local)
-!
-! If there is a '/' in the file name, we grab the portion before the
-! slash and look for an underscore. Anything following the underscore
-! is presumed to be the portion to increment.
-!
-! If there is no slash AND ifile is > 1 ... we have already read
-! the 'one and only' obs_seq.final file and we return 'done'.
-!----------------------------------------------------------------------
-
-character(len=*), intent(in) :: fname
-integer, intent(in) :: ifile
-
-character(len=len(fname)) :: next_file
-character(len=len(fname)) :: dir_name
+character(len=len(fname)) :: next_file
+character(len=len(fname)) :: dir_name
integer, SAVE :: filenum = 0
integer, SAVE :: dir_prec = 0
@@ -2237,40 +1813,93 @@ function next_file(fname,ifile)
end function next_file
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! generic routines needed by more than one part of the code
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
-!#######################################################################
+!-----------------------------------------------------------------------
+!> uniform way to treat longitude ranges, in degrees, on a globe.
+!> returns true if lon is between min and max, starting at min
+!> and going EAST until reaching max. wraps across 0 longitude.
+!> if min == max, all points are inside. includes edges.
+!> if optional arg doradians is true, do computation in radians
+!> between 0 and 2*PI instead of 360. if given, return the
+!> 'lon' value possibly + 360 (or 2PI) which can be used for averaging
+!> or computing on a consistent set of longitude values. after the
+!> computation is done if the answer is > 360 (or 2PI), subtract that
+!> value to get back into the 0 to 360 (or 2PI) range.
-function ascii_file_format(fform)
+function is_longitude_between (lon, minlon, maxlon, doradians, newlon)
-!----------------------------------------------------------------------
-! Common routine for setting read/write file format.
+real(r8), intent(in) :: lon, minlon, maxlon
+logical, intent(in), optional :: doradians
+real(r8), intent(out), optional :: newlon
+logical :: is_longitude_between
-character(len=*), intent(in), optional :: fform
-logical :: ascii_file_format
+real(r8) :: minl, maxl, lon2, circumf
-! Returns .true. for formatted/ascii file, .false. is unformatted/binary
-! Defaults (if fform not specified) to formatted/ascii.
+circumf = 360.0_r8
+if (present(doradians)) then
+ if (doradians) circumf = TWOPI
+endif
-if ( .not. module_initialized ) call initialize_utilities
+! ensure the valid region boundaries are between 0 and one circumference
+! (must use modulo() and not mod() so negative vals are handled ok)
+minl = modulo(minlon, circumf)
+maxl = modulo(maxlon, circumf)
-! Default to formatted/ascii.
-if ( .not. present(fform)) then
- ascii_file_format = .true.
+! boundary points are included in the valid region so if min=max
+! the 'region' is the entire globe and you can return early.
+if (minl == maxl) then
+ is_longitude_between = .true.
+ if (present(newlon)) newlon = lon
return
endif
-SELECT CASE (fform)
- CASE("unf", "UNF", "unformatted", "UNFORMATTED")
- ascii_file_format = .false.
- CASE DEFAULT
- ascii_file_format = .true.
-END SELECT
+! ensure the test point is between 0 and one circumference
+lon2 = modulo(lon, circumf)
-end function ascii_file_format
+! here's where the magic happens:
+! minl will be bigger than maxl if the region of interest crosses the prime
+! meridian (longitude = 0). in this case add one circumference to the
+! eastern boundary so maxl is guarenteed to be larger than minl (and valid
+! values are now between 0 and 2 circumferences).
+!
+! if the test point longitude is west of the minl boundary add one circumference
+! to it as well before testing against the bounds. values that were east of
+! longitude 0 but west of maxl will now be shifted so they are again correctly
+! within the new range; values that were west of the prime meridian but east
+! of minl will stay in range; values west of minl and east of maxl will be
+! correctly shifted out of range.
+
+if (minl > maxl) then
+ maxl = maxl + circumf
+ if (lon2 < minl) lon2 = lon2 + circumf
+endif
+
+is_longitude_between = ((lon2 >= minl) .and. (lon2 <= maxl))
+
+! if requested, return the value that was tested against the bounds, which
+! will always be between 0 and 2 circumferences and monotonically increasing
+! from minl to maxl. if the region of interest doesn't cross longitude 0
+! this value will be the same as the input value. if the region does
+! cross longitude 0 this value will be between 0 and 2 circumferences.
+! it's appropriate for averaging values together or comparing them against
+! other values returned from this routine with a simple greater than or less
+! than without further computation for longitude 0. to convert the values
+! back into the range from 0 to one circumference, compare it to the
+! circumference and if larger, subtract one circumference from the value.
+if (present(newlon)) newlon = lon2
+
+end function is_longitude_between
-!#######################################################################
+
+!-----------------------------------------------------------------------
+!>
pure function to_scalar_real(x)
real(r8), intent(in) :: x(1)
@@ -2280,17 +1909,19 @@ pure function to_scalar_real(x)
end function to_scalar_real
-!#######################################################################
+!-----------------------------------------------------------------------
+!>
-pure function to_scalar_int(x)
- integer, intent(in) :: x(1)
- integer :: to_scalar_int
+pure function to_scalar_int4(x)
+ integer(i4), intent(in) :: x(1)
+ integer(i4) :: to_scalar_int4
-to_scalar_int = x(1)
+to_scalar_int4 = x(1)
-end function to_scalar_int
+end function to_scalar_int4
-!#######################################################################
+!-----------------------------------------------------------------------
+!>
pure function to_scalar_int8(x)
integer(i8), intent(in) :: x(1)
@@ -2378,6 +2009,758 @@ function string_to_logical(inputstring, string_to_match)
end function string_to_logical
+!-----------------------------------------------------------------------
+!> dump the contents of a 1d array with a max of N items per line.
+!> optional arguments allow the caller to restrict the output to
+!> no more than X items, to write to an open file unit, and to
+!> write a text label before the numerical dump.
+!>
+
+subroutine array_1d_dump(array, nper_line, max_items, funit, label)
+real(r8), intent(in) :: array(:)
+integer, intent(in), optional :: nper_line
+integer, intent(in), optional :: max_items
+integer, intent(in), optional :: funit
+character(len=*), intent(in), optional :: label
+
+integer :: i, per_line, ounit, asize_i
+logical :: has_label
+
+! set defaults and override if arguments are present
+
+per_line = 4
+if (present(nper_line)) per_line = nper_line
+
+asize_i = size(array)
+if (present(max_items)) asize_i = min(asize_i, max_items)
+
+ounit = 0
+if (present(funit)) ounit = funit
+
+has_label = .false.
+if (present(label)) has_label = .true.
+
+! output section
+
+if (has_label) write(ounit, *) trim(label)
+
+do i=1, asize_i, per_line
+ write(ounit, *) i, ' : ', array(i:min(asize_i,i+per_line-1))
+enddo
+
+end subroutine array_1d_dump
+
+!-----------------------------------------------------------------------
+!> dump the contents of a 2d array with a max of N items per line.
+!> optional arguments allow the caller to restrict the output to
+!> no more than X items, to write to an open file unit, and to
+!> write a text label before the numerical dump.
+!>
+
+subroutine array_2d_dump(array, nper_line, max_i_items, max_j_items, funit, label)
+real(r8), intent(in) :: array(:,:)
+integer, intent(in), optional :: nper_line
+integer, intent(in), optional :: max_i_items
+integer, intent(in), optional :: max_j_items
+integer, intent(in), optional :: funit
+character(len=*), intent(in), optional :: label
+
+integer :: i, j, per_line, ounit, asize_i, asize_j
+logical :: has_label
+
+! set defaults and override if arguments are present
+
+per_line = 4
+if (present(nper_line)) per_line = nper_line
+
+asize_i = size(array, 1)
+asize_j = size(array, 2)
+if (present(max_i_items)) asize_i = min(asize_i, max_i_items)
+if (present(max_j_items)) asize_j = min(asize_j, max_j_items)
+
+ounit = 0
+if (present(funit)) ounit = funit
+
+has_label = .false.
+if (present(label)) has_label = .true.
+
+! output section
+
+if (has_label) write(ounit, *) trim(label)
+
+do j=1, asize_j
+ do i=1, asize_i, per_line
+ write(ounit, *) i, j, ' : ', array(i:min(asize_i,i+per_line-1), j)
+ enddo
+enddo
+
+end subroutine array_2d_dump
+
+!-----------------------------------------------------------------------
+!> dump the contents of a 3d array with a max of N items per line.
+!> optional arguments allow the caller to restrict the output to
+!> no more than X items, to write to an open file unit, and to
+!> write a text label before the numerical dump.
+!>
+
+subroutine array_3d_dump(array, nper_line, max_i_items, max_j_items, max_k_items, funit, label)
+real(r8), intent(in) :: array(:,:,:)
+integer, intent(in), optional :: nper_line
+integer, intent(in), optional :: max_i_items
+integer, intent(in), optional :: max_j_items
+integer, intent(in), optional :: max_k_items
+integer, intent(in), optional :: funit
+character(len=*), intent(in), optional :: label
+
+integer :: i, j, k, per_line, ounit, asize_i, asize_j, asize_k
+logical :: has_label
+
+! set defaults and override if arguments are present
+
+per_line = 4
+if (present(nper_line)) per_line = nper_line
+
+asize_i = size(array, 1)
+asize_j = size(array, 2)
+asize_k = size(array, 3)
+if (present(max_i_items)) asize_i = min(asize_i, max_i_items)
+if (present(max_j_items)) asize_j = min(asize_j, max_j_items)
+if (present(max_k_items)) asize_k = min(asize_k, max_k_items)
+
+ounit = 0
+if (present(funit)) ounit = funit
+
+has_label = .false.
+if (present(label)) has_label = .true.
+
+! output section
+
+if (has_label) write(ounit, *) trim(label)
+
+do k=1, asize_k
+ do j=1, asize_j
+ do i=1, asize_i, per_line
+ write(ounit, *) i, j, k, ' : ', array(i:min(asize_i,i+per_line-1), j, k)
+ enddo
+ enddo
+enddo
+
+end subroutine array_3d_dump
+
+!-----------------------------------------------------------------------
+!> dump the contents of a 4d array with a max of N items per line.
+!> optional arguments allow the caller to restrict the output to
+!> no more than X items, to write to an open file unit, and to
+!> write a text label before the numerical dump.
+!>
+
+subroutine array_4d_dump(array, nper_line, max_i_items, max_j_items, max_k_items, max_l_items, funit, label)
+real(r8), intent(in) :: array(:,:,:,:)
+integer, intent(in), optional :: nper_line
+integer, intent(in), optional :: max_i_items
+integer, intent(in), optional :: max_j_items
+integer, intent(in), optional :: max_k_items
+integer, intent(in), optional :: max_l_items
+integer, intent(in), optional :: funit
+character(len=*), intent(in), optional :: label
+
+integer :: i, j, k, l, per_line, ounit, asize_i, asize_j, asize_k, asize_l
+logical :: has_label
+
+! set defaults and override if arguments are present
+
+per_line = 4
+if (present(nper_line)) per_line = nper_line
+
+asize_i = size(array, 1)
+asize_j = size(array, 2)
+asize_k = size(array, 3)
+asize_l = size(array, 4)
+if (present(max_i_items)) asize_i = min(asize_i, max_i_items)
+if (present(max_j_items)) asize_j = min(asize_j, max_j_items)
+if (present(max_k_items)) asize_k = min(asize_k, max_k_items)
+if (present(max_l_items)) asize_l = min(asize_l, max_l_items)
+
+ounit = 0
+if (present(funit)) ounit = funit
+
+has_label = .false.
+if (present(label)) has_label = .true.
+
+! output section
+
+if (has_label) write(ounit, *) trim(label)
+
+do l=1, asize_l
+ do k=1, asize_k
+ do j=1, asize_j
+ do i=1, asize_i, per_line
+ write(ounit, *) i, j, k, l, ' : ', array(i:min(asize_i,i+per_line-1), j, k, l)
+ enddo
+ enddo
+ enddo
+enddo
+
+end subroutine array_4d_dump
+
+!-----------------------------------------------------------------------
+!> given an array of sorted values and a value to find, return the
+!> two indices that enclose that value, and the fraction between.
+!>
+!> fraction_across = 0.0 is the 100% the smaller index value,
+!> 1.0 is the 100% the larger index value.
+!>
+!> if the array values are inverted (e.g. index 1 is the largest value),
+!> set inverted = .true. the interpretation in the calling code for
+!> smaller index, larger index and fraction_across remain the same as the default case.
+!>
+!> if the fraction_across the enclosing level should be computed using a
+!> log scale, set log_scale = .true.
+!>
+!> if indirect_indices specified, use as indirect indices into data_array,
+!> with these indices giving the sorted order. the order of the values
+!> cannot be inverted! use either indirect addressing or inverted but
+!> not both.
+!>
+!> my_status values:
+!> 0 = good return
+!> -1 = value_to_find is below smallest value
+!> 1 = value_to_find is above largest value
+!>
+!> 95 = cannot combine inverted and indirect indices
+!> 96 = cannot use log scale with negative data values
+!> 97 = array only has a single value
+!> 98 = interval has 0 width or values are inverted
+!> 99 = unknown error
+!>
+!> bad output values use MISSING_I and MISSING_R8
+!>
+!> usage example:
+!> you have an array of model level heights called my_heights() and you
+!> have an array of data values at those model levels called data_on_heights.
+!> you want to interpolate the data at a height of 'this_height'.
+!>
+!> call find_enclosing_indices(size(my_heights), my_heights, this_height, low_i, high_i, fract, istat)
+!> if (istat /= 0) return
+!> value = data_on_heights(low_i) * (1.0 - fract) + &
+!> data_on_heights(high_i) * fract
+!>
+!> FIXME:
+!> added to the utilities module, but this module should be split into
+!> smaller modules because right now it's a dumping ground for every
+!> random routine that is useful to more than one module. (my fault
+!> as much as anyones - nsc)
+
+subroutine find_enclosing_indices(nitems, data_array, value_to_find, &
+ smaller_index, larger_index, fraction_across, my_status, &
+ inverted, log_scale, indirect_indices)
+
+integer, intent(in) :: nitems
+real(r8), intent(in) :: data_array(nitems)
+real(r8), intent(in) :: value_to_find
+integer, intent(out) :: smaller_index
+integer, intent(out) :: larger_index
+real(r8), intent(out) :: fraction_across
+integer, intent(out) :: my_status
+logical, intent(in), optional :: inverted
+logical, intent(in), optional :: log_scale
+integer, intent(in), optional :: indirect_indices(nitems)
+
+integer :: i, j, k
+integer :: lowest_i, highest_i
+real(r8) :: smaller_data, larger_data, this_data
+logical :: one_is_smallest, linear_interp, direct ! the normal defaults are true
+
+! set defaults and initialize intent(out) items
+! so we can return immediately on error.
+
+one_is_smallest = .true.
+if (present(inverted)) one_is_smallest = .not. inverted
+
+linear_interp = .true.
+if (present(log_scale)) linear_interp = .not. log_scale
+
+direct = .true.
+if (present(indirect_indices)) direct = .false.
+
+smaller_index = MISSING_I
+larger_index = MISSING_I
+fraction_across = MISSING_R8
+my_status = -99
+
+
+! exclude malformed call cases
+if (nitems <= 1) then
+ my_status = 97
+ return
+endif
+if (.not. direct .and. .not. one_is_smallest) then
+ my_status = 95
+ return
+endif
+
+! set these indices so we can simplify the tests below
+if (.not. direct) then
+ lowest_i = indirect_indices(1)
+ highest_i = indirect_indices(nitems)
+else if (one_is_smallest) then
+ lowest_i = 1
+ highest_i = nitems
+else
+ lowest_i = nitems
+ highest_i = 1
+endif
+
+! get limits so we can easily discard out of range values
+smaller_data = data_array(lowest_i)
+larger_data = data_array(highest_i)
+
+if (value_to_find < smaller_data) then
+ my_status = -1
+ return
+endif
+
+if (value_to_find > larger_data) then
+ my_status = 1
+ return
+endif
+
+! bisection search:
+! because input must be in sorted order take the middle
+! index each time and shift the lower or upper index
+! to match it, depending on which half the value falls in.
+
+i = 1
+j = nitems
+
+do
+ k=(i+j)/2
+
+ if (direct) then
+ this_data = data_array(k)
+ else
+ this_data = data_array(indirect_indices(k))
+ endif
+
+ if ((value_to_find < this_data .and. one_is_smallest) .or. &
+ (value_to_find > this_data .and. .not. one_is_smallest)) then
+ j=k
+ else
+ i=k
+ endif
+
+ if (i+1 >= j) exit
+enddo
+
+! return index values. if indirect, return indices
+! directly into the data array so caller doesn't have
+! do redo the indirection.
+if (.not. direct) then
+ smaller_index = indirect_indices(i)
+ larger_index = indirect_indices(i+1)
+else if (one_is_smallest) then
+ smaller_index = i
+ larger_index = i+1
+else
+ smaller_index = i+1
+ larger_index = i
+endif
+
+! use the indices to look up the corresponding data values
+! to compute the fraction across.
+smaller_data = data_array(smaller_index)
+larger_data = data_array(larger_index)
+
+! avoid cases that would divide by 0 below.
+!> if smaller > larger then the input data isn't monotonic.
+!> return valid index values but bad status and fraction.
+!> if smaller == larger, return fraction of 0
+
+if (smaller_data > larger_data) then
+ my_status = 98
+ return
+endif
+if (smaller_data == larger_data) then
+ fraction_across = 0.0_r8
+ my_status = 0
+ return
+endif
+
+! no log computations if any data values are negative
+if (.not. linear_interp .and. smaller_data <= 0.0) then
+ my_status = 96
+ return
+endif
+
+! compute fraction here. 0.0 = smaller value, 1.0 = larger value
+if (linear_interp) then
+ fraction_across = (value_to_find - smaller_data) / &
+ (larger_data - smaller_data)
+else
+ fraction_across = (log(value_to_find) - log(smaller_data)) / &
+ (log(larger_data) - log(smaller_data))
+
+endif
+
+! good return
+my_status = 0
+
+end subroutine find_enclosing_indices
+
+!-----------------------------------------------------------------------
+!> given an array of sorted values and a value to find, return the
+!> first index value that is less than or equal to the target.
+!>
+!> if the array values are inverted (e.g. index 1 is the largest value),
+!> set inverted = .true.
+!>
+!> if indirect_indices specified, use as indirect indices into data_array,
+!> with these indices giving the sorted order. return index will be the
+!> direct index into the data_array. to also return the index into the
+!> indirect array, specify the_indirect_index in the arg list.
+!>
+!> note that you cannot specify both inverted and indirect.
+!>
+!> my_status values:
+!> 0 = good return
+!> -1 = value_to_find is below the smallest value
+!> 1 = value_to_find is above largest value
+!>
+!> 94 = invalid indirect index values
+!> 95 = cannot specify the_indirect_index and not indirect_indices(:)
+!> 96 = cannot specify both indirect and inverted
+!> 97 = empty input data array
+!> 98 = interval values are inverted
+!> 99 = unknown error
+!>
+!> bad output values use MISSING_I and MISSING_R8
+!>
+!> usage example:
+!> you have a long array of unsorted numbers and you want to find the index of
+!> a given value.
+!>
+!> ! do this only once
+!> call index_sort(unsorted_array, index_array, sizeof(unsorted_array))
+!>
+!> call find_first_occurrence(sizeof(unsorted_array), unsorted_array, value_to_find, &
+!> this_index, istat, indirect_indices = index_array)
+!> if (istat /= 0) return
+!> if (value_to_find == unsorted_array(this_index)) then
+!> print *, 'found ', value_to_find, ' in array at index ', this_index
+!> else
+!> print *, 'did not find exact match in array'
+!> print *, 'largest value still less than ', value_to_find, ' in array at index ', this_index
+!> print *, 'is value ', unsorted_array(this_index)
+!> endif
+!>
+
+!>@todo FIXME - do we need an integer version of this? (i think yes)
+!> possibly also a character version for arrays of strings.
+!> C++ overloading would be nice sometimes.
+
+subroutine find_first_occurrence(nitems, data_array, value_to_find, &
+ the_index, my_status, &
+ inverted, indirect_indices, the_indirect_index)
+
+integer, intent(in) :: nitems
+real(r8), intent(in) :: data_array(nitems)
+real(r8), intent(in) :: value_to_find
+integer, intent(out) :: the_index
+integer, intent(out) :: my_status
+logical, intent(in), optional :: inverted
+integer, intent(in), optional :: indirect_indices(nitems)
+integer, intent(out), optional :: the_indirect_index
+
+integer :: i, j, k
+integer :: lowest_i, highest_i
+logical :: one_is_smallest, direct ! the normal defaults are true
+real(r8) :: smallest_data, largest_data, this_data
+
+! set defaults and initialize intent(out) items
+! so we can return immediately on error.
+
+one_is_smallest = .true.
+if (present(inverted)) one_is_smallest = .not. inverted
+
+direct = .true.
+if (present(indirect_indices)) direct = .false.
+
+the_index = MISSING_I
+if (present(the_indirect_index)) the_indirect_index = MISSING_I
+my_status = -99
+
+
+! exclude malformed call cases
+if (nitems < 1) then
+ my_status = 97
+ return
+endif
+
+if (.not. direct .and. .not. one_is_smallest) then
+ my_status = 96
+ return
+endif
+
+if (present(the_indirect_index) .and. .not. present(indirect_indices)) then
+ my_status = 95
+ return
+endif
+
+!> if the input is a single value, test it and
+!> return if the value to find is too small or too large.
+!> also check for bad indirect index values.
+if (nitems == 1) then
+ if (.not. direct) then
+ if (indirect_indices(1) /= 1) then
+ my_status = 94
+ return
+ endif
+ endif
+
+ this_data = data_array(1)
+ if (value_to_find < this_data) then
+ my_status = -1
+ return
+ endif
+ if (value_to_find > this_data) then
+ my_status = 1
+ return
+ endif
+
+ the_index = 1
+ if (present(the_indirect_index)) the_indirect_index = 1
+ my_status = 0
+ return
+endif
+
+! set these indices so we can simplify the tests below
+if (.not. direct) then
+ lowest_i = indirect_indices(1)
+ highest_i = indirect_indices(nitems)
+else if (one_is_smallest) then
+ lowest_i = 1
+ highest_i = nitems
+else
+ lowest_i = nitems
+ highest_i = 1
+endif
+
+! get limits so we can easily discard out of range values
+smallest_data = data_array(lowest_i)
+largest_data = data_array(highest_i)
+
+! discard small and large values here
+if (value_to_find < smallest_data) then
+ my_status = -1
+ return
+endif
+if (value_to_find > largest_data) then
+ my_status = 1
+ return
+endif
+
+! if equal to the largest value, return here.
+if (value_to_find == largest_data) then
+ the_index = highest_i
+ if (present(the_indirect_index)) the_indirect_index = nitems
+ my_status = 0
+ return
+endif
+
+! bisection search:
+! because input must be in sorted order take the middle
+! index each time and shift the lower or upper index
+! to match it, depending on which half the value falls in.
+
+i = 1
+j = nitems
+
+do
+ k=(i+j)/2
+
+ if (direct) then
+ this_data = data_array(k)
+ else
+ this_data = data_array(indirect_indices(k))
+ endif
+
+ if ((value_to_find < this_data .and. one_is_smallest) .or. &
+ (value_to_find >= this_data .and. .not. one_is_smallest)) then
+ j=k
+ else
+ i=k
+ endif
+
+ if (i+1 >= j) exit
+enddo
+
+! always return the index directly into the incoming data array.
+! if requested and there are indirect indices also return the indirect
+! array index number. the former makes it easy to access the data directly.
+! the latter makes it possible to move forward and back in numeric order.
+if (.not. direct) then
+ the_index = indirect_indices(i)
+ if (present(the_indirect_index)) the_indirect_index = i
+else if (one_is_smallest) then
+ the_index = i
+else
+ the_index = j
+endif
+
+! good return
+my_status = 0
+
+end subroutine find_first_occurrence
+
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! debug code section
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!> print out the kind numbers for various variable kinds
+
+subroutine dump_varkinds()
+
+integer :: bob
+
+call log_it('') ! a little whitespace is nice
+
+write(msgstring1,*)'.. digits12 is ',digits12
+write(msgstring2,*)'r8 is ',r8
+write(msgstring3,*)'r4 is ',r4
+call error_handler(E_DBG, 'initialize_utilities', msgstring1, &
+ source, revision, revdate, text2=msgstring2, text3=msgstring3)
+
+write(msgstring1,*)'.. integer is ',kind(bob) ! any integer variable will do
+write(msgstring2,*)'i8 is ',i8
+write(msgstring3,*)'i4 is ',i4
+call error_handler(E_DBG, 'initialize_utilities', msgstring1, &
+ source, revision, revdate, text2=msgstring2, text3=msgstring3)
+
+end subroutine dump_varkinds
+
+!-----------------------------------------------------------------------
+!> Useful for dumping all the attributes for a file 'unit'
+!> A debugging routine, really. TJH Oct 2004
+
+subroutine dump_unit_attributes(iunit)
+
+integer, intent(in) :: iunit
+
+logical :: exists, open, named_file
+integer :: ios, reclen, nextrecnum
+character(len=256) :: file_name
+character(len=32) :: ynu ! YES, NO, UNDEFINED ... among others
+
+if ( .not. module_initialized ) call initialize_utilities
+
+call output_unit_attribs(ios, 'for unit', '', ivalue=iunit)
+
+inquire(iunit, opened = open, iostat=ios)
+call output_unit_attribs(ios, 'opened', '', lvalue=open)
+
+inquire(iunit, named = named_file, iostat=ios)
+call output_unit_attribs(ios, 'named file', '', lvalue=named_file)
+
+if (named_file) then
+ inquire(iunit, name = file_name, iostat=ios)
+ call output_unit_attribs(ios, 'file name is', file_name)
+endif
+
+inquire(iunit, exist = exists, iostat=ios)
+call output_unit_attribs(ios, 'file exists', '', lvalue=exists)
+
+inquire(iunit, recl = reclen, iostat=ios)
+call output_unit_attribs(ios, 'record length', '', ivalue=reclen)
+
+inquire(iunit, nextrec = nextrecnum, iostat=ios)
+call output_unit_attribs(ios, 'next record', '', ivalue=nextrecnum)
+
+inquire(iunit, access = ynu, iostat=ios)
+call output_unit_attribs(ios, 'access type', ynu)
+
+inquire(iunit, sequential = ynu, iostat=ios)
+call output_unit_attribs(ios, 'sequential', ynu)
+
+inquire(iunit, direct = ynu, iostat=ios)
+call output_unit_attribs(ios, 'direct', ynu)
+
+inquire(iunit, form = ynu, iostat=ios)
+call output_unit_attribs(ios, 'file format', ynu)
+
+inquire(iunit, action = ynu, iostat=ios)
+call output_unit_attribs(ios, 'action', ynu)
+
+inquire(iunit, read = ynu, iostat=ios)
+call output_unit_attribs(ios, 'read', ynu)
+
+inquire(iunit, write = ynu, iostat=ios)
+call output_unit_attribs(ios, 'write', ynu)
+
+inquire(iunit, readwrite = ynu, iostat=ios)
+call output_unit_attribs(ios, 'readwrite', ynu)
+
+inquire(iunit, blank = ynu, iostat=ios)
+call output_unit_attribs(ios, 'blank', ynu)
+
+inquire(iunit, position = ynu, iostat=ios)
+call output_unit_attribs(ios, 'position', ynu)
+
+inquire(iunit, delim = ynu, iostat=ios)
+call output_unit_attribs(ios, 'delim', ynu)
+
+inquire(iunit, pad = ynu, iostat=ios)
+call output_unit_attribs(ios, 'pad', ynu)
+
+end subroutine dump_unit_attributes
+
+!-----------------------------------------------------------------------
+!> fairly specialized routine to output the results
+!> of a file inquire call from dump_unit_attributes
+
+
+subroutine output_unit_attribs(ios, label, cvalue, ivalue, lvalue)
+integer, intent(in) :: ios
+character(len=*), intent(in) :: label
+character(len=*), intent(in) :: cvalue
+integer, optional, intent(in) :: ivalue
+logical, optional, intent(in) :: lvalue
+
+character(len=128) :: string1
+
+! if the inquire failed, just return
+if (ios /= 0) return
+
+! format the output string based on the type of input
+
+if (present(lvalue)) then ! logical
+
+ if (lvalue) then
+ write(string1, *) trim(label) // " is true"
+ else
+ write(string1, *) trim(label) // " is false"
+ endif
+
+else if (present(ivalue)) then ! integer
+
+ write(string1, *) trim(label) // " is ", ivalue
+
+else ! character
+
+ write(string1, *) trim(label) // " = " // trim(cvalue)
+
+endif
+
+call error_handler(E_MSG, 'dump_unit_attributes', string1, &
+ source, revision, revdate)
+
+end subroutine output_unit_attribs
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
!=======================================================================
! End of utilities_mod
diff --git a/assimilation_code/programs/advance_time/advance_time.f90 b/assimilation_code/programs/advance_time/advance_time.f90
index 45fb38cd66..026a8bade4 100644
--- a/assimilation_code/programs/advance_time/advance_time.f90
+++ b/assimilation_code/programs/advance_time/advance_time.f90
@@ -4,17 +4,26 @@
!
! $Id$
-!> interface identical to WRF da_advance_cymdh, except for reading the arg line
-!> from standard input, to be more portable since iargc() is nonstandard across
-!> different fortran implementations.
-!
-!> i/o sections of file lightly modified from da_advance_cymdh
-!> time computations all call DART time manager
+!> @mainpage
+!> @{
+!> @brief Compute with time quantities
+!>
+!> The advance_time program computes the resulting time when either
+!> adding or subtracting time intervals. The increments can be
+!> expressed in days, hours, minutes or seconds. The output can be
+!> formatted as native WRF, CESM, Julian or Gregorian format.
+!>
+!> Reads input from standard input to be more portable, since older
+!> versions of iargc() weren't standardized.
+!>
+!> Based on the WRF da_advance_cymdh utility.
+!>
+!> All time computations call DART time manager.
!>
!> - has accuracy down to second,
!> - can use day/hour/minute/second (with/without +/- sign) to advance time,
!> - can digest various input date format if it still has the right order (ie. cc yy mm dd hh nn ss)
-!> - can digest flexible time increment
+!> - can digest flexible time increment
!> - can output in wrf date format (ccyy-mm-dd_hh:nn:ss)
!> - can specify output date format
!> - can output Julian day
@@ -59,14 +68,16 @@
!>
!> echo 2007073006 0 -c | advance_time
!>
-!> @todo if called with no arguments ... it just hangs. Can we make it fail straight away?
+!> @todo if run with no inputs ... it just hangs. Can we make it fail straight away?
+!> @}
program advance_time
use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
increment_time, decrement_time, get_time, &
set_date, get_date, julian_day
-use utilities_mod, only : initialize_utilities, E_ERR, error_handler
+use utilities_mod, only : initialize_utilities, E_ERR, error_handler, &
+ finalize_utilities
use parse_args_mod, only : get_args_from_string
implicit none
@@ -94,14 +105,14 @@ program advance_time
call set_calendar_type(GREGORIAN)
-! this routine reads a line from standard input and parses it up
+! this routine reads a line from standard input and parses it up
! into blank-separated words.
read(*, '(A)') in_string
call get_args_from_string(in_string, nargum, argum)
if ( nargum < 2 ) then
write(unit=stdout, fmt='(a)') &
- 'Usage: echo ccyymmddhh[nnss] [+|-]dt[d|h|m|s] [-w|-W|-wrf|-WRF] [-f|-F date_format] [-j|-J] [-g|-G] [-c|-C] | advance_time'
+ 'Usage: echo ccyymmddhh[nnss] [+|-]dt[d|h|m|s] [-w|-W|-wrf|-WRF] [-f|-F date_format] [-j|-J] [-g|-G] [-c|-C] | advance_time'
write(unit=stdout, fmt='(a)') &
'Option: -w|-W|-wrf|-WRF output in wrf date format as ccyy-mm-dd_hh:nn:ss'
write(unit=stdout, fmt='(a)') &
@@ -121,7 +132,7 @@ program advance_time
write(unit=stdout, fmt='(a)') &
' echo 2007-07-30_12:00:00 2d1s -w | advance_time # same as previous example'
write(unit=stdout, fmt='(a)') &
- ' echo 200707301200 2d1s -f ccyy-mm-dd_hh:nn:ss | advance_time # same as previous'
+ ' echo 200707301200 2d1s -f ccyy-mm-dd_hh:nn:ss | advance_time # same as previous'
write(unit=stdout, fmt='(a)') &
' echo 2007073006 120 -j | advance_time # advance 120 h, and print year and Julian day'
write(unit=stdout, fmt='(a)') &
@@ -133,7 +144,7 @@ program advance_time
write(unit=stdout, fmt='(a)') ''
call error_handler(E_ERR,'advance_time','Invalid Usage', source, revision, revdate)
-endif
+end if
ccyymmddhhnnss = parsedate(argum(1))
datelen = len_trim(ccyymmddhhnnss)
@@ -143,14 +154,14 @@ program advance_time
hh = 0
nn = 0
ss = 0
-elseif (datelen == 10) then
+else if (datelen == 10) then
read(ccyymmddhhnnss(1:10), fmt='(i4, 3i2)') ccyy, mm, dd, hh
nn = 0
ss = 0
-elseif (datelen == 12) then
+else if (datelen == 12) then
read(ccyymmddhhnnss(1:12), fmt='(i4, 4i2)') ccyy, mm, dd, hh, nn
ss = 0
-elseif (datelen == 14) then
+else if (datelen == 14) then
read(ccyymmddhhnnss(1:14), fmt='(i4, 5i2)') ccyy, mm, dd, hh, nn, ss
elseif (datelen == 13) then
read(ccyymmddhhnnss(1:13), fmt='(i4, 2i2, i5)') ccyy, mm, dd, ss
@@ -177,42 +188,44 @@ program advance_time
!print*, 'delta t: ', dday, dh, dn, ds
-! each part can be positive or negative, or 0.
+! each part can be positive or negative, or 0.
if (dday > 0) then
base_time = increment_time(base_time, 0, dday)
-elseif (dday < 0) then
+else if (dday < 0) then
base_time = decrement_time(base_time, 0, -dday)
endif
-
+
if (dh > 0) then
base_time = increment_time(base_time, dh*3600)
-elseif (dh < 0) then
+else if (dh < 0) then
base_time = decrement_time(base_time, -dh*3600)
endif
-
+
if (dn > 0) then
base_time = increment_time(base_time, dn*60)
-elseif (dn < 0) then
+else if (dn < 0) then
base_time = decrement_time(base_time, -dn*60)
endif
-
+
if (ds > 0) then
base_time = increment_time(base_time, ds)
-elseif (ds < 0) then
+else if (ds < 0) then
base_time = decrement_time(base_time, -ds)
endif
+
call get_date(base_time, ccyy, mm, dd, hh, nn, ss)
+
write(ccyymmddhhnnss(1:14), fmt='(i4, 5i2.2)') ccyy, mm, dd, hh, nn, ss
if ( nargum == 2 ) then
if (datelen == 13) datelen=10
- if (datelen<14) then
+ if (datelen < 14) then
if(nn /= 0) datelen=12
if(ss /= 0) datelen=14
endif
write(unit=stdout, fmt='(a)') ccyymmddhhnnss(1:datelen)
-elseif ( nargum > 2 ) then
+else if ( nargum > 2 ) then
i = 3
do while (i <= nargum)
select case ( trim(argum(i)) )
@@ -241,8 +254,10 @@ program advance_time
case default
i = i+1
end select
- enddo
-endif
+ end do
+end if
+
+call finalize_utilities()
contains
@@ -255,31 +270,30 @@ program advance_time
function parsedate(datein)
character(len=*), intent(in) :: datein
-character(len=14) :: parsedate
+character(len=14) :: parsedate
character(len=1 ) :: ch
integer :: n, i
parsedate = '00000000000000'
+
i=0
do n = 1, len_trim(datein)
ch = datein(n:n)
if (ch >= '0' .and. ch <= '9') then
i=i+1
parsedate(i:i)=ch
- endif
-enddo
+ end if
+end do
if (i == 13) then
parsedate(14:14) = ''
return ! CESM format
-elseif (parsedate(11:14) == '0000') then
+else if (parsedate(11:14) == '0000') then
parsedate(11:14) = ''
-elseif(parsedate(13:14) == '00') then
+else if(parsedate(13:14) == '00') then
parsedate(13:14) = ''
-endif
-
-return
+end if
end function parsedate
@@ -299,7 +313,7 @@ subroutine parsedt(dt,dday,dh,dn,ds)
integer, intent(out) :: dn
integer, intent(out) :: ds
-character(len=1) :: ch
+character(len=1 ) :: ch
integer :: n,i,d,s,nounit
! initialize time and sign
@@ -310,6 +324,7 @@ subroutine parsedt(dt,dday,dh,dn,ds)
ds=0
d=0
s=1
+
do n = 1, len_trim(dt)
ch = dt(n:n)
select case (ch)
@@ -337,8 +352,10 @@ subroutine parsedt(dt,dday,dh,dn,ds)
ds=ds+d*s
d=0
case default
+ continue
end select
-enddo
+end do
+
if (nounit==1) dh=d*s
end subroutine parsedt
@@ -353,8 +370,8 @@ end subroutine parsedt
function formatdate(datein,dateform)
character(len=*), intent(in) :: datein
character(len=*), intent(in) :: dateform
-character(len=80) :: formatdate
+character(len=80) :: formatdate
integer :: ic,iy,im,id,ih,in,is
ic=index(dateform,'cc')
@@ -364,7 +381,9 @@ function formatdate(datein,dateform)
ih=index(dateform,'hh')
in=index(dateform,'nn')
is=index(dateform,'ss')
+
formatdate=trim(dateform)
+
if (ic /= 0) formatdate(ic:ic+1) = datein(1:2)
if (iy /= 0) formatdate(iy:iy+1) = datein(3:4)
if (im /= 0) formatdate(im:im+1) = datein(5:6)
diff --git a/assimilation_code/programs/buildall.csh b/assimilation_code/programs/buildall.csh
deleted file mode 100755
index b29d929e5a..0000000000
--- a/assimilation_code/programs/buildall.csh
+++ /dev/null
@@ -1,122 +0,0 @@
-#!/bin/csh
-#
-# 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
-#
-# DART $Id$
-#
-# build and test all the programs given in the list.
-# usage: [ -mpi | -nompi | -default ]
-#
-#----------------------------------------------------------------------
-
-set usingmpi=no
-
-if ( $#argv > 0 ) then
- if ( "$argv[1]" == "-mpi" ) then
- set usingmpi=yes
- else if ( "$argv[1]" == "-default" ) then
- set usingmpi=default
- else if ( "$argv[1]" == "-nompi" ) then
- set usingmpi=no
- else
- echo "Unrecognized argument to $0: $argv[1]"
- echo "Usage: $0 [ -mpi | -nompi | -default ]"
- echo " default is to run tests without MPI"
- exit -1
- endif
-endif
-
-# set the environment variable MPI to anything in order to enable the
-# MPI builds and tests. set the argument to the build scripts so it
-# knows which ones to build.
-if ( "$usingmpi" == "yes" ) then
- echo "Will be building with MPI enabled"
- set QUICKBUILD_ARG='-mpi'
-else if ( "$usingmpi" == "default" ) then
- echo "Will be building with the default MPI settings"
- set QUICKBUILD_ARG=''
-else if ( "$usingmpi" == "no" ) then
- echo "Will NOT be building with MPI enabled"
- set QUICKBUILD_ARG='-nompi'
-else
- echo "Internal error: unrecognized value of usingmpi; should not happen"
- exit -1
-endif
-
-#----------------------------------------------------------------------
-
-if ( ! $?REMOVE) then
- setenv REMOVE 'rm -f'
-endif
-
-if ( ! $?host) then
- setenv host `uname -n`
-endif
-
-echo "Running DART programs test on $host"
-
-#----------------------------------------------------------------------
-
-set programdir = `pwd`
-
-# set the list of programs to include here
-
-set DO_THESE_PROGRAMS = ( \
- compare_states \
- gen_sampling_err_table \
- system_simulation \
-)
-
-#----------------------------------------------------------------------
-# Compile all executables for each program.
-#----------------------------------------------------------------------
-
-@ programnum = 1
-
-foreach PROGRAM ( $DO_THESE_PROGRAMS )
-
- echo
- echo
- echo "=================================================================="
- echo "=================================================================="
- echo "Compiling $PROGRAM starting at "`date`
- echo "=================================================================="
- echo "=================================================================="
- echo
- echo
-
- cd ${programdir}/${PROGRAM}/work
- set FAILURE = 0
-
- ./quickbuild.csh ${QUICKBUILD_ARG} || set FAILURE = 1
-
- @ programnum = $programnum + 1
-
- echo
- echo
- echo "=================================================================="
- echo "=================================================================="
- if ( $FAILURE ) then
- echo "ERROR - unsuccessful build of $PROGRAM at "`date`
- else
- echo "End of successful build of $PROGRAM at "`date`
- endif
- echo "=================================================================="
- echo "=================================================================="
- echo
- echo
-
-end
-
-echo
-echo $programnum programs built.
-echo
-
-exit 0
-
-#
-# $URL$
-# $Revision$
-# $Date$
diff --git a/assimilation_code/programs/closest_member_tool/closest_member_tool.f90 b/assimilation_code/programs/closest_member_tool/closest_member_tool.f90
index bb2411469e..8b8ad50bec 100644
--- a/assimilation_code/programs/closest_member_tool/closest_member_tool.f90
+++ b/assimilation_code/programs/closest_member_tool/closest_member_tool.f90
@@ -4,19 +4,19 @@
!
! $Id$
-!>@todo FIXME changed so it compiles, but this IS NOT WORKING CODE YET
-!> it needs to read in an ensemble (perhaps become an mpi program)
-!> and do all ensemble members at the same time - also handle the
-!> layout when only part of a state vector is on a single task.
-!> would have to do a reduce to add up the total differences.
-
-!>@todo FIXME the html needs to be made consistent with the namelist once the namelist
-!> is fleshed out.
+!> @mainpage
+!> @{
+!> @brief Select the member closest to the ensemble mean.
+!>
+!> This program has options to compute distance in several different ways
+!> and returns the ensemble member which has the smallest total distance from
+!> the ensemble mean.
+!> @}
+!>
+!>
program closest_member_tool
-! Program to overwrite the time on each ensemble in a restart file.
-
use types_mod, only : r8, i8, obstypelength, MAX_NUM_DOMS, MAX_FILES
use time_manager_mod, only : time_type, set_time_missing, operator(/=), &
@@ -25,7 +25,8 @@ program closest_member_tool
use utilities_mod, only : register_module, find_namelist_in_file, &
error_handler, nmlfileunit, E_MSG, E_ERR, &
check_namelist_read, do_nml_file, do_nml_term, &
- open_file, close_file, set_multiple_filename_lists
+ open_file, close_file, set_multiple_filename_lists, &
+ get_next_filename
use location_mod, only : location_type
@@ -37,7 +38,7 @@ program closest_member_tool
use assim_model_mod, only : static_init_assim_model, get_model_size, &
get_state_meta_data
-use state_vector_io_mod, only : read_state, write_state
+use state_vector_io_mod, only : read_state
use io_filenames_mod, only : file_info_type, io_filenames_init, &
set_io_copy_flag, set_file_metadata, &
@@ -49,7 +50,7 @@ program closest_member_tool
use mpi_utilities_mod, only : initialize_mpi_utilities, task_count, &
finalize_mpi_utilities, my_task_id, &
- send_sum_to
+ send_sum_to, sum_across_tasks
use ensemble_manager_mod, only : ensemble_type, init_ensemble_manager, compute_copy_mean, &
get_my_vars, get_my_num_vars, end_ensemble_manager
@@ -62,8 +63,9 @@ program closest_member_tool
character(len=32 ), parameter :: revision = "$Revision$"
character(len=128), parameter :: revdate = "$Date$"
-integer :: iunit, io, ens, i, j, qtyindex
+integer :: iunit, io, ens, i, j, total_j, qtyindex
integer :: num_qtys, stype
+
integer(i8) :: ii, model_size
integer, allocatable :: index_list(:)
integer, parameter :: max_list_len = 500
@@ -71,7 +73,7 @@ program closest_member_tool
logical :: allqtys, done
logical, allocatable :: useqty(:), useindex(:)
type(location_type) :: loc
-type(time_type) :: mean_time, member_time
+type(time_type) :: member_time
type(file_info_type) :: ens_file_info
@@ -116,7 +118,7 @@ program closest_member_tool
character(len=256) :: my_base, my_desc
integer(i8), allocatable :: vars_array(:)
integer(i8) :: owners_index
-integer :: num_domains, idom, imem
+integer :: num_domains, imem
integer :: ENS_MEAN_COPY
integer :: copies, my_num_vars, num_copies
real(r8), allocatable :: total_diff(:)
@@ -160,7 +162,7 @@ program closest_member_tool
num_domains = get_num_domains()
-! Given either a vector of in/output_state_files or a text file containing
+! Given either a vector of input_state_files or a text file containing
! a list of files, return a vector of files containing the filenames.
call set_multiple_filename_lists(input_restart_files(:), &
input_restart_file_list(:), &
@@ -176,10 +178,11 @@ program closest_member_tool
file_array_input = RESHAPE(input_restart_files, (/ens_size, num_domains/))
! read in the ensemble and the mean - always in a separate file
-call io_filenames_init(ens_file_info, ens_size, &
- cycling=single_restart_file_in, &
- single_file=single_restart_file_in, &
- restart_files=file_array_input)
+call io_filenames_init(ens_file_info, &
+ ncopies = ens_size, &
+ cycling = single_restart_file_in, &
+ single_file = single_restart_file_in, &
+ restart_files = file_array_input)
do imem = 1, ens_size
write(my_base,'(A,I0.2)') 'inens_', imem
@@ -282,14 +285,17 @@ program closest_member_tool
endif
enddo
- !>@todo JOHNNY should do a sum_all_variables then print
- write(msgstring, *) 'using ', j, ' of ', model_size, ' items in the state vector'
+ ! compute the total across all members
+ call sum_across_tasks(j, total_j)
+ write(msgstring, *) 'using ', total_j, ' of ', model_size, ' items in the state vector'
call error_handler(E_MSG,'closest_member_tool', msgstring)
else
! use everything.
useindex(:) = .true.
endif
+allocate(total_diff(ens_size))
+
total_diff = compute_diff(ens_handle%copies(:,:), ens_handle%copies(ENS_MEAN_COPY,:))
!------------------- Print out results -----------------------
@@ -314,9 +320,11 @@ program closest_member_tool
iunit = open_file(output_file_name, 'formatted', 'write')
if (single_restart_file_in) then
- write(iunit, "(I4)") index_list(1)
+ write(iunit, "(I6)") index_list(1)
else
- write(iunit, "(A,A,I4.4)") trim(input_restart_file_list(1)), '.', index_list(1)
+ !> @todo FIXME is this domain by domain? if so, need to loop over domains?
+ msgstring = get_next_filename(input_restart_file_list(1), index_list(1))
+ write(iunit, "(A)") trim(msgstring)
endif
call close_file(iunit)
@@ -334,7 +342,7 @@ program closest_member_tool
if (.not. allqtys) deallocate(useqty)
call end_ensemble_manager(ens_handle)
-call finalize_mpi_utilities() ! now closes log file, too
+call finalize_mpi_utilities()
!----------------------------------------------------------------
!----------------------------------------------------------------
diff --git a/assimilation_code/programs/closest_member_tool/closest_member_tool.html b/assimilation_code/programs/closest_member_tool/closest_member_tool.html
index 6f46f0188f..c311dda115 100644
--- a/assimilation_code/programs/closest_member_tool/closest_member_tool.html
+++ b/assimilation_code/programs/closest_member_tool/closest_member_tool.html
@@ -36,8 +36,8 @@
PROGRAM closest_member_tool
Overview
-Utility program to compare the ensemble mean to a group of ensemble
-member restart files, which can now be run in parallel.
+Utility program to compare the ensemble mean to an ensemble of
+restart files, which can now be run in parallel.
The program prints out a sorted order of which
members are 'closest' to the mean, where the method used to determine
'close' is selectable by namelist option. It also creates a file with
@@ -85,7 +85,7 @@
Overview
members to run a free model forecast forward in time after
the assimilation is finished. Each member is an equally likely
representation of the model state. Using the ensemble mean
-may not be the best since the mean may not have
+may not be the best choice since the mean may not have
self-consistent fine-scale structures in the data.
In addition to printing out data about all members to both
@@ -93,8 +93,8 @@
Overview
a single output file containing information about the closest member.
If the input restart data is in a single file, the output
file 'closest_restart' contains a single number which is
-the ensemble member number. If the
-input restart data is in separate files, the output file
+the ensemble member number.
+If the input restart data is in separate files, the output file
contains the full filename of the closest member, e.g.
'filter_restart.0004' if member 4 is closest. For scripting
the contents of this file can be used to copy the corresponding
@@ -186,12 +186,12 @@
-Currently single_restart_file_in is not supported. This is
-typically used for simpler models that have built in model
-advances such as lorenz_96.
+Currently single_restart_file_in is not supported.
+This is typically used for simpler models that have built in model
+advances such as lorenz_96.
-none
+Add check to see that the model template variables are conformable
+with the variables in the files being read.
diff --git a/assimilation_code/programs/closest_member_tool/closest_member_tool.nml b/assimilation_code/programs/closest_member_tool/closest_member_tool.nml
index 76d0210d22..ea8754f5f4 100644
--- a/assimilation_code/programs/closest_member_tool/closest_member_tool.nml
+++ b/assimilation_code/programs/closest_member_tool/closest_member_tool.nml
@@ -1,4 +1,3 @@
-
# different methods to compute 'distance' from mean:
# 1 = simple absolute difference
# 2 = normalized absolute difference
@@ -6,12 +5,12 @@
# 4 = normalized rmse difference
&closest_member_tool_nml
- input_restart_file_list = '',
- mean_restart_file_list = '',
- output_file_name = 'closest_restart',
- ens_size = 1
- difference_method = 4,
- use_only_kinds = '',
- single_restart_file_in = .false.,
+ input_restart_files = ''
+ input_restart_file_list = ''
+ output_file_name = 'closest_restart'
+ ens_size = 1
+ difference_method = 4
+ use_only_qtys = ''
+ single_restart_file_in = .false.
/
diff --git a/assimilation_code/programs/compare_states/compare_states.f90 b/assimilation_code/programs/compare_states/compare_states.f90
index 7bc820a068..d3a872f101 100644
--- a/assimilation_code/programs/compare_states/compare_states.f90
+++ b/assimilation_code/programs/compare_states/compare_states.f90
@@ -18,11 +18,12 @@ program compare_states
! do this with a short script, but not all platforms have matlab.
use types_mod, only : r8
-use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
- open_file, close_file, nc_check, get_next_filename, &
- find_namelist_in_file, check_namelist_read, &
- do_nml_file, do_nml_term, nmlfileunit, &
+use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
+ open_file, close_file, get_next_filename, &
+ find_namelist_in_file, check_namelist_read, &
+ do_nml_file, do_nml_term, nmlfileunit, &
initialize_utilities, finalize_utilities
+use netcdf_utilities_mod, only : nc_check
use parse_args_mod, only : get_args_from_string
use netcdf
diff --git a/assimilation_code/programs/compare_states/work/path_names_compare_states b/assimilation_code/programs/compare_states/work/path_names_compare_states
index 782bf5e793..c6f9849dcf 100644
--- a/assimilation_code/programs/compare_states/work/path_names_compare_states
+++ b/assimilation_code/programs/compare_states/work/path_names_compare_states
@@ -1,3 +1,4 @@
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
assimilation_code/modules/utilities/parse_args_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
diff --git a/assimilation_code/programs/compare_states/work/quickbuild.csh b/assimilation_code/programs/compare_states/work/quickbuild.csh
index a61c478dc7..37796155ea 100755
--- a/assimilation_code/programs/compare_states/work/quickbuild.csh
+++ b/assimilation_code/programs/compare_states/work/quickbuild.csh
@@ -8,7 +8,7 @@
#
# This script compiles all executables in this directory.
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
set MODEL = "compare_states"
@@ -25,7 +25,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -33,9 +33,9 @@ foreach TARGET ( mkmf_* )
end
# clean up. comment this out if you want to keep the .o and .mod files around
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml.*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All DART programs compiled."
exit 0
diff --git a/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.f90 b/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.f90
index 476a517a11..06bbcd5341 100644
--- a/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.f90
+++ b/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.f90
@@ -45,8 +45,6 @@ program fill_inflation_restart
use mpi_utilities_mod, only : initialize_mpi_utilities, finalize_mpi_utilities
-use netcdf
-
implicit none
! version controlled file description for error handling, do not edit
@@ -64,14 +62,14 @@ program fill_inflation_restart
! The namelist variables
!------------------------------------------------------------------
-logical :: single_file = .false.
-character(len=256) :: input_state_files(MAX_FILES) = ''
logical :: write_prior_inf = .FALSE.
real(r8) :: prior_inf_mean = MISSING_R8
real(r8) :: prior_inf_sd = MISSING_R8
logical :: write_post_inf = .FALSE.
real(r8) :: post_inf_mean = MISSING_R8
real(r8) :: post_inf_sd = MISSING_R8
+logical :: single_file = .FALSE.
+character(len=256) :: input_state_files(MAX_FILES) = ''
logical :: verbose = .FALSE.
namelist /fill_inflation_restart_nml/ &
@@ -231,7 +229,7 @@ subroutine fill_inflation_files(inf_mean, inf_sd, stage)
ens_handle%copies(ss_inflate_index , :) = prior_inf_mean
ens_handle%copies(ss_inflate_sd_index, :) = prior_inf_sd
-write(my_stage,'(2A)') stage, '_inflation'
+write(my_stage,'(3A)') 'input_', stage, 'inf'
write(my_base, '(A)') 'mean'
write(my_desc, '(2A)') stage, ' inflation mean'
call set_file_metadata(file_info_output, &
diff --git a/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.html b/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.html
index 4aa4ca62ef..d3b522b0cf 100644
--- a/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.html
+++ b/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.html
@@ -42,8 +42,9 @@
Overview
inf_sd_initial_from_restart items in the &filter_nml
namelist can be .TRUE. from the beginning.
-This reads values from the namelist, prior_inf_mean, prior_inf_sd and/or
-post_inf_mean, post_inf_sd.
+This reads inflation values from the &fill_inflation_restart_nml namelist for
+prior_inf_mean, prior_inf_sd and post_inf_mean, post_inf_sd. It does not use
+the values in the & filter namelist.
@@ -54,6 +55,16 @@
Overview
exactly the namelist used during the assimilation run.
+
+It creates files with names consistent with the input names expected by filter:
+
A template file that contains all of the variables in the
- state vector. If there is multiple domains you need to provide
- a file for each domain.
-
-
write_prior_inf
logical
Setting this to .TRUE. writes both the prior inflation mean and
- standard deviation file 'inflation_prior_mean', 'inflation_prior_sd'.
+ standard deviation files: input_priorinf_mean.nc,
+ input_priorinf_sd.nc.
prior_inf_mean
@@ -157,7 +162,8 @@
NAMELIST
write_post_inf
logical
Setting this to .TRUE. writes both the posterior inflation mean and
- standard deviation file 'inflation_post_mean', 'inflation_post_sd'.
+ standard deviation files input_postinf_mean.nc,
+ input_postinf_sd.nc.
post_inf_mean
@@ -174,7 +180,14 @@
NAMELIST
logical
Currently not supported, but would be used in the
case where you have a single restart file that contains
- all of the ensemble members.
+ all of the ensemble members. Must be .false.
+
+
+
input_state_files
+
character(:)
+
For the single file case a list of input files, one per domain,
+ to add the inflation values into with the proper netcdf variable names.
+ Unused for the multiple file case.
verbose
@@ -191,24 +204,23 @@
NAMELIST
-Here is an example of a typical namelist for
-fill_inflation_restart.
+Here is an example of a typical namelist for fill_inflation_restart :
diff --git a/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.nml b/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.nml
index f460fe5f1c..4ddfd7baef 100644
--- a/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.nml
+++ b/assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.nml
@@ -1,16 +1,15 @@
&fill_inflation_restart_nml
- input_state_files = ''
-
write_prior_inf = .FALSE.
prior_inf_mean = -88888.8888
prior_inf_sd = -88888.8888
write_post_inf = .FALSE.
- prior_inf_mean = -88888.8888
- prior_inf_sd = -88888.8888
+ post_inf_mean = -88888.8888
+ post_inf_sd = -88888.8888
single_file = .FALSE.
+ input_state_files = ''
verbose = .FALSE.
/
diff --git a/assimilation_code/programs/gen_sampling_err_table/gen_sampling_err_table.f90 b/assimilation_code/programs/gen_sampling_err_table/gen_sampling_err_table.f90
index 822961589b..8e1b65c9c8 100644
--- a/assimilation_code/programs/gen_sampling_err_table/gen_sampling_err_table.f90
+++ b/assimilation_code/programs/gen_sampling_err_table/gen_sampling_err_table.f90
@@ -31,10 +31,11 @@
program gen_sampling_err_table
use types_mod, only : r8, MISSING_I
-use utilities_mod, only : error_handler, E_ERR, nc_check, file_exist, &
+use utilities_mod, only : error_handler, E_ERR, file_exist, &
initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
do_nml_file, do_nml_term, nmlfileunit, E_MSG
+use netcdf_utilities_mod, only : nc_check
use random_seq_mod, only : random_seq_type, init_random_seq, twod_gaussians
use netcdf
diff --git a/assimilation_code/programs/gen_sampling_err_table/work/input.nml b/assimilation_code/programs/gen_sampling_err_table/work/input.nml
index a000874b05..706a1be08f 100644
--- a/assimilation_code/programs/gen_sampling_err_table/work/input.nml
+++ b/assimilation_code/programs/gen_sampling_err_table/work/input.nml
@@ -1,20 +1,15 @@
-# the default netcdf file that is checked out with the source
-# code already contains these ensemble sizes. you can run
-# the generator program to append new sizes to the
+# the supplied netcdf file contains all ensemble sizes from 3 to 200.
+#
+# you can run the generator program to append new ensemble sizes to the
# existing file.
#
# the computation iterates many times to compute the factors;
# each new size will take many minutes.
#
-# ens_sizes = 5, 6, 7, 8, 9, 10, 12, 14, 15, 16, 18, 20,
-# 22, 24, 28, 30, 32, 36, 40, 44, 48, 49, 50,
-# 52, 56, 60, 64, 70, 72, 80, 84, 88, 90, 96,
-# 100, 120, 140, 160, 180, 200
-#
&gen_sampling_error_table_nml
- ens_sizes = 98, 128
+ ens_sizes = 250, 300
debug = .false.
/
diff --git a/assimilation_code/programs/gen_sampling_err_table/work/path_names_gen_sampling_err_table b/assimilation_code/programs/gen_sampling_err_table/work/path_names_gen_sampling_err_table
index 57ed536a8c..cab3b3a4db 100644
--- a/assimilation_code/programs/gen_sampling_err_table/work/path_names_gen_sampling_err_table
+++ b/assimilation_code/programs/gen_sampling_err_table/work/path_names_gen_sampling_err_table
@@ -1,3 +1,4 @@
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
assimilation_code/modules/utilities/random_seq_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
diff --git a/assimilation_code/programs/gen_sampling_err_table/work/quickbuild.csh b/assimilation_code/programs/gen_sampling_err_table/work/quickbuild.csh
index 4813e6b261..0cbfcec90c 100755
--- a/assimilation_code/programs/gen_sampling_err_table/work/quickbuild.csh
+++ b/assimilation_code/programs/gen_sampling_err_table/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -17,7 +17,7 @@ set ITEM = "Generate Sampling Error Correction Table"
# ---------------
# shouldn't have to modify this script below here.
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
@ n = 0
@@ -28,16 +28,16 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$ITEM build number $n is $PROG"
+ echo "$ITEM build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
end
-echo "Success: All programs compiled."
+echo "Success: All programs compiled."
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml.*_default Makefile .cppdefs
exit 0
diff --git a/assimilation_code/programs/gen_sampling_err_table/work/sampling_error_correction_table.nc b/assimilation_code/programs/gen_sampling_err_table/work/sampling_error_correction_table.nc
index abb56b0e20..39033fafcb 100644
Binary files a/assimilation_code/programs/gen_sampling_err_table/work/sampling_error_correction_table.nc and b/assimilation_code/programs/gen_sampling_err_table/work/sampling_error_correction_table.nc differ
diff --git a/assimilation_code/programs/model_mod_check/model_mod_check.f90 b/assimilation_code/programs/model_mod_check/model_mod_check.f90
index 79b553d1aa..408e1d214b 100644
--- a/assimilation_code/programs/model_mod_check/model_mod_check.f90
+++ b/assimilation_code/programs/model_mod_check/model_mod_check.f90
@@ -15,21 +15,20 @@ program model_mod_check
use types_mod, only : r8, i8, missing_r8, metadatalength
use utilities_mod, only : register_module, error_handler, E_MSG, E_ERR, &
- initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
- nc_check, E_MSG, open_file, close_file, do_output
+ E_MSG, open_file, close_file, do_output
use mpi_utilities_mod, only : initialize_mpi_utilities, finalize_mpi_utilities
-use location_mod, only : location_type, set_location, write_location
+use location_mod, only : location_type, write_location
-use obs_kind_mod, only : get_index_for_quantity, get_name_for_quantity
+use obs_kind_mod, only : get_name_for_quantity
use obs_sequence_mod, only : static_init_obs_sequence
use assim_model_mod, only : static_init_assim_model
-use time_manager_mod, only : time_type, set_time, print_time, print_date, operator(-), &
+use time_manager_mod, only : time_type, print_time, print_date, operator(-), &
get_calendar_type, NO_CALENDAR
use ensemble_manager_mod, only : init_ensemble_manager, ensemble_type
@@ -41,21 +40,17 @@ program model_mod_check
use io_filenames_mod, only : io_filenames_init, file_info_type, &
stage_metadata_type, get_stage_metadata, &
- get_restart_filename, &
- set_file_metadata, file_info_dump, &
+ get_restart_filename, set_file_metadata, &
set_io_copy_flag, READ_COPY, WRITE_COPY
use distributed_state_mod, only : create_state_window, free_state_window
-use model_mod, only : static_init_model, get_model_size, &
- get_state_meta_data, model_interpolate
+use model_mod, only : get_model_size, get_state_meta_data
use test_interpolate_mod, only : test_interpolate_single, &
test_interpolate_range, &
find_closest_gridpoint
-use netcdf
-
implicit none
! version controlled file description for error handling, do not edit
@@ -166,6 +161,8 @@ program model_mod_check
call static_init_assim_model()
+num_domains = get_num_domains()
+
call print_test_message('TEST 0', ending=.true.)
!----------------------------------------------------------------------
@@ -181,21 +178,22 @@ program model_mod_check
if (verbose) then
string1 = 'To suppress the detailed list of the variables that comprise the DART state'
string2 = 'set "verbose = .FALSE." in the model_mod_check_nml namelist.'
- call print_info_message('TEST 1',string1, string2)
+ call print_info_message(string1, string2)
- do idomain = 1,get_num_domains()
+ do idomain = 1,num_domains
call state_structure_info(idomain)
enddo
else
string1 = 'To print a detailed list of the variables that comprise the DART state'
string2 = 'set "verbose = .TRUE." in the model_mod_check_nml namelist.'
- call print_info_message('TEST 1',string1, string2)
+ call print_info_message(string1, string2)
endif
model_size = get_model_size()
+ call left_just_i8(model_size, string3)
- write(string1, '(A,I10)') 'state vector has length of ', model_size
- call print_info_message('TEST 1', string1)
+ write(string1, *) 'state vector has a length of ', trim(string3)
+ call print_info_message(string1)
call print_test_message('TEST 1', ending=.true.)
@@ -213,95 +211,15 @@ program model_mod_check
! Set up the ensemble storage and read in the restart file
call init_ensemble_manager(ens_handle, num_ens, model_size)
- ! Allocate space for file arrays. contains a matrix of files (num_ens x num_domains)
- ! If perturbing from a single instance the number of input files does not have to
- ! be ens_size but rather a single file (or multiple files if more than one domain)
-
- num_domains = get_num_domains()
-
- allocate(file_array_input( num_ens, num_domains))
- allocate(file_array_output(num_ens, num_domains))
- file_array_input = RESHAPE(input_state_files, (/num_ens, num_domains/))
- file_array_output = RESHAPE(output_state_files, (/num_ens, num_domains/))
-
- ! Test the read portion.
- call io_filenames_init(file_info_input, &
- ncopies = num_ens, &
- cycling = single_file, &
- single_file = single_file, &
- restart_files = file_array_input)
-
- do imem = 1, num_ens
- write(my_base,'(A,I2)') 'inens_', imem
- write(my_desc,'(A,I2)') 'input ens', imem
- call set_file_metadata(file_info_input, &
- cnum = imem, &
- fnames = file_array_input(imem,:), &
- basename = my_base, &
- desc = my_desc)
-
- call set_io_copy_flag(file_info_input, &
- cnum = imem, &
- io_flag = READ_COPY)
- enddo
-
- input_restart_files = get_stage_metadata(file_info_input)
-
- do idom = 1, num_domains
- do imem = 1, num_ens
- write(string1, *) '- Reading File : ', trim(get_restart_filename(input_restart_files, imem, domain=idom))
- call print_info_message('TEST 2',string1)
- enddo
- enddo
-
- call read_state(ens_handle, file_info_input, read_time_from_file, model_time)
-
- ! Test the write portion.
- call io_filenames_init(file_info_output, &
- ncopies = num_ens, &
- cycling = single_file, &
- single_file = single_file, &
- restart_files = file_array_output)
-
- do imem = 1, num_ens
- write(my_base,'(A,I2)') 'outens_', imem
- write(my_desc,'(A,I2)') 'output ens', imem
- call set_file_metadata(file_info_output, &
- cnum = imem, &
- fnames = file_array_output(imem,:), &
- basename = my_base, &
- desc = my_desc)
-
- call set_io_copy_flag(file_info_output, &
- cnum = imem, &
- io_flag = WRITE_COPY)
- enddo
-
- output_restart_files = get_stage_metadata(file_info_output)
-
- do idom = 1, num_domains
- do imem = 1, num_ens
- write(string1, *) '- Writing File : ', trim(get_restart_filename(output_restart_files, imem, domain=idom))
- call print_info_message('TEST 2',string1)
- enddo
- enddo
+ call do_read_test(ens_handle)
- call write_state(ens_handle, file_info_output)
+ call do_write_test(ens_handle)
- ! print date does not work when a model does not have a calendar
- if (get_calendar_type() /= NO_CALENDAR) then
- write(*,'(A)') '-- printing model date --------------------------------------'
- call print_date( model_time,' model_mod_check:model date')
- endif
-
- write(*,'(A)') '-- printing model time --------------------------------------'
- call print_time( model_time,' model_mod_check:model time')
- write(*,'(A)') '-------------------------------------------------------------'
+ call print_model_time(model_time)
+
call print_test_message('TEST 2', ending=.true.)
- deallocate(file_array_input, file_array_output)
-
endif
!----------------------------------------------------------------------
@@ -317,8 +235,10 @@ program model_mod_check
if ( x_ind >= 1 .and. x_ind <= model_size ) then
call check_meta_data( x_ind )
else
- write(string1, *) "x_ind = ", x_ind, " is not in valid range 1-", model_size
- call print_info_message('TEST 3',string1)
+ call left_just_i8(x_ind, string2)
+ call left_just_i8(model_size, string3)
+ write(string1, *) 'namelist item "x_ind" = '//trim(string2)//" is not in valid range 1 - "//trim(string3)
+ call print_info_message(string1)
endif
call print_test_message('TEST 3', ending=.true.)
@@ -332,14 +252,15 @@ program model_mod_check
if (tests_to_run(4)) then
call print_test_message('TEST 4', &
- 'Testing model_interpolate() with "loc_of_interest"', &
- 'for '//trim(quantity_of_interest)//' variables.', &
- starting=.true.)
+ 'Testing model_interpolate with a single location', starting=.true.)
call create_state_window(ens_handle)
allocate(interp_vals(num_ens), ios_out(num_ens))
+ call print_info_message('Interpolating '//trim(quantity_of_interest), &
+ ' at "loc_of_interest" location')
+
num_passed = test_interpolate_single( ens_handle, &
num_ens, &
interp_test_vertcoord, &
@@ -352,15 +273,15 @@ program model_mod_check
! test_interpolate_single reports individual interpolation failures internally
if (num_passed == num_ens) then
- write(string1,*)'interpolation successful for all ensemble members.'
- call print_info_message('TEST 4',string1)
+ call print_info_message('interpolation successful for all ensemble members.')
endif
call free_state_window(ens_handle)
call print_test_message('TEST 4', ending=.true.)
- deallocate(interp_vals, ios_out)
+ deallocate(interp_vals, ios_out)
+
endif
!----------------------------------------------------------------------
@@ -368,8 +289,9 @@ program model_mod_check
!----------------------------------------------------------------------
if (tests_to_run(5)) then
+
call print_test_message('TEST 5', &
- 'Testing model_interpolate() with a mesh of locations.', starting=.true.)
+ 'Testing model_interpolate() with a grid of locations.', starting=.true.)
call create_state_window(ens_handle)
@@ -393,6 +315,7 @@ program model_mod_check
call free_state_window(ens_handle)
call print_test_message('TEST 5', ending=.true.)
+
endif
!----------------------------------------------------------------------
@@ -401,32 +324,39 @@ program model_mod_check
if (tests_to_run(6)) then
- write(string1,*)'Exhaustive test of get_state_meta_data - please be patient.'
- write(string2,*)'There are ',get_model_size(),' items in the state vector.'
- call print_test_message('TEST 6', string1, string2, starting=.true.)
+ call print_test_message('TEST 6', &
+ 'Exhaustive test of get_state_meta_data()', &
+ starting=.true.)
+
+ call left_just_i8(model_size, string3)
+ write(string1,*)'There are '//trim(string3)//' items in the state vector.'
+ write(string2,*)'This might take some time.'
+ call print_info_message(string1, string2)
call check_all_meta_data()
- call print_info_message('TEST 6', &
- 'The table of metadata was written to '//trim(all_metadata_file))
+ call print_info_message('The table of metadata was written to file "'//trim(all_metadata_file)//'"')
call print_test_message('TEST 6', ending=.true.)
+
endif
!----------------------------------------------------------------------
-! Find the index closest to a location
+! Find the state vector index closest to a location
!----------------------------------------------------------------------
if (tests_to_run(7)) then
- write(string1,*)'Finding the state vector index closest to a given location.'
- call print_test_message('TEST 7', string1, starting=.true.)
+ call print_test_message('TEST 7', &
+ 'Finding the state vector index closest to a given location.', &
+ starting=.true.)
call find_closest_gridpoint(loc_of_interest, &
interp_test_vertcoord, &
quantity_of_interest)
call print_test_message('TEST 7', ending=.true.)
+
endif
!----------------------------------------------------------------------
@@ -439,8 +369,7 @@ program model_mod_check
! finalize model_mod_check
!----------------------------------------------------------------------
-write(string1,*) '- model_mod_check Finished successfully'
-call print_info_message(string1)
+call print_info_message('model_mod_check Finished successfully')
call finalize_modules_used()
@@ -484,6 +413,11 @@ subroutine check_meta_data( iloc )
integer :: ix, iy, iz, dom_id, qty_index, var_type
character(len=256) :: qty_string
+call left_just_i8(iloc, string3)
+write(string1, *) 'requesting meta data for state vector index '//trim(string3)
+write(string2, *) 'set by namelist item "x_ind"'
+call print_info_message(string1, string2)
+
call get_state_meta_data(iloc, loc, var_type)
call get_model_variable_indices(iloc, ix, iy, iz, &
dom_id=dom_id, &
@@ -499,119 +433,6 @@ subroutine check_meta_data( iloc )
end subroutine check_meta_data
-!----------------------------------------------------------------------
-!> print the labels between the starts of tests
-
-subroutine print_test_message(test_label, msg1, msg2, msg3, starting, ending)
-
-character(len=*), intent(in) :: test_label
-character(len=*), intent(in), optional :: msg1
-character(len=*), intent(in), optional :: msg2
-character(len=*), intent(in), optional :: msg3
-logical, intent(in), optional :: starting
-logical, intent(in), optional :: ending
-
-if (do_output()) &
- call print_message(.true., test_label, msg1, msg2, msg3, starting, ending)
-
-end subroutine print_test_message
-
-!----------------------------------------------------------------------
-!> print an informational message
-
-subroutine print_info_message(info_msg, msg1, msg2, msg3, starting, ending)
-
-character(len=*), intent(in) :: info_msg
-character(len=*), intent(in), optional :: msg1
-character(len=*), intent(in), optional :: msg2
-character(len=*), intent(in), optional :: msg3
-logical, intent(in), optional :: starting
-logical, intent(in), optional :: ending
-
-if (do_output()) &
- call print_message(.false., info_msg, msg1, msg2, msg3, starting, ending)
-
-end subroutine print_info_message
-
-!----------------------------------------------------------------------
-!> common code for printing
-
-subroutine print_message(is_test_label, msg, msg1, msg2, msg3, starting, ending)
-
-logical, intent(in) :: is_test_label ! true is test, false is info
-character(len=*), intent(in) :: msg
-character(len=*), intent(in), optional :: msg1
-character(len=*), intent(in), optional :: msg2
-character(len=*), intent(in), optional :: msg3
-logical, intent(in), optional :: starting
-logical, intent(in), optional :: ending
-
-character(len=20) :: test_label
-character(len=64) :: msg_label
-character(len=64) :: msg_blank
-character(len=64) :: msg_close
-character(len=64) :: msg_sep1
-character(len=64) :: msg_sep2
-logical :: is_start, is_end
-
-! if my task isn't writing output, return now.
-if (.not. do_output()) return
-
-! setup section - set defaults for optional arguments
-! so we don't have to keep testing them.
-
-is_start = set_logical_flag(.false., starting)
-is_end = set_logical_flag(.false., ending)
-
-! is it documented anywhere that this can only be 20 chars long?
-! i'm assuming this was set up so the separators would line up.
-
-if (is_test_label) then
- if (is_start) then
- test_label = 'RUNNING '//trim(msg)
- else if (is_end) then
- test_label = 'FINISHED '//trim(msg)
- else
- test_label = msg
- endif
- write(msg_label, '(3A)') '***************** ', test_label, ' ***********************'
-endif
-
-write(msg_close ,'(A)' ) '**************************************************************'
-write(msg_sep1, '(A)' ) 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'
-write(msg_sep2, '(A)' ) '--------------------------------------------------------------'
-write(msg_blank, '(A)' ) ''
-
-! ok, here's where the actual writing happens.
-! if you want to change the formatting, fool around with
-! the order and formatting of these lines and it will affect
-! all the output from this program.
-
-if (is_test_label) then
- write(*,'(A)') trim(msg_blank)
- write(*,'(A)') trim(msg_blank)
-
- write(*,'(A)') trim(msg_label)
- if (present(msg1)) write(*,'(2A)') ' -- ', trim(msg1)
- if (present(msg2)) write(*,'(2A)') ' -- ', trim(msg2)
- if (present(msg3)) write(*,'(2A)') ' -- ', trim(msg3)
- if (present(msg1)) write(*,'(A)') trim(msg_close)
-
- if (is_end) then
- write(*,'(A)') trim(msg_sep1)
- write(*,'(A)') trim(msg_sep1)
- endif
-else ! info message
- write(*,'(A)') trim(msg_sep2)
- write(*,'(A)') trim(msg)
- if (present(msg1)) write(*,'(2A)') ' -- ', trim(msg1)
- if (present(msg2)) write(*,'(2A)') ' -- ', trim(msg2)
- if (present(msg3)) write(*,'(2A)') ' -- ', trim(msg3)
- write(*,'(A)') trim(msg_sep2)
-endif
-
-end subroutine print_message
-
!----------------------------------------------------------------------
!> compute the points to be used when testing interpolation
@@ -738,7 +559,7 @@ subroutine check_all_meta_data()
fid = open_file(all_metadata_file)
-do iloc = 1,get_model_size()
+do iloc = 1,model_size
call get_model_variable_indices(iloc, ix, iy, iz, &
dom_id=dom_id, &
@@ -764,8 +585,8 @@ subroutine check_all_meta_data()
write(string3,'(A,1x,I4,1x,A33,1x,A)') &
trim(string1), var_type, trim(qty_string), trim(string2)
- if ( do_output() ) write(fid,'(A)') trim(string3)
- if ( do_output() .and. mod(iloc,100000) == 0) write( * ,'(A)') trim(string3)
+ if ( do_output() ) write(fid,'(A)') trim(string3)
+ if ( do_output() .and. mod(iloc,int(100000,i8)) == 0) write( * ,'(A)') trim(string3)
enddo
@@ -773,6 +594,250 @@ subroutine check_all_meta_data()
end subroutine check_all_meta_data
+!------------------------------------------------------------------
+
+subroutine do_read_test(ens_handle)
+
+type(ensemble_type), intent(inout) :: ens_handle
+
+! Allocate space for file arrays. contains a matrix of files (num_ens x num_domains)
+! If perturbing from a single instance the number of input files does not have to
+! be ens_size but rather a single file (or multiple files if more than one domain)
+
+allocate(file_array_input( num_ens, num_domains))
+file_array_input = RESHAPE(input_state_files, (/num_ens, num_domains/))
+
+! Test the read portion.
+call io_filenames_init(file_info_input, &
+ ncopies = num_ens, &
+ cycling = single_file, &
+ single_file = single_file, &
+ restart_files = file_array_input)
+
+do imem = 1, num_ens
+ write(my_base,'(A,I2)') 'inens_', imem
+ write(my_desc,'(A,I2)') 'input ens', imem
+ call set_file_metadata(file_info_input, &
+ cnum = imem, &
+ fnames = file_array_input(imem,:), &
+ basename = my_base, &
+ desc = my_desc)
+
+ call set_io_copy_flag(file_info_input, &
+ cnum = imem, &
+ io_flag = READ_COPY)
+enddo
+
+input_restart_files = get_stage_metadata(file_info_input)
+
+do idom = 1, num_domains
+ do imem = 1, num_ens
+ write(string1, *) 'Reading File : ', trim(get_restart_filename(input_restart_files, imem, domain=idom))
+ call print_info_message(string1)
+ enddo
+enddo
+
+call read_state(ens_handle, file_info_input, read_time_from_file, model_time)
+
+deallocate(file_array_input)
+
+end subroutine do_read_test
+
+!------------------------------------------------------------------
+
+subroutine do_write_test(ens_handle)
+
+type(ensemble_type), intent(inout) :: ens_handle
+
+allocate(file_array_output(num_ens, num_domains))
+file_array_output = RESHAPE(output_state_files, (/num_ens, num_domains/))
+
+! Test the write portion.
+call io_filenames_init(file_info_output, &
+ ncopies = num_ens, &
+ cycling = single_file, &
+ single_file = single_file, &
+ restart_files = file_array_output)
+
+do imem = 1, num_ens
+ write(my_base,'(A,I2)') 'outens_', imem
+ write(my_desc,'(A,I2)') 'output ens', imem
+ call set_file_metadata(file_info_output, &
+ cnum = imem, &
+ fnames = file_array_output(imem,:), &
+ basename = my_base, &
+ desc = my_desc)
+
+ call set_io_copy_flag(file_info_output, &
+ cnum = imem, &
+ io_flag = WRITE_COPY)
+enddo
+
+output_restart_files = get_stage_metadata(file_info_output)
+
+do idom = 1, num_domains
+ do imem = 1, num_ens
+ write(string1, *) 'Writing File : ', trim(get_restart_filename(output_restart_files, imem, domain=idom))
+ call print_info_message(string1)
+ enddo
+enddo
+
+call write_state(ens_handle, file_info_output)
+
+deallocate(file_array_output)
+
+end subroutine do_write_test
+
+!------------------------------------------------------------------
+
+subroutine print_model_time(mtime)
+
+type(time_type), intent(in) :: mtime
+
+! this can be an MPI program. do this only from a single task or you
+! get hash from multiple tasks writing over each other.
+
+if (.not. do_output()) return
+
+write(*,'(A)') ''
+write(*,'(A)') '-------------------------------------------------------------'
+
+! print date does not work when a model does not have a calendar
+if (get_calendar_type() /= NO_CALENDAR) then
+ write(*,'(A)') 'printing model date: '
+ call print_date( mtime,' model_mod_check:model date')
+endif
+
+write(*,'(A)') 'printing model time: '
+call print_time( mtime,' model_mod_check:model time')
+write(*,'(A)') '-------------------------------------------------------------'
+write(*,'(A)') ''
+
+end subroutine print_model_time
+
+!----------------------------------------------------------------------
+!> print the labels between the starts of tests
+
+subroutine print_test_message(test_label, msg1, msg2, msg3, starting, ending)
+
+character(len=*), intent(in) :: test_label
+character(len=*), intent(in), optional :: msg1
+character(len=*), intent(in), optional :: msg2
+character(len=*), intent(in), optional :: msg3
+logical, intent(in), optional :: starting
+logical, intent(in), optional :: ending
+
+call print_message(.true., test_label, msg1, msg2, msg3, starting, ending)
+
+end subroutine print_test_message
+
+!----------------------------------------------------------------------
+!> print an informational message
+
+subroutine print_info_message(info_msg, msg1, msg2, msg3, starting, ending)
+
+character(len=*), intent(in) :: info_msg
+character(len=*), intent(in), optional :: msg1
+character(len=*), intent(in), optional :: msg2
+character(len=*), intent(in), optional :: msg3
+logical, intent(in), optional :: starting
+logical, intent(in), optional :: ending
+
+call print_message(.false., info_msg, msg1, msg2, msg3, starting, ending)
+
+end subroutine print_info_message
+
+!----------------------------------------------------------------------
+!> common code for printing
+
+subroutine print_message(is_test_label, msg, msg1, msg2, msg3, starting, ending)
+
+logical, intent(in) :: is_test_label ! true is test, false is info
+character(len=*), intent(in) :: msg
+character(len=*), intent(in), optional :: msg1
+character(len=*), intent(in), optional :: msg2
+character(len=*), intent(in), optional :: msg3
+logical, intent(in), optional :: starting
+logical, intent(in), optional :: ending
+
+character(len=20) :: test_label
+character(len=64) :: msg_label
+character(len=64) :: msg_blank
+character(len=64) :: msg_close
+character(len=64) :: msg_sep1
+character(len=64) :: msg_sep2
+logical :: is_start, is_end
+
+! if my task isn't writing output, return now.
+if (.not. do_output()) return
+
+! setup section - set defaults for optional arguments
+! so we don't have to keep testing them.
+
+is_start = set_logical_flag(.false., starting)
+is_end = set_logical_flag(.false., ending)
+
+! is it documented anywhere that this can only be 20 chars long?
+! i'm assuming this was set up so the separators would line up.
+
+if (is_test_label) then
+ if (is_start) then
+ test_label = 'RUNNING '//trim(msg)
+ else if (is_end) then
+ test_label = 'FINISHED '//trim(msg)
+ else
+ test_label = msg
+ endif
+ write(msg_label, '(3A)') '***************** ', test_label, ' ***********************'
+endif
+
+write(msg_close ,'(A)' ) '**************************************************************'
+write(msg_sep1, '(A)' ) 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'
+write(msg_sep2, '(A)' ) '--------------------------------------------------------------'
+write(msg_blank, '(A)' ) ''
+
+! ok, here's where the actual writing happens.
+! if you want to change the formatting, fool around with
+! the order and formatting of these lines and it will affect
+! all the output from this program.
+
+if (is_test_label) then
+ write(*,'(A)') trim(msg_blank)
+ write(*,'(A)') trim(msg_blank)
+
+ write(*,'(A)') trim(msg_label)
+ if (present(msg1)) write(*,'(2A)') ' -- ', trim(msg1)
+ if (present(msg2)) write(*,'(2A)') ' -- ', trim(msg2)
+ if (present(msg3)) write(*,'(2A)') ' -- ', trim(msg3)
+ if (present(msg1)) write(*,'(A)') trim(msg_close)
+
+ if (is_end) then
+ write(*,'(A)') trim(msg_sep1)
+ write(*,'(A)') trim(msg_sep1)
+ endif
+else ! info message
+ write(*,'(A)') trim(msg_sep2)
+ write(*,'(A)') trim(msg)
+ if (present(msg1)) write(*,'(2A)') ' -- ', trim(msg1)
+ if (present(msg2)) write(*,'(2A)') ' -- ', trim(msg2)
+ if (present(msg3)) write(*,'(2A)') ' -- ', trim(msg3)
+ write(*,'(A)') trim(msg_sep2)
+endif
+
+end subroutine print_message
+
+!------------------------------------------------------------------
+
+subroutine left_just_i8(ivalue, ostring)
+integer(i8), intent(in) :: ivalue
+character(len=*), intent(out) :: ostring
+
+write(ostring, *) ivalue
+ostring = adjustl(ostring)
+
+end subroutine left_just_i8
+
+!------------------------------------------------------------------
end program model_mod_check
diff --git a/assimilation_code/programs/obs_assim_count/obs_assim_count.f90 b/assimilation_code/programs/obs_assim_count/obs_assim_count.f90
new file mode 100644
index 0000000000..1cc5cd20ab
--- /dev/null
+++ b/assimilation_code/programs/obs_assim_count/obs_assim_count.f90
@@ -0,0 +1,581 @@
+! 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
+!
+! DART $Id$
+
+program obs_assim_count
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick table of obs types and counts, overall start and
+! stop times, and metadata strings and counts.
+
+! right now this program counts up the number of obs for each
+! possible 'DART quality control' value (0-7). (it could also
+! check for a 'posterior ensemble mean' copy and count how
+! many are missing_r8 and how many are not.) it does the
+! former right now.
+
+
+use types_mod, only : r8, missing_r8, metadatalength, obstypelength
+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, &
+ file_exist
+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
+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=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+type(obs_sequence_type) :: seq_in
+integer :: size_seq_in
+integer :: num_copies_in, num_qc_in
+integer :: iunit, io, ifile
+integer :: max_num_obs, file_id
+character(len = 129) :: read_format, filename_in
+logical :: pre_I_format, cal
+character(len = 256) :: msgstring, msgstring1, msgstring2
+
+! 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
+
+! 8 is now failed vert convert
+integer, parameter :: MAX_DART_QC = 8
+
+!----------------------------------------------------------------
+! Namelist input with default values
+
+
+character(len = 160) :: obs_sequence_name = ''
+character(len = 160) :: obs_sequence_list = ''
+
+logical :: stats_by_obs_type = .false.
+
+character(len=32) :: calendar = 'Gregorian'
+
+
+namelist /obs_assim_count_nml/ &
+ obs_sequence_name, obs_sequence_list, calendar, stats_by_obs_type
+
+!----------------------------------------------------------------
+! Start of the program:
+!
+! Process each input observation sequence file in turn, optionally
+! selecting observations to insert into the output sequence file.
+!----------------------------------------------------------------
+
+call setup()
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "obs_assim_count_nml", iunit)
+read(iunit, nml = obs_assim_count_nml, iostat = io)
+call check_namelist_read(iunit, io, "obs_assim_count_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=obs_assim_count_nml)
+if (do_nml_term()) write( * , nml=obs_assim_count_nml)
+
+! the default is a gregorian calendar. if you are using a different type
+! set it in the namelist. this only controls how it prints out the first
+! and last timestamps in the obs_seq files.
+call set_calendar_type(calendar)
+
+! set a logial to see if we have a calendar or not
+cal = (get_calendar_type() /= NO_CALENDAR)
+
+! Check the user input for sanity
+if ((obs_sequence_name /= '') .and. (obs_sequence_list /= '')) then
+ write(msgstring1,*)'specify "obs_sequence_name" or "obs_sequence_list"'
+ write(msgstring2,*)'set other to an empty string ... i.e. ""'
+ call error_handler(E_ERR, 'obs_assim_count', msgstring1, &
+ source, revision, revdate, text2=msgstring2)
+endif
+
+! if you add anything to the namelist, you can process it here.
+
+! end of namelist processing and setup
+
+ifile = 0
+ObsFileLoop : do ! until we run out of names
+!-----------------------------------------------------------------------
+
+ ifile = ifile + 1
+
+ ! Determine the next input filename ...
+
+ if (obs_sequence_list == '') then
+ if (ifile > 1) exit ObsFileLoop
+ filename_in = obs_sequence_name
+ else
+ filename_in = get_next_filename(obs_sequence_list,ifile)
+ if (filename_in == '') exit ObsFileLoop
+ endif
+
+ if ( .not. file_exist(filename_in) ) then
+ write(msgstring1,*)'cannot open ', trim(filename_in)
+ call error_handler(E_ERR,'obs_assim_count:',msgstring1,source,revision,revdate)
+ endif
+
+ ! Read in information about observation sequence so we can allocate
+ ! observations. We need info about how many copies, qc values, etc.
+
+
+ call read_obs_seq_header(filename_in, num_copies_in, num_qc_in, &
+ size_seq_in, max_num_obs, file_id, read_format, pre_I_format, &
+ close_the_file = .true.)
+
+ if (max_num_obs == 0) then
+ write(msgstring,*) 'No obs in input sequence file ', trim(filename_in)
+ call error_handler(E_ERR,'obs_assim_count',msgstring)
+ endif
+
+ write(msgstring, *) 'Starting to process input sequence file: '
+ write(msgstring1,*) trim(filename_in)
+ call error_handler(E_MSG,'obs_assim_count',msgstring, &
+ text2=msgstring1)
+
+ call read_obs_seq(filename_in, 0, 0, 0, seq_in)
+
+ ! sanity check - ensure the linked list times are in increasing time order
+ call validate_obs_seq_time(seq_in, filename_in)
+
+ ! the counting up is done here now.
+ call compute_and_print_obs_seq_info(seq_in, filename_in)
+
+ ! clean up
+
+ call destroy_obs_sequence(seq_in)
+
+enddo ObsFileLoop
+
+call shutdown()
+
+!---------------------------------------------------------------------
+! end of main program.
+!---------------------------------------------------------------------
+
+
+contains
+
+
+!---------------------------------------------------------------------
+subroutine setup()
+
+! Initialize modules used that require it
+call initialize_utilities('obs_assim_count')
+call register_module(source,revision,revdate)
+call static_init_obs_sequence()
+
+end subroutine setup
+
+
+!---------------------------------------------------------------------
+subroutine shutdown()
+
+call finalize_utilities('obs_assim_count')
+
+end subroutine shutdown
+
+
+!---------------------------------------------------------------------
+subroutine compute_and_print_obs_seq_info(seq_in, filename)
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick table of obs types and counts, overall start and
+! stop times, and metadata strings and counts.
+
+! and this one counts up, if there is a 'posterior ensemble mean' copy,
+! how many are missing_r8 and how many are not. it could also count
+! up the 'DART quality control' settings? start with the latter for now.
+
+type(obs_sequence_type), intent(in) :: seq_in
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq_in
+integer :: i, qc_int, obt
+integer :: this_obs_type
+integer :: type_count(0:max_defined_types_of_obs), identity_count, qc_count(0:MAX_DART_QC), qcindex
+integer :: qc_count_by_type(0:MAX_DART_QC, 0:max_defined_types_of_obs)
+real(r8) :: qcval(1)
+character(len=32) :: this_obs_name
+
+
+! Initialize counters
+type_count(:) = 0
+identity_count = 0
+qc_count(:) = 0
+qc_count_by_type(:,:) = 0
+
+
+size_seq_in = get_num_obs(seq_in)
+if (size_seq_in == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_assim_count',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq_in), get_num_qc(seq_in))
+call init_obs(next_obs, get_num_copies(seq_in), get_num_qc(seq_in))
+
+! find the dart qc copy, if there is one
+qcindex = get_dartqc_index(seq_in, filename)
+
+! blank line
+call error_handler(E_MSG,'',' ')
+
+write(msgstring,*) 'Processing sequence file ', trim(filename)
+call error_handler(E_MSG,'',msgstring)
+
+call print_metadata(seq_in, filename)
+
+!-------------------------------------------------------------
+! Start to process obs from seq_in
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq_in, obs)
+
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first observation in ',trim(filename)
+ call error_handler(E_MSG,'obs_assim_count', msgstring)
+endif
+
+! process it here
+is_this_last = .false.
+
+! blank line
+call error_handler(E_MSG, '', ' ')
+
+call get_obs_def(obs, this_obs_def)
+call print_time(get_obs_def_time(this_obs_def), ' First timestamp: ')
+! does not work with NO_CALENDAR
+if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_obs_type = get_obs_def_type_of_obs(this_obs_def)
+ if (this_obs_type < 0) then
+ identity_count = identity_count + 1
+ else
+ type_count(this_obs_type) = type_count(this_obs_type) + 1
+ endif
+! print *, 'obs type index = ', this_obs_type
+! if(this_obs_type > 0)print *, 'obs name = ', get_name_for_type_of_obs(this_obs_type)
+ if (qcindex > 0) then
+ call get_qc(obs, qcval, qcindex)
+ qc_int = nint(qcval(1))
+ qc_count(qc_int) = qc_count(qc_int) + 1
+ if (this_obs_type >= 0) &
+ qc_count_by_type(qc_int,this_obs_type) = qc_count_by_type(qc_int,this_obs_type) + 1
+ endif
+
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if (.not. is_this_last) then
+ obs = next_obs
+ else
+ call print_time(get_obs_def_time(this_obs_def), ' Last timestamp: ')
+ if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+ endif
+
+enddo ObsLoop
+
+
+write(msgstring, *) 'Number of obs processed : ', size_seq_in
+call error_handler(E_MSG, '', msgstring)
+write(msgstring, *) '---------------------------------------------------------'
+call error_handler(E_MSG, '', msgstring)
+do i = 1, max_defined_types_of_obs
+ if (type_count(i) > 0) then
+ write(msgstring, '(a32,i8,a)') trim(get_name_for_type_of_obs(i)), &
+ type_count(i), ' obs'
+ call error_handler(E_MSG, '', msgstring)
+ endif
+enddo
+if (identity_count > 0) then
+ write(msgstring, '(a32,i8,a)') 'Identity observations', &
+ identity_count, ' obs'
+ call error_handler(E_MSG, '', msgstring)
+endif
+if (qcindex > 0) then
+ call error_handler(E_MSG, '', ' ')
+ write(msgstring, *) 'DART QC results: '
+ call error_handler(E_MSG, '', msgstring)
+ do i=0, MAX_DART_QC
+ if (qc_count(i) > 0) then
+ write(msgstring, '(a16,2(i8))') 'DART QC value', i, &
+ qc_count(i)
+ call error_handler(E_MSG, '', msgstring)
+ endif
+ enddo
+ write(msgstring, *) 'Total obs: ', sum(qc_count(:))
+ call error_handler(E_MSG, '', msgstring)
+
+ if (stats_by_obs_type) then
+ do obt = 0, max_defined_types_of_obs
+ if (sum(qc_count_by_type(:,obt)) <= 0) cycle
+ this_obs_name = get_name_for_type_of_obs(obt)
+
+ call error_handler(E_MSG, '', ' ')
+ write(msgstring, *) 'DART QC results for '//trim(this_obs_name)//':'
+ call error_handler(E_MSG, '', msgstring)
+ do i=0, MAX_DART_QC
+ if (qc_count(i) > 0) then
+ write(msgstring, '(a16,2(i8))') 'DART QC value', i, &
+ qc_count_by_type(i,obt)
+ call error_handler(E_MSG, '', msgstring)
+ endif
+ enddo
+ write(msgstring, *) 'Total '//trim(this_obs_name)//' obs: ', sum(qc_count_by_type(:,obt))
+ call error_handler(E_MSG, '', msgstring)
+ enddo
+ endif
+endif
+
+! another blank line
+call error_handler(E_MSG, '', ' ')
+
+! Time to clean up
+
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+end subroutine compute_and_print_obs_seq_info
+
+
+!---------------------------------------------------------------------
+subroutine validate_obs_seq_time(seq, filename)
+
+! this eventually belongs in the obs_seq_mod code, but for now
+! try it out here. we just fixed a hole in the interactive create
+! routine which would silently let you create out-of-time-order
+! linked lists, which gave no errors but didn't assimilate the
+! right obs at the right time when running filter. this runs
+! through the times in the entire sequence, ensuring they are
+! monotonically increasing in time. this should help catch any
+! bad files which were created with older versions of code.
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq, obs_count
+integer :: key
+type(time_type) :: last_time, this_time
+
+
+! make sure there are obs left to process before going on.
+size_seq = get_num_obs(seq)
+if (size_seq == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_assim_count:validate',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq), get_num_qc(seq))
+call init_obs(next_obs, get_num_copies(seq), get_num_qc(seq))
+
+obs_count = 0
+
+!-------------------------------------------------------------
+! Start to process obs from seq
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq, obs)
+
+! we already tested for 0 obs above, so there should be a first obs here.
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first obs in sequence ' // trim(filename)
+ call error_handler(E_ERR,'obs_assim_count:validate', &
+ msgstring, source, revision, revdate)
+ return
+endif
+
+is_this_last = .false.
+last_time = set_time(0, 0)
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+
+ if (last_time > this_time) then
+ ! bad time order of observations in linked list
+ call print_time(last_time, ' previous timestamp: ')
+ if (cal) call print_date(last_time, ' calendar date: ')
+ call print_time(this_time, ' next timestamp: ')
+ if (cal) call print_date(this_time, ' calendar date: ')
+
+ key = get_obs_key(obs)
+ write(msgstring1,*)'obs number ', key, ' has earlier time than previous obs'
+ write(msgstring2,*)'observations must be in increasing time order, file ' // trim(filename)
+ call error_handler(E_ERR,'obs_assim_count:validate', msgstring2, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ endif
+
+ last_time = this_time
+ obs_count = obs_count + 1
+
+ call get_next_obs(seq, obs, next_obs, is_this_last)
+ if (.not. is_this_last) obs = next_obs
+
+enddo ObsLoop
+
+! clean up
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+! technically not a time validation, but easy to check. obs_count should never
+! be larger than size_seq - that's a fatal error. obs_count < size_seq would
+! suggest there are obs in the file that aren't part of the linked list.
+! this does not necessarily indicate a fatal error but it's not a common
+! situation and might indicate someone should check on the file.
+if (obs_count /= size_seq) then
+ write(msgstring,*) 'input sequence ', trim(filename)
+ call error_handler(E_MSG,'obs_assim_count:validate', msgstring)
+
+ write(msgstring,*) 'total obs in file: ', size_seq, ' obs in linked list: ', obs_count
+ if (obs_count > size_seq) then
+ ! this is a fatal error
+ write(msgstring1,*) 'linked list obs_count > total size_seq, should not happen'
+ call error_handler(E_ERR,'obs_assim_count:validate', msgstring, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ else
+ ! just warning msg
+ write(msgstring1,*) 'only observations in linked list will be processed'
+ call error_handler(E_MSG,'obs_assim_count:validate', msgstring, &
+ source, revision, revdate, text2=msgstring1)
+ endif
+endif
+
+end subroutine validate_obs_seq_time
+
+
+!---------------------------------------------------------------------
+subroutine print_metadata(seq, fname)
+
+!
+! print out the metadata strings, trimmed
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*) :: fname
+
+integer :: num_copies , num_qc, i
+character(len=metadatalength) :: str
+character(len=255) :: msgstring3
+
+num_copies = get_num_copies(seq)
+num_qc = get_num_qc( seq)
+
+if ( num_copies < 0 .or. num_qc < 0 ) then
+ write(msgstring3,*)' illegal copy or obs count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_assim_count', msgstring3, &
+ source, revision, revdate)
+endif
+
+MetaDataLoop : do i=1, num_copies
+ str = get_copy_meta_data(seq,i)
+
+ write(msgstring,*)'Data Metadata: ',trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo MetaDataLoop
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ write(msgstring,*)' QC Metadata: ', trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo QCMetaData
+
+end subroutine print_metadata
+
+
+!---------------------------------------------------------------------
+function get_dartqc_index(seq, fname)
+
+!
+! return the index number of the dart qc copy (-1 if none)
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*) :: fname
+integer :: get_dartqc_index
+
+integer :: num_qc, i
+character(len=metadatalength) :: str
+character(len=255) :: msgstring3
+
+num_qc = get_num_qc( seq)
+
+if ( num_qc < 0 ) then
+ write(msgstring3,*)' illegal qc metadata count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_assim_count', msgstring3, &
+ source, revision, revdate)
+endif
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ if (str == 'DART quality control') then
+ get_dartqc_index = i
+ return
+ endif
+
+enddo QCMetaData
+
+get_dartqc_index = -1
+
+end function get_dartqc_index
+
+
+!---------------------------------------------------------------------
+end program obs_assim_count
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
diff --git a/assimilation_code/programs/obs_assim_count/obs_assim_count.nml b/assimilation_code/programs/obs_assim_count/obs_assim_count.nml
new file mode 100644
index 0000000000..1137128b8b
--- /dev/null
+++ b/assimilation_code/programs/obs_assim_count/obs_assim_count.nml
@@ -0,0 +1,7 @@
+&obs_assim_count_nml
+ obs_sequence_name = 'obs_seq.final',
+ obs_sequence_list = '',
+ calendar = 'Gregorian'
+ stats_by_obs_type = .false.
+ /
+
diff --git a/assimilation_code/programs/obs_assim_count/work/input.nml b/assimilation_code/programs/obs_assim_count/work/input.nml
new file mode 100644
index 0000000000..9c4baaa00d
--- /dev/null
+++ b/assimilation_code/programs/obs_assim_count/work/input.nml
@@ -0,0 +1,63 @@
+
+&obs_assim_count_nml
+ obs_sequence_name = 'obs_seq.final',
+ obs_sequence_list = '',
+ calendar = 'Gregorian'
+ /
+
+# for low order models, use this version of preprocess.
+#&preprocess_nml
+# overwrite_output = .true.
+# input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
+# output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90'
+# input_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
+# output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90'
+# input_files = '../../../../observations/forward_operators/obs_def_1d_state_mod.f90
+
+&preprocess_nml
+ overwrite_output = .true.
+ input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
+ output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90'
+ input_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
+ output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90'
+ input_files = '../../../../observations/forward_operators/obs_def_AIRS_mod.f90',
+ '../../../../observations/forward_operators/obs_def_AOD_mod.f90',
+ '../../../../observations/forward_operators/obs_def_AURA_mod.f90',
+ '../../../../observations/forward_operators/obs_def_COSMOS_mod.f90',
+ '../../../../observations/forward_operators/obs_def_CO_Nadir_mod.f90',
+ '../../../../observations/forward_operators/obs_def_GWD_mod.f90',
+ '../../../../observations/forward_operators/obs_def_QuikSCAT_mod.f90',
+ '../../../../observations/forward_operators/obs_def_SABER_mod.f90',
+ '../../../../observations/forward_operators/obs_def_TES_nadir_mod.f90',
+ '../../../../observations/forward_operators/obs_def_altimeter_mod.f90',
+ '../../../../observations/forward_operators/obs_def_cice_mod.f90',
+ '../../../../observations/forward_operators/obs_def_cloud_mod.f90',
+ '../../../../observations/forward_operators/obs_def_cwp_mod.f90',
+ '../../../../observations/forward_operators/obs_def_dew_point_mod.f90',
+ '../../../../observations/forward_operators/obs_def_dwl_mod.f90',
+ '../../../../observations/forward_operators/obs_def_eval_mod.f90',
+ '../../../../observations/forward_operators/obs_def_gps_mod.f90',
+ '../../../../observations/forward_operators/obs_def_gts_mod.f90',
+ '../../../../observations/forward_operators/obs_def_metar_mod.f90',
+ '../../../../observations/forward_operators/obs_def_ocean_mod.f90',
+ '../../../../observations/forward_operators/obs_def_pe2lyr_mod.f90',
+ '../../../../observations/forward_operators/obs_def_radar_mod.f90',
+ '../../../../observations/forward_operators/obs_def_radiance_mod.f90',
+ '../../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90',
+ '../../../../observations/forward_operators/obs_def_rel_humidity_mod.f90',
+ '../../../../observations/forward_operators/obs_def_sqg_mod.f90',
+ '../../../../observations/forward_operators/obs_def_surface_mod.f90',
+ '../../../../observations/forward_operators/obs_def_tower_mod.f90',
+ '../../../../observations/forward_operators/obs_def_tpw_mod.f90',
+ '../../../../observations/forward_operators/obs_def_upper_atm_mod.f90',
+ '../../../../observations/forward_operators/obs_def_vortex_mod.f90',
+ '../../../../observations/forward_operators/obs_def_wind_speed_mod.f90',
+ /
+
+&utilities_nml
+ module_details = .false.
+ write_nml = 'file'
+ /
+
+&obs_sequence_nml
+ /
diff --git a/observations/obs_converters/cice/work/mkmf_seaice_fy_to_obs_netcdf b/assimilation_code/programs/obs_assim_count/work/mkmf_obs_assim_count
similarity index 66%
rename from observations/obs_converters/cice/work/mkmf_seaice_fy_to_obs_netcdf
rename to assimilation_code/programs/obs_assim_count/work/mkmf_obs_assim_count
index 56feb8008d..8f5160129d 100755
--- a/observations/obs_converters/cice/work/mkmf_seaice_fy_to_obs_netcdf
+++ b/assimilation_code/programs/obs_assim_count/work/mkmf_obs_assim_count
@@ -6,8 +6,8 @@
#
# DART $Id$
-../../../../build_templates/mkmf -p seaice_fy_to_obs_netcdf -t ../../../../build_templates/mkmf.template \
- -a "../../../.." path_names_seaice_fy_to_obs_netcdf
+../../../../build_templates/mkmf -p obs_assim_count -t ../../../../build_templates/mkmf.template \
+ -a "../../../.." path_names_obs_assim_count
exit $status
diff --git a/observations/obs_converters/cice/work/mkmf_seaice_sat_to_obs_netcdf b/assimilation_code/programs/obs_assim_count/work/mkmf_preprocess
similarity index 66%
rename from observations/obs_converters/cice/work/mkmf_seaice_sat_to_obs_netcdf
rename to assimilation_code/programs/obs_assim_count/work/mkmf_preprocess
index 9c17c595fa..ce35969343 100755
--- a/observations/obs_converters/cice/work/mkmf_seaice_sat_to_obs_netcdf
+++ b/assimilation_code/programs/obs_assim_count/work/mkmf_preprocess
@@ -6,8 +6,8 @@
#
# DART $Id$
-../../../../build_templates/mkmf -p seaice_sat_to_obs_netcdf -t ../../../../build_templates/mkmf.template \
- -a "../../../.." path_names_seaice_sat_to_obs_netcdf
+../../../../build_templates/mkmf -p preprocess -t ../../../../build_templates/mkmf.template \
+ -a "../../../.." path_names_preprocess
exit $status
diff --git a/assimilation_code/programs/obs_assim_count/work/path_names_obs_assim_count b/assimilation_code/programs/obs_assim_count/work/path_names_obs_assim_count
new file mode 100644
index 0000000000..884b72493e
--- /dev/null
+++ b/assimilation_code/programs/obs_assim_count/work/path_names_obs_assim_count
@@ -0,0 +1,28 @@
+assimilation_code/location/threed_sphere/location_mod.f90
+assimilation_code/location/utilities/default_location_mod.f90
+assimilation_code/location/utilities/location_io_mod.f90
+assimilation_code/modules/assimilation/adaptive_inflate_mod.f90
+assimilation_code/modules/assimilation/assim_model_mod.f90
+assimilation_code/modules/io/dart_time_io_mod.f90
+assimilation_code/modules/io/direct_netcdf_mod.f90
+assimilation_code/modules/io/io_filenames_mod.f90
+assimilation_code/modules/io/state_structure_mod.f90
+assimilation_code/modules/io/state_vector_io_mod.f90
+assimilation_code/modules/observations/obs_kind_mod.f90
+assimilation_code/modules/observations/obs_sequence_mod.f90
+assimilation_code/modules/utilities/distributed_state_mod.f90
+assimilation_code/modules/utilities/ensemble_manager_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/null_win_mod.f90
+assimilation_code/modules/utilities/options_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/obs_assim_count/obs_assim_count.f90
+models/template/model_mod.f90
+models/utilities/default_model_mod.f90
+observations/forward_operators/obs_def_mod.f90
+observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/assimilation_code/programs/obs_assim_count/work/path_names_preprocess b/assimilation_code/programs/obs_assim_count/work/path_names_preprocess
new file mode 100644
index 0000000000..ae8022dafe
--- /dev/null
+++ b/assimilation_code/programs/obs_assim_count/work/path_names_preprocess
@@ -0,0 +1,5 @@
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/preprocess/preprocess.f90
diff --git a/assimilation_code/programs/obs_assim_count/work/quickbuild.csh b/assimilation_code/programs/obs_assim_count/work/quickbuild.csh
new file mode 100755
index 0000000000..225bb21468
--- /dev/null
+++ b/assimilation_code/programs/obs_assim_count/work/quickbuild.csh
@@ -0,0 +1,71 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+#
+# Script to manage the compilation of all components.
+
+#----------------------------------------------------------------------
+# 'preprocess' is a program that culls the appropriate sections of the
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
+# so this MUST be run first.
+#----------------------------------------------------------------------
+
+\rm -f preprocess *.o *.mod Makefile .cppdefs
+\rm -f ../../../obs_def/obs_def_mod.f90
+\rm -f ../../../obs_kind/obs_kind_mod.f90
+
+set MODEL = "obs_assim_count"
+
+@ n = 1
+
+echo
+echo
+echo "---------------------------------------------------------------"
+echo "${MODEL} build number ${n} is preprocess"
+
+csh mkmf_preprocess
+make || exit $n
+
+./preprocess || exit 99
+
+#----------------------------------------------------------------------
+# Build all the single-threaded targets
+#----------------------------------------------------------------------
+
+foreach TARGET ( mkmf_* )
+
+ set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
+
+ switch ( $TARGET )
+ case mkmf_preprocess:
+ breaksw
+ default:
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "${MODEL} build number ${n} is ${PROG}"
+ \rm -f ${PROG}
+ csh $TARGET || exit $n
+ make || exit $n
+ breaksw
+ endsw
+end
+
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
+
+echo ""
+echo "Success: All single task DART programs compiled."
+echo ""
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/assimilation_code/programs/obs_common_subset/obs_common_subset.f90 b/assimilation_code/programs/obs_common_subset/obs_common_subset.f90
index f756c129a2..da158046c1 100644
--- a/assimilation_code/programs/obs_common_subset/obs_common_subset.f90
+++ b/assimilation_code/programs/obs_common_subset/obs_common_subset.f90
@@ -770,10 +770,10 @@ subroutine print_obs_seq(seq_in, filename)
write(msgstring,*) 'Processing sequence file ', trim(filename)
call error_handler(E_MSG,'',msgstring)
-! for an obs_seq final file which has lots of ensemble members, this
-! is really long and obscures useful data. comment it out for now.
+! for an obs_seq final file which has lots of ensemble members this
+! is really long and obscures useful data. disable it for now.
! at some point we could make a verbose option which could re-enable it.
-!call print_metadata(seq_in, filename)
+if (.false.) call print_metadata(seq_in, filename)
! Start to process obs from seq_in
diff --git a/assimilation_code/programs/obs_diag/oned/obs_diag.f90 b/assimilation_code/programs/obs_diag/oned/obs_diag.f90
index 3ec599b044..d15b09e5a1 100644
--- a/assimilation_code/programs/obs_diag/oned/obs_diag.f90
+++ b/assimilation_code/programs/obs_diag/oned/obs_diag.f90
@@ -44,8 +44,11 @@ program obs_diag
file_exist, error_handler, E_ERR, E_WARN, E_MSG, &
initialize_utilities, logfileunit, nmlfileunit, &
find_namelist_in_file, check_namelist_read, &
- nc_check, do_nml_file, do_nml_term, &
- set_filename_list, finalize_utilities
+ do_nml_file, do_nml_term, finalize_utilities, &
+ set_filename_list
+
+use netcdf_utilities_mod, only : nc_check
+
use sort_mod, only : sort
use random_seq_mod, only : random_seq_type, init_random_seq, several_random_gaussians
@@ -488,6 +491,18 @@ program obs_diag
call get_obs_def(observation, obs_def)
flavor = get_obs_def_type_of_obs(obs_def)
+
+ ! Check to see if it is an identity observation.
+ ! Redefine identity observations as flavor = RAW_STATE_VARIABLE
+ !> Still have a problem determining what state type best relates
+ !> to the observation kind - but it would allow us to
+ !> do this for all models, regardless of dimensionality.
+
+ if ( flavor < 0 ) then
+ Nidentity = Nidentity + 1
+ flavor = RAW_STATE_VARIABLE
+ endif
+
obsname = get_name_for_type_of_obs(flavor)
obs_time = get_obs_def_time(obs_def)
obs_loc = get_obs_def_location(obs_def)
@@ -503,30 +518,27 @@ program obs_diag
trusted = .false.
endif
- ! Check to see if it is an identity observation.
- ! Redefine identity observations as flavor = RAW_STATE_VARIABLE
- !> Still have a problem determining what state type best relates
- !> to the observation kind - but it would allow us to
- !> do this for all models, regardless of dimensionality.
-
- if ( flavor < 0 ) then
- Nidentity = Nidentity + 1
- flavor = RAW_STATE_VARIABLE
- endif
-
if ( use_zero_error_obs ) then
obs_error_variance = 0.0_r8
else
obs_error_variance = get_obs_def_error_variance(obs_def)
endif
-
! retrieve observation prior and posterior means and spreads
- call get_obs_values(observation, obs, obs_index)
- call get_obs_values(observation, prior_mean, prior_mean_index)
- call get_obs_values(observation, posterior_mean, posterior_mean_index)
- call get_obs_values(observation, prior_spread, prior_spread_index)
- call get_obs_values(observation, posterior_spread, posterior_spread_index)
+ prior_mean(1) = 0.0_r8
+ posterior_mean(1) = 0.0_r8
+ prior_spread(1) = 0.0_r8
+ posterior_spread(1) = 0.0_r8
+
+ call get_obs_values(observation, obs, obs_index)
+ if (prior_mean_index > 0) &
+ call get_obs_values(observation, prior_mean, prior_mean_index)
+ if (posterior_mean_index > 0) &
+ call get_obs_values(observation, posterior_mean, posterior_mean_index)
+ if (prior_spread_index > 0) &
+ call get_obs_values(observation, prior_spread, prior_spread_index)
+ if (posterior_spread_index > 0) &
+ call get_obs_values(observation, posterior_spread, posterior_spread_index)
pr_mean = prior_mean(1)
po_mean = posterior_mean(1)
@@ -1392,13 +1404,21 @@ subroutine SetIndices()
org_qc_index, trim(get_qc_meta_data(seq,org_qc_index))
call error_handler(E_MSG,'SetIndices',string1)
- if ( dart_qc_index > 0 ) then
+ if (dart_qc_index > 0 ) then
write(string1,'(''DART quality control index '',i2,'' metadata '',a)') &
dart_qc_index, trim(get_qc_meta_data(seq,dart_qc_index))
call error_handler(E_MSG,'SetIndices',string1)
endif
endif
+if ( any( (/ prior_mean_index, prior_spread_index, &
+ posterior_mean_index, posterior_spread_index /) < 0) ) then
+ string1 = 'Observation sequence has no prior/posterior information.'
+ string2 = 'You will still get a count, maybe observation value, incoming qc, ...'
+ string3 = 'For simple information, you may want to use "obs_seq_to_netcdf" instead.'
+ call error_handler(E_MSG, 'SetIndices', string1, text2=string2, text3=string3)
+endif
+
end subroutine SetIndices
diff --git a/assimilation_code/programs/obs_diag/threed_cartesian/obs_diag.f90 b/assimilation_code/programs/obs_diag/threed_cartesian/obs_diag.f90
index 161c0a7bb7..a385e44cb6 100644
--- a/assimilation_code/programs/obs_diag/threed_cartesian/obs_diag.f90
+++ b/assimilation_code/programs/obs_diag/threed_cartesian/obs_diag.f90
@@ -46,8 +46,9 @@ program obs_diag
file_exist, error_handler, E_ERR, E_WARN, E_MSG, &
initialize_utilities, logfileunit, nmlfileunit, &
find_namelist_in_file, check_namelist_read, &
- nc_check, do_nml_file, do_nml_term, &
+ do_nml_file, do_nml_term, &
set_filename_list, finalize_utilities
+use netcdf_utilities_mod, only : nc_check
use sort_mod, only : sort
use random_seq_mod, only : random_seq_type, init_random_seq, several_random_gaussians
diff --git a/assimilation_code/programs/obs_diag/threed_sphere/obs_diag.f90 b/assimilation_code/programs/obs_diag/threed_sphere/obs_diag.f90
index 6b6ca79ae4..26e5b087be 100644
--- a/assimilation_code/programs/obs_diag/threed_sphere/obs_diag.f90
+++ b/assimilation_code/programs/obs_diag/threed_sphere/obs_diag.f90
@@ -32,7 +32,8 @@ program obs_diag
get_last_obs, destroy_obs, get_num_qc, get_qc_meta_data
use obs_def_mod, only : obs_def_type, get_obs_def_error_variance, get_obs_def_time, &
get_obs_def_location, get_obs_def_type_of_obs
-use obs_kind_mod, only : max_defined_types_of_obs, get_quantity_for_type_of_obs, get_name_for_type_of_obs, &
+use obs_kind_mod, only : max_defined_types_of_obs, get_quantity_for_type_of_obs, &
+ get_name_for_type_of_obs, &
QTY_U_WIND_COMPONENT, QTY_V_WIND_COMPONENT
use location_mod, only : location_type, get_location, set_location_missing, &
write_location, operator(/=), is_location_in_region, &
@@ -49,8 +50,9 @@ program obs_diag
file_exist, error_handler, E_ERR, E_WARN, E_MSG, &
initialize_utilities, logfileunit, nmlfileunit, &
find_namelist_in_file, check_namelist_read, &
- nc_check, do_nml_file, do_nml_term, &
- set_filename_list, finalize_utilities
+ do_nml_file, do_nml_term, finalize_utilities, &
+ set_filename_list
+use netcdf_utilities_mod, only : nc_check
use sort_mod, only : sort
use random_seq_mod, only : random_seq_type, init_random_seq, several_random_gaussians
@@ -125,6 +127,7 @@ program obs_diag
integer, allocatable, dimension(:) :: ens_copy_index
logical :: out_of_range, keeper
+logical :: has_posteriors = .true.
!---------------------------------------------------------------------
! variables associated with quality control
@@ -171,7 +174,7 @@ program obs_diag
integer, parameter, dimension(2) :: good_poste_qcs = (/ 0, 1 /)
integer :: numqcvals
-integer, parameter :: max_num_input_files = 100
+integer, parameter :: max_num_input_files = 10000
!>@todo remove after verifying NbiqQC, NbadIZ not used in plotting scripts
real(r8):: rat_cri = 5000.0_r8 ! QC ratio
@@ -179,7 +182,7 @@ program obs_diag
!-----------------------------------------------------------------------
! Namelist with default values
-!
+
character(len=256) :: obs_sequence_name(max_num_input_files) = ''
character(len=256) :: obs_sequence_list = ''
integer, dimension(6) :: first_bin_center = (/ 2003, 1, 1, 0, 0, 0 /)
@@ -371,7 +374,6 @@ program obs_diag
num_input_files = set_filename_list(obs_sequence_name, obs_sequence_list, 'obs_diag')
-
! Check to see if we are including the outlier observations in the
! rank histogram calculation.
@@ -394,7 +396,8 @@ program obs_diag
call SetScaleFactors() ! for plotting purposes
Nlevels = maxval((/ Nplevels, Nhlevels, Nmlevels /))
-call InitializeVariables( Nepochs, Nlevels, Nregions, num_obs_types)
+
+call InitializeALLVariables( Nepochs, Nlevels, Nregions, num_obs_types)
U_obs_loc = set_location_missing()
@@ -511,6 +514,23 @@ program obs_diag
prior_spread_index, posterior_spread_index, &
ens_copy_index )
+ if ( any( (/ prior_mean_index, prior_spread_index/) < 0) ) then
+ string1 = 'Observation sequence has no prior information.'
+ string2 = 'You will still get a count, maybe observation value, incoming qc, ...'
+ string3 = 'For simple information, you may want to use "obs_seq_to_netcdf" instead.'
+ call error_handler(E_MSG, 'obs_diag', string1, &
+ source, revision, revdate, text2=string2, text3=string3)
+ endif
+
+ has_posteriors = .true.
+ if ( any( (/ posterior_mean_index, posterior_spread_index /) < 0) ) then
+ has_posteriors = .false.
+ string1 = 'Observation sequence has no posterior information,'
+ string2 = 'therefore - posterior diagnostics are not possible.'
+ call error_handler(E_WARN, 'obs_diag', string1, &
+ source, revision, revdate, text2=string2)
+ endif
+
! Loop over all potential time periods ... the observation sequence
! files are not required to be in any particular order.
@@ -611,6 +631,8 @@ program obs_diag
posterior_mean(1) = 0.0_r8
prior_spread(1) = 0.0_r8
posterior_spread(1) = 0.0_r8
+ pr_zscore = 0.0_r8
+ po_zscore = 0.0_r8
call get_obs_values(observation, obs, obs_index)
if (prior_mean_index > 0) &
@@ -722,6 +744,9 @@ program obs_diag
po_zscore = InnovZscore(obs(1), po_mean, po_sprd, obs_error_variance, &
qc_value, QC_MAX_POSTERIOR)
+ if (has_posteriors) po_zscore = InnovZscore(obs(1), po_mean, po_sprd, &
+ obs_error_variance, qc_value, QC_MAX_POSTERIOR)
+
indx = min(int(pr_zscore), MaxSigmaBins)
nsigma(indx) = nsigma(indx) + 1
@@ -787,8 +812,10 @@ program obs_diag
if ((level_index < 1) .or. (level_index > Nlevels)) then
prior%NbadLV(iepoch,:,iregion,flavor) = &
prior%NbadLV(iepoch,:,iregion,flavor) + 1
- poste%NbadLV(iepoch,:,iregion,flavor) = &
- poste%NbadLV(iepoch,:,iregion,flavor) + 1
+ if (has_posteriors) then
+ poste%NbadLV(iepoch,:,iregion,flavor) = &
+ poste%NbadLV(iepoch,:,iregion,flavor) + 1
+ endif
cycle Areas
endif
@@ -797,8 +824,9 @@ program obs_diag
if ( org_qc_index > 0 ) then
if (qc(org_qc_index) > input_qc_threshold ) then
- call IPE(prior%NbigQC(iepoch,level_index,iregion,flavor), 1)
- call IPE(poste%NbigQC(iepoch,level_index,iregion,flavor), 1)
+ call IPE(prior%NbigQC(iepoch,level_index,iregion,flavor), 1)
+ if (has_posteriors) &
+ call IPE(poste%NbigQC(iepoch,level_index,iregion,flavor), 1)
endif
endif
@@ -814,7 +842,7 @@ program obs_diag
call IPE(prior%NbadIZ(iepoch,level_index,iregion,flavor), 1)
endif
- if( po_zscore > rat_cri ) then
+ if(po_zscore > rat_cri .and. has_posteriors) then
call IPE(poste%NbadIZ(iepoch,level_index,iregion,flavor), 1)
endif
@@ -826,7 +854,8 @@ program obs_diag
! Additional work for horizontal wind (given U,V)
- ObsIsWindCheck: if ( get_quantity_for_type_of_obs(flavor) == QTY_V_WIND_COMPONENT ) then
+ ObsIsWindCheck: if ( get_quantity_for_type_of_obs(flavor) == &
+ QTY_V_WIND_COMPONENT ) then
! The big assumption is that the U wind component has
! immediately preceeded the V component and has been saved.
@@ -839,7 +868,8 @@ program obs_diag
if ( ierr /= 0 ) then
call IPE(prior%NbadUV(iepoch, level_index, iregion, flavor), 1)
- call IPE(poste%NbadUV(iepoch, level_index, iregion, flavor), 1)
+ if (has_posteriors) &
+ call IPE(poste%NbadUV(iepoch, level_index, iregion, flavor), 1)
else
! The next big assumption is that the 'horizontal wind' flavors
@@ -855,13 +885,13 @@ program obs_diag
zscoreU = InnovZscore(U_obs, U_pr_mean, U_pr_sprd, U_obs_err_var, &
U_qc, QC_MAX_PRIOR)
- if( (pr_zscore > rat_cri) .or. (zscoreU > rat_cri) ) then
+ if(pr_zscore > rat_cri .or. zscoreU > rat_cri) then
call IPE(prior%NbadIZ(iepoch,level_index,iregion,wflavor), 1)
endif
zscoreU = InnovZscore(U_obs, U_po_mean, U_po_sprd, U_obs_err_var, &
U_qc, QC_MAX_POSTERIOR)
- if( (po_zscore > rat_cri) .or. (zscoreU > rat_cri) ) then
+ if((po_zscore > rat_cri .or. zscoreU > rat_cri) .and. has_posteriors) then
call IPE(poste%NbadIZ(iepoch,level_index,iregion,wflavor), 1)
endif
@@ -891,8 +921,9 @@ program obs_diag
if ( org_qc_index > 0 ) then
if (qc(org_qc_index) > input_qc_threshold ) then
- call IPE(priorAVG%NbigQC(level_index,iregion,flavor), 1)
- call IPE(posteAVG%NbigQC(level_index,iregion,flavor), 1)
+ call IPE(priorAVG%NbigQC(level_index,iregion,flavor), 1)
+ if (has_posteriors) &
+ call IPE(posteAVG%NbigQC(level_index,iregion,flavor), 1)
endif
endif
@@ -907,7 +938,7 @@ program obs_diag
call IPE(priorAVG%NbadIZ(level_index,iregion,flavor), 1)
endif
- if(po_zscore > rat_cri ) then
+ if(po_zscore > rat_cri .and. has_posteriors) then
call IPE(posteAVG%NbadIZ(level_index,iregion,flavor), 1)
endif
@@ -922,7 +953,8 @@ program obs_diag
if ( ierr /= 0 ) then
call IPE(priorAVG%NbadUV(level_index, iregion, flavor), 1)
- call IPE(posteAVG%NbadUV(level_index, iregion, flavor), 1)
+ if (has_posteriors) &
+ call IPE(posteAVG%NbadUV(level_index, iregion, flavor), 1)
else
ierr = ParseLevel(obs_loc, obslevel, wflavor)
@@ -935,7 +967,7 @@ program obs_diag
zscoreU = InnovZscore(U_obs, U_po_mean, U_po_sprd, U_obs_err_var, &
U_qc, QC_MAX_POSTERIOR)
- if( (po_zscore > rat_cri) .or. (zscoreU > rat_cri) ) then
+ if((po_zscore > rat_cri .or. zscoreU > rat_cri) .and. has_posteriors) then
call IPE(posteAVG%NbadIZ(level_index,iregion,wflavor), 1)
endif
@@ -943,7 +975,7 @@ program obs_diag
iregion, wflavor, priorAVG, posteAVG, uqc=U_qc)
call Bin3D(qc_value, level_index, iregion, &
- wflavor, .false., obs(1), obs_error_variance, pr_mean, pr_sprd, &
+ wflavor, .false., obs(1), obs_error_variance, pr_mean, pr_sprd, &
po_mean, po_sprd, U_obs, U_obs_err_var, U_pr_mean, U_pr_sprd, &
U_po_mean, U_po_sprd, U_qc)
endif
@@ -1011,7 +1043,7 @@ program obs_diag
write(*,*) '# bad Level : ',sum(prior%NbadLV(:,1,:,:))
write(*,*) '# big (original) QC : ',sum(prior%NbigQC)
write(*,*) '# bad DART QC prior : ',sum(prior%NbadDartQC)
-write(*,*) '# bad DART QC post : ',sum(poste%NbadDartQC)
+if (has_posteriors) write(*,*) '# bad DART QC post : ',sum(poste%NbadDartQC)
write(*,*) '# priorQC 7 postQC 4 : ',num_ambiguous
write(*,*)
write(*,*) '# trusted prior : ',sum(prior%Ntrusted)
@@ -1025,17 +1057,20 @@ program obs_diag
write(*,*) '# prior DART QC 7 : ',sum(prior%NDartQC_7)
write(*,*) '# prior DART QC 8 : ',sum(prior%NDartQC_8)
write(*,*)
-write(*,*) '# trusted poste : ',sum(poste%Ntrusted)
-write(*,*) '# poste DART QC 0 : ',sum(poste%NDartQC_0)
-write(*,*) '# poste DART QC 1 : ',sum(poste%NDartQC_1)
-write(*,*) '# poste DART QC 2 : ',sum(poste%NDartQC_2)
-write(*,*) '# poste DART QC 3 : ',sum(poste%NDartQC_3)
-write(*,*) '# poste DART QC 4 : ',sum(poste%NDartQC_4)
-write(*,*) '# poste DART QC 5 : ',sum(poste%NDartQC_5)
-write(*,*) '# poste DART QC 6 : ',sum(poste%NDartQC_6)
-write(*,*) '# poste DART QC 7 : ',sum(poste%NDartQC_7)
-write(*,*) '# poste DART QC 8 : ',sum(poste%NDartQC_8)
-write(*,*)
+
+if (has_posteriors) then
+ write(*,*) '# trusted poste : ',sum(poste%Ntrusted)
+ write(*,*) '# poste DART QC 0 : ',sum(poste%NDartQC_0)
+ write(*,*) '# poste DART QC 1 : ',sum(poste%NDartQC_1)
+ write(*,*) '# poste DART QC 2 : ',sum(poste%NDartQC_2)
+ write(*,*) '# poste DART QC 3 : ',sum(poste%NDartQC_3)
+ write(*,*) '# poste DART QC 4 : ',sum(poste%NDartQC_4)
+ write(*,*) '# poste DART QC 5 : ',sum(poste%NDartQC_5)
+ write(*,*) '# poste DART QC 6 : ',sum(poste%NDartQC_6)
+ write(*,*) '# poste DART QC 7 : ',sum(poste%NDartQC_7)
+ write(*,*) '# poste DART QC 8 : ',sum(poste%NDartQC_8)
+ write(*,*)
+endif
write(logfileunit,*)
write(logfileunit,*) '# observations used : ',sum(obs_used_in_epoch)
@@ -1046,7 +1081,7 @@ program obs_diag
write(logfileunit,*) '# bad Level : ',sum(prior%NbadLV(:,1,:,:))
write(logfileunit,*) '# big (original) QC : ',sum(prior%NbigQC)
write(logfileunit,*) '# bad DART QC prior : ',sum(prior%NbadDartQC)
-write(logfileunit,*) '# bad DART QC post : ',sum(poste%NbadDartQC)
+if (has_posteriors) write(logfileunit,*) '# bad DART QC post : ',sum(poste%NbadDartQC)
write(logfileunit,*) '# priorQC 7 postQC 4 : ',num_ambiguous
write(logfileunit,*)
write(logfileunit,*) '# trusted prior : ',sum(prior%Ntrusted)
@@ -1060,17 +1095,20 @@ program obs_diag
write(logfileunit,*) '# prior DART QC 7 : ',sum(prior%NDartQC_7)
write(logfileunit,*) '# prior DART QC 8 : ',sum(prior%NDartQC_8)
write(logfileunit,*)
-write(logfileunit,*) '# trusted poste : ',sum(poste%Ntrusted)
-write(logfileunit,*) '# poste DART QC 0 : ',sum(poste%NDartQC_0)
-write(logfileunit,*) '# poste DART QC 1 : ',sum(poste%NDartQC_1)
-write(logfileunit,*) '# poste DART QC 2 : ',sum(poste%NDartQC_2)
-write(logfileunit,*) '# poste DART QC 3 : ',sum(poste%NDartQC_3)
-write(logfileunit,*) '# poste DART QC 4 : ',sum(poste%NDartQC_4)
-write(logfileunit,*) '# poste DART QC 5 : ',sum(poste%NDartQC_5)
-write(logfileunit,*) '# poste DART QC 6 : ',sum(poste%NDartQC_6)
-write(logfileunit,*) '# poste DART QC 7 : ',sum(poste%NDartQC_7)
-write(logfileunit,*) '# poste DART QC 8 : ',sum(poste%NDartQC_8)
-write(logfileunit,*)
+
+if (has_posteriors) then
+ write(logfileunit,*) '# trusted poste : ',sum(poste%Ntrusted)
+ write(logfileunit,*) '# poste DART QC 0 : ',sum(poste%NDartQC_0)
+ write(logfileunit,*) '# poste DART QC 1 : ',sum(poste%NDartQC_1)
+ write(logfileunit,*) '# poste DART QC 2 : ',sum(poste%NDartQC_2)
+ write(logfileunit,*) '# poste DART QC 3 : ',sum(poste%NDartQC_3)
+ write(logfileunit,*) '# poste DART QC 4 : ',sum(poste%NDartQC_4)
+ write(logfileunit,*) '# poste DART QC 5 : ',sum(poste%NDartQC_5)
+ write(logfileunit,*) '# poste DART QC 6 : ',sum(poste%NDartQC_6)
+ write(logfileunit,*) '# poste DART QC 7 : ',sum(poste%NDartQC_7)
+ write(logfileunit,*) '# poste DART QC 8 : ',sum(poste%NDartQC_8)
+ write(logfileunit,*)
+endif
if (Nidentity > 0) then
write(*,*)'There were identity observations in this observation sequence file.'
@@ -1109,305 +1147,18 @@ program obs_diag
call finalize_utilities()
-CONTAINS
-
!======================================================================
-! These routines use common variables from the scope of this file.
-! If it's not in the argument list ... it's scoped within this file.
-!======================================================================
-
-
-subroutine InitializeVariables( ntimes, nlevs, nareas, ntypes )
-
-! Global variables set in this routine:
-! type(TLRV_type), intent(out) :: poste, prior
-! type( LRV_type), intent(out) :: posteAVG, priorAVG
-
-integer, intent(in) :: ntimes
-integer, intent(in) :: nlevs
-integer, intent(in) :: nareas
-integer, intent(in) :: ntypes
-
-allocate(prior%rmse( ntimes, nlevs, nareas, ntypes), &
- prior%bias( ntimes, nlevs, nareas, ntypes), &
- prior%spread( ntimes, nlevs, nareas, ntypes), &
- prior%totspread( ntimes, nlevs, nareas, ntypes), &
- prior%observation(ntimes, nlevs, nareas, ntypes), &
- prior%ens_mean( ntimes, nlevs, nareas, ntypes), &
- prior%Nposs( ntimes, nlevs, nareas, ntypes), &
- prior%Nused( ntimes, nlevs, nareas, ntypes), &
- prior%NbigQC( ntimes, nlevs, nareas, ntypes), &
- prior%NbadIZ( ntimes, nlevs, nareas, ntypes), &
- prior%NbadUV( ntimes, nlevs, nareas, ntypes), &
- prior%NbadLV( ntimes, nlevs, nareas, ntypes), &
- prior%NbadDartQC( ntimes, nlevs, nareas, ntypes), &
- prior%Ntrusted( ntimes, nlevs, nareas, ntypes), &
- prior%NDartQC_0( ntimes, nlevs, nareas, ntypes), &
- prior%NDartQC_1( ntimes, nlevs, nareas, ntypes), &
- prior%NDartQC_2( ntimes, nlevs, nareas, ntypes), &
- prior%NDartQC_3( ntimes, nlevs, nareas, ntypes), &
- prior%NDartQC_4( ntimes, nlevs, nareas, ntypes), &
- prior%NDartQC_5( ntimes, nlevs, nareas, ntypes), &
- prior%NDartQC_6( ntimes, nlevs, nareas, ntypes), &
- prior%NDartQC_7( ntimes, nlevs, nareas, ntypes), &
- prior%NDartQC_8( ntimes, nlevs, nareas, ntypes))
-
-prior%rmse = 0.0_r8
-prior%bias = 0.0_r8
-prior%spread = 0.0_r8
-prior%totspread = 0.0_r8
-prior%observation = 0.0_r8
-prior%ens_mean = 0.0_r8
-prior%Nposs = 0
-prior%Nused = 0
-prior%NbigQC = 0
-prior%NbadIZ = 0
-prior%NbadUV = 0
-prior%NbadLV = 0
-prior%NbadDartQC = 0
-prior%Ntrusted = 0
-prior%NDartQC_0 = 0
-prior%NDartQC_1 = 0
-prior%NDartQC_2 = 0
-prior%NDartQC_3 = 0
-prior%NDartQC_4 = 0
-prior%NDartQC_5 = 0
-prior%NDartQC_6 = 0
-prior%NDartQC_7 = 0
-prior%NDartQC_8 = 0
-
-prior%string = 'guess'
-prior%num_times = ntimes
-prior%num_levels = nlevs
-prior%num_regions = nareas
-prior%num_variables = ntypes
-
-allocate(poste%rmse( ntimes, nlevs, nareas, ntypes), &
- poste%bias( ntimes, nlevs, nareas, ntypes), &
- poste%spread( ntimes, nlevs, nareas, ntypes), &
- poste%totspread( ntimes, nlevs, nareas, ntypes), &
- poste%observation(ntimes, nlevs, nareas, ntypes), &
- poste%ens_mean( ntimes, nlevs, nareas, ntypes), &
- poste%Nposs( ntimes, nlevs, nareas, ntypes), &
- poste%Nused( ntimes, nlevs, nareas, ntypes), &
- poste%NbigQC( ntimes, nlevs, nareas, ntypes), &
- poste%NbadIZ( ntimes, nlevs, nareas, ntypes), &
- poste%NbadUV( ntimes, nlevs, nareas, ntypes), &
- poste%NbadLV( ntimes, nlevs, nareas, ntypes), &
- poste%NbadDartQC( ntimes, nlevs, nareas, ntypes), &
- poste%Ntrusted( ntimes, nlevs, nareas, ntypes), &
- poste%NDartQC_0( ntimes, nlevs, nareas, ntypes), &
- poste%NDartQC_1( ntimes, nlevs, nareas, ntypes), &
- poste%NDartQC_2( ntimes, nlevs, nareas, ntypes), &
- poste%NDartQC_3( ntimes, nlevs, nareas, ntypes), &
- poste%NDartQC_4( ntimes, nlevs, nareas, ntypes), &
- poste%NDartQC_5( ntimes, nlevs, nareas, ntypes), &
- poste%NDartQC_6( ntimes, nlevs, nareas, ntypes), &
- poste%NDartQC_7( ntimes, nlevs, nareas, ntypes), &
- poste%NDartQC_8( ntimes, nlevs, nareas, ntypes))
-
-poste%rmse = 0.0_r8
-poste%bias = 0.0_r8
-poste%spread = 0.0_r8
-poste%totspread = 0.0_r8
-poste%observation = 0.0_r8
-poste%ens_mean = 0.0_r8
-poste%Nposs = 0
-poste%Nused = 0
-poste%NbigQC = 0
-poste%NbadIZ = 0
-poste%NbadUV = 0
-poste%NbadLV = 0
-poste%NbadDartQC = 0
-poste%Ntrusted = 0
-poste%NDartQC_0 = 0
-poste%NDartQC_1 = 0
-poste%NDartQC_2 = 0
-poste%NDartQC_3 = 0
-poste%NDartQC_4 = 0
-poste%NDartQC_5 = 0
-poste%NDartQC_6 = 0
-poste%NDartQC_7 = 0
-poste%NDartQC_8 = 0
-
-poste%string = 'analy'
-poste%num_times = ntimes
-poste%num_levels = nlevs
-poste%num_regions = nareas
-poste%num_variables = ntypes
-
-allocate(priorAVG%rmse( nlevs, nareas, ntypes), &
- priorAVG%bias( nlevs, nareas, ntypes), &
- priorAVG%spread( nlevs, nareas, ntypes), &
- priorAVG%totspread( nlevs, nareas, ntypes), &
- priorAVG%observation(nlevs, nareas, ntypes), &
- priorAVG%ens_mean( nlevs, nareas, ntypes), &
- priorAVG%Nposs( nlevs, nareas, ntypes), &
- priorAVG%Nused( nlevs, nareas, ntypes), &
- priorAVG%NbigQC( nlevs, nareas, ntypes), &
- priorAVG%NbadIZ( nlevs, nareas, ntypes), &
- priorAVG%NbadUV( nlevs, nareas, ntypes), &
- priorAVG%NbadLV( nlevs, nareas, ntypes), &
- priorAVG%NbadDartQC( nlevs, nareas, ntypes), &
- priorAVG%Ntrusted( nlevs, nareas, ntypes), &
- priorAVG%NDartQC_0( nlevs, nareas, ntypes), &
- priorAVG%NDartQC_1( nlevs, nareas, ntypes), &
- priorAVG%NDartQC_2( nlevs, nareas, ntypes), &
- priorAVG%NDartQC_3( nlevs, nareas, ntypes), &
- priorAVG%NDartQC_4( nlevs, nareas, ntypes), &
- priorAVG%NDartQC_5( nlevs, nareas, ntypes), &
- priorAVG%NDartQC_6( nlevs, nareas, ntypes), &
- priorAVG%NDartQC_7( nlevs, nareas, ntypes), &
- priorAVG%NDartQC_8( nlevs, nareas, ntypes))
-
-priorAVG%rmse = 0.0_r8
-priorAVG%bias = 0.0_r8
-priorAVG%spread = 0.0_r8
-priorAVG%totspread = 0.0_r8
-priorAVG%observation = 0.0_r8
-priorAVG%ens_mean = 0.0_r8
-priorAVG%Nposs = 0
-priorAVG%Nused = 0
-priorAVG%NbigQC = 0
-priorAVG%NbadIZ = 0
-priorAVG%NbadUV = 0
-priorAVG%NbadLV = 0
-priorAVG%NbadDartQC = 0
-priorAVG%Ntrusted = 0
-priorAVG%NDartQC_0 = 0
-priorAVG%NDartQC_1 = 0
-priorAVG%NDartQC_2 = 0
-priorAVG%NDartQC_3 = 0
-priorAVG%NDartQC_4 = 0
-priorAVG%NDartQC_5 = 0
-priorAVG%NDartQC_6 = 0
-priorAVG%NDartQC_7 = 0
-priorAVG%NDartQC_8 = 0
-
-priorAVG%string = 'VPguess'
-priorAVG%num_levels = nlevs
-priorAVG%num_regions = nareas
-priorAVG%num_variables = ntypes
-
-allocate(posteAVG%rmse( nlevs, nareas, ntypes), &
- posteAVG%bias( nlevs, nareas, ntypes), &
- posteAVG%spread( nlevs, nareas, ntypes), &
- posteAVG%totspread( nlevs, nareas, ntypes), &
- posteAVG%observation(nlevs, nareas, ntypes), &
- posteAVG%ens_mean( nlevs, nareas, ntypes), &
- posteAVG%Nposs( nlevs, nareas, ntypes), &
- posteAVG%Nused( nlevs, nareas, ntypes), &
- posteAVG%NbigQC( nlevs, nareas, ntypes), &
- posteAVG%NbadIZ( nlevs, nareas, ntypes), &
- posteAVG%NbadUV( nlevs, nareas, ntypes), &
- posteAVG%NbadLV( nlevs, nareas, ntypes), &
- posteAVG%NbadDartQC( nlevs, nareas, ntypes), &
- posteAVG%Ntrusted( nlevs, nareas, ntypes), &
- posteAVG%NDartQC_0( nlevs, nareas, ntypes), &
- posteAVG%NDartQC_1( nlevs, nareas, ntypes), &
- posteAVG%NDartQC_2( nlevs, nareas, ntypes), &
- posteAVG%NDartQC_3( nlevs, nareas, ntypes), &
- posteAVG%NDartQC_4( nlevs, nareas, ntypes), &
- posteAVG%NDartQC_5( nlevs, nareas, ntypes), &
- posteAVG%NDartQC_6( nlevs, nareas, ntypes), &
- posteAVG%NDartQC_7( nlevs, nareas, ntypes), &
- posteAVG%NDartQC_8( nlevs, nareas, ntypes))
-
-posteAVG%rmse = 0.0_r8
-posteAVG%bias = 0.0_r8
-posteAVG%spread = 0.0_r8
-posteAVG%totspread = 0.0_r8
-posteAVG%observation = 0.0_r8
-posteAVG%ens_mean = 0.0_r8
-posteAVG%Nposs = 0
-posteAVG%Nused = 0
-posteAVG%NbigQC = 0
-posteAVG%NbadIZ = 0
-posteAVG%NbadUV = 0
-posteAVG%NbadLV = 0
-posteAVG%NbadDartQC = 0
-posteAVG%Ntrusted = 0
-posteAVG%NDartQC_0 = 0
-posteAVG%NDartQC_1 = 0
-posteAVG%NDartQC_2 = 0
-posteAVG%NDartQC_3 = 0
-posteAVG%NDartQC_4 = 0
-posteAVG%NDartQC_5 = 0
-posteAVG%NDartQC_6 = 0
-posteAVG%NDartQC_7 = 0
-posteAVG%NDartQC_8 = 0
-
-posteAVG%string = 'VPanaly'
-posteAVG%num_levels = nlevs
-posteAVG%num_regions = nareas
-posteAVG%num_variables = ntypes
-
-end subroutine InitializeVariables
-
-
+CONTAINS
!======================================================================
-subroutine DestroyVariables()
-
-if (associated(prior%hist_bin)) deallocate(prior%hist_bin)
-if (allocated(ens_copy_index)) deallocate(ens_copy_index)
-
-deallocate(prior%rmse, prior%bias, prior%spread, prior%totspread, &
- prior%observation, prior%ens_mean, prior%Nposs, prior%Nused, &
- prior%NbigQC, prior%NbadIZ, prior%NbadUV, prior%NbadLV, &
- prior%NbadDartQC, prior%Ntrusted)
-
-deallocate(prior%NDartQC_0, prior%NDartQC_1, prior%NDartQC_2, prior%NDartQC_3, &
- prior%NDartQC_4, prior%NDartQC_5, prior%NDartQC_6, prior%NDartQC_7, &
- prior%NDartQC_8)
-
-deallocate(poste%rmse, poste%bias, poste%spread, poste%totspread, &
- poste%observation, poste%ens_mean, poste%Nposs, poste%Nused, &
- poste%NbigQC, poste%NbadIZ, poste%NbadUV, poste%NbadLV, &
- poste%NbadDartQC, poste%Ntrusted)
-
-deallocate(poste%NDartQC_0, poste%NDartQC_1, poste%NDartQC_2, poste%NDartQC_3, &
- poste%NDartQC_4, poste%NDartQC_5, poste%NDartQC_6, poste%NDartQC_7, &
- poste%NDartQC_8)
-
-deallocate(priorAVG%rmse, priorAVG%bias, priorAVG%spread, &
- priorAVG%totspread, priorAVG%observation, priorAVG%ens_mean, &
- priorAVG%Nposs, priorAVG%Nused, priorAVG%NbigQC, &
- priorAVG%NbadIZ, priorAVG%NbadUV, priorAVG%NbadLV, &
- priorAVG%NbadDartQC, priorAVG%Ntrusted)
-
-deallocate(priorAVG%NDartQC_0, priorAVG%NDartQC_1, priorAVG%NDartQC_2, &
- priorAVG%NDartQC_3, priorAVG%NDartQC_4, priorAVG%NDartQC_5, &
- priorAVG%NDartQC_6, priorAVG%NDartQC_7, priorAVG%NDartQC_8)
-
-deallocate(posteAVG%rmse, posteAVG%bias, posteAVG%spread, &
- posteAVG%totspread, posteAVG%observation, posteAVG%ens_mean, &
- posteAVG%Nposs, posteAVG%Nused, posteAVG%NbigQC, &
- posteAVG%NbadIZ, posteAVG%NbadUV, posteAVG%NbadLV, &
- posteAVG%NbadDartQC, posteAVG%Ntrusted)
-
-deallocate(posteAVG%NDartQC_0, posteAVG%NDartQC_1, posteAVG%NDartQC_2, &
- posteAVG%NDartQC_3, posteAVG%NDartQC_4, posteAVG%NDartQC_5, &
- posteAVG%NDartQC_6, posteAVG%NDartQC_7, posteAVG%NDartQC_8)
-
-deallocate(epoch_center, epoch_edges, bin_center, obs_used_in_epoch)
-
-deallocate(obs_type_strings, which_vert, scale_factor)
-
-end subroutine DestroyVariables
-
-
-!======================================================================
-
+!----------------------------------------------------------------------
+!> Define/Append the 'horizontal wind' obs_kinds to supplant the list declared
+!> in obs_kind_mod.f90 i.e. if there is a RADIOSONDE_U_WIND_COMPONENT
+!> and a RADIOSONDE_V_WIND_COMPONENT, there must be a RADIOSONDE_HORIZONTAL_WIND
+!> Replace calls to 'get_name_for_type_of_obs' with variable 'obs_type_strings'
function grok_observation_names(my_names)
-!----------------------------------------------------------------------
-! Define/Append the 'horizontal wind' obs_kinds to supplant the list declared
-! in obs_kind_mod.f90 i.e. if there is a RADIOSONDE_U_WIND_COMPONENT
-! and a RADIOSONDE_V_WIND_COMPONENT, there must be a RADIOSONDE_HORIZONTAL_WIND
-! Replace calls to 'get_name_for_type_of_obs' with variable 'obs_type_strings'
-!----------------------------------------------------------------------
character(len=stringlength), pointer :: my_names(:) ! INTENT OUT, btw
integer :: grok_observation_names
@@ -2128,6 +1879,188 @@ end subroutine SetScaleFactors
!======================================================================
+
+subroutine InitializeALLVariables( ntimes, nlevs, nareas, ntypes )
+
+! Global variables set in this routine:
+! type(TLRV_type), intent(out) :: poste, prior
+! type( LRV_type), intent(out) :: posteAVG, priorAVG
+
+integer, intent(in) :: ntimes
+integer, intent(in) :: nlevs
+integer, intent(in) :: nareas
+integer, intent(in) :: ntypes
+
+call AllocateOneTLRVVariable( prior, ntimes, nlevs, nareas, ntypes )
+call ResetOneTLRVVariable( prior, ntimes, nlevs, nareas, ntypes, 'guess')
+
+call AllocateOneTLRVVariable( poste, ntimes, nlevs, nareas, ntypes )
+call ResetOneTLRVVariable( poste, ntimes, nlevs, nareas, ntypes, 'analy')
+
+call AllocateOneLRVVariable( priorAVG, nlevs, nareas, ntypes )
+call ResetOneLRVVariable( priorAVG, nlevs, nareas, ntypes, 'VPguess')
+
+call AllocateOneLRVVariable( posteAVG, nlevs, nareas, ntypes )
+call ResetOneLRVVariable( posteAVG, nlevs, nareas, ntypes, 'VPanaly')
+
+end subroutine InitializeALLVariables
+
+!======================================================================
+
+subroutine AllocateOneTLRVVariable( thisvar, ntimes, nlevs, nareas, ntypes )
+
+type(TLRV_type), intent(inout) :: thisvar
+integer, intent(in) :: ntimes
+integer, intent(in) :: nlevs
+integer, intent(in) :: nareas
+integer, intent(in) :: ntypes
+
+allocate(thisvar%rmse( ntimes, nlevs, nareas, ntypes), &
+ thisvar%bias( ntimes, nlevs, nareas, ntypes), &
+ thisvar%spread( ntimes, nlevs, nareas, ntypes), &
+ thisvar%totspread( ntimes, nlevs, nareas, ntypes), &
+ thisvar%observation(ntimes, nlevs, nareas, ntypes), &
+ thisvar%ens_mean( ntimes, nlevs, nareas, ntypes), &
+ thisvar%Nposs( ntimes, nlevs, nareas, ntypes), &
+ thisvar%Nused( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NbigQC( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NbadIZ( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NbadUV( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NbadLV( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NbadDartQC( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NDartQC_0( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NDartQC_1( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NDartQC_2( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NDartQC_3( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NDartQC_4( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NDartQC_5( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NDartQC_6( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NDartQC_7( ntimes, nlevs, nareas, ntypes), &
+ thisvar%NDartQC_8( ntimes, nlevs, nareas, ntypes), &
+ thisvar%Ntrusted( ntimes, nlevs, nareas, ntypes) )
+
+end subroutine AllocateOneTLRVVariable
+
+!======================================================================
+
+subroutine ResetOneTLRVVariable(thisvar, ntimes, nlevs, nareas, ntypes, label)
+
+type(TLRV_type), intent(inout) :: thisvar
+integer, intent(in) :: ntimes
+integer, intent(in) :: nlevs
+integer, intent(in) :: nareas
+integer, intent(in) :: ntypes
+character(len=*), intent(in) :: label
+
+thisvar%rmse = 0.0_r8
+thisvar%bias = 0.0_r8
+thisvar%spread = 0.0_r8
+thisvar%totspread = 0.0_r8
+thisvar%observation = 0.0_r8
+thisvar%ens_mean = 0.0_r8
+thisvar%Nposs = 0
+thisvar%Nused = 0
+thisvar%NbigQC = 0
+thisvar%NbadIZ = 0
+thisvar%NbadUV = 0
+thisvar%NbadLV = 0
+thisvar%NbadDartQC = 0
+thisvar%NDartQC_0 = 0
+thisvar%NDartQC_1 = 0
+thisvar%NDartQC_2 = 0
+thisvar%NDartQC_3 = 0
+thisvar%NDartQC_4 = 0
+thisvar%NDartQC_5 = 0
+thisvar%NDartQC_6 = 0
+thisvar%NDartQC_7 = 0
+thisvar%NDartQC_8 = 0
+thisvar%Ntrusted = 0
+
+thisvar%string = label
+thisvar%num_times = ntimes
+thisvar%num_levels = nlevs
+thisvar%num_regions = nareas
+thisvar%num_variables = ntypes
+
+end subroutine ResetOneTLRVVariable
+
+!======================================================================
+
+subroutine AllocateOneLRVVariable( thisvar, nlevs, nareas, ntypes )
+
+type(LRV_type), intent(inout) :: thisvar
+integer, intent(in) :: nlevs
+integer, intent(in) :: nareas
+integer, intent(in) :: ntypes
+
+allocate(thisvar%rmse( nlevs, nareas, ntypes), &
+ thisvar%bias( nlevs, nareas, ntypes), &
+ thisvar%spread( nlevs, nareas, ntypes), &
+ thisvar%totspread( nlevs, nareas, ntypes), &
+ thisvar%observation(nlevs, nareas, ntypes), &
+ thisvar%ens_mean( nlevs, nareas, ntypes), &
+ thisvar%Nposs( nlevs, nareas, ntypes), &
+ thisvar%Nused( nlevs, nareas, ntypes), &
+ thisvar%NbigQC( nlevs, nareas, ntypes), &
+ thisvar%NbadIZ( nlevs, nareas, ntypes), &
+ thisvar%NbadUV( nlevs, nareas, ntypes), &
+ thisvar%NbadLV( nlevs, nareas, ntypes), &
+ thisvar%NbadDartQC( nlevs, nareas, ntypes), &
+ thisvar%NDartQC_0( nlevs, nareas, ntypes), &
+ thisvar%NDartQC_1( nlevs, nareas, ntypes), &
+ thisvar%NDartQC_2( nlevs, nareas, ntypes), &
+ thisvar%NDartQC_3( nlevs, nareas, ntypes), &
+ thisvar%NDartQC_4( nlevs, nareas, ntypes), &
+ thisvar%NDartQC_5( nlevs, nareas, ntypes), &
+ thisvar%NDartQC_6( nlevs, nareas, ntypes), &
+ thisvar%NDartQC_7( nlevs, nareas, ntypes), &
+ thisvar%NDartQC_8( nlevs, nareas, ntypes), &
+ thisvar%Ntrusted( nlevs, nareas, ntypes) )
+
+end subroutine AllocateOneLRVVariable
+
+!======================================================================
+
+subroutine ResetOneLRVVariable(thisvar, nlevs, nareas, ntypes, label)
+
+type(LRV_type), intent(inout) :: thisvar
+integer, intent(in) :: nlevs
+integer, intent(in) :: nareas
+integer, intent(in) :: ntypes
+character(len=*), intent(in) :: label
+
+thisvar%rmse = 0.0_r8
+thisvar%bias = 0.0_r8
+thisvar%spread = 0.0_r8
+thisvar%totspread = 0.0_r8
+thisvar%observation = 0.0_r8
+thisvar%ens_mean = 0.0_r8
+thisvar%Nposs = 0
+thisvar%Nused = 0
+thisvar%NbigQC = 0
+thisvar%NbadIZ = 0
+thisvar%NbadUV = 0
+thisvar%NbadLV = 0
+thisvar%NbadDartQC = 0
+thisvar%NDartQC_0 = 0
+thisvar%NDartQC_1 = 0
+thisvar%NDartQC_2 = 0
+thisvar%NDartQC_3 = 0
+thisvar%NDartQC_4 = 0
+thisvar%NDartQC_5 = 0
+thisvar%NDartQC_6 = 0
+thisvar%NDartQC_7 = 0
+thisvar%NDartQC_8 = 0
+thisvar%Ntrusted = 0
+
+thisvar%string = label
+thisvar%num_levels = nlevs
+thisvar%num_regions = nareas
+thisvar%num_variables = ntypes
+
+end subroutine ResetOneLRVVariable
+
+!----------------------------------------------------------------------
!> We need to know the time of the first and last observations in the sequence,
!> primarily just to see if they intersect the desired Epoch window.
!> We also record these times so we can report the first/last times of all
@@ -2150,14 +2083,14 @@ subroutine GetFirstLastObs(my_fname, my_sequence, my_obs1, my_obsN, &
logical, SAVE :: first_time = .true.
if ( .not. get_first_obs(my_sequence, my_obs1) ) then
- call error_handler(E_ERR,'obs_diag','No first observation in '//trim(my_fname), &
+ call error_handler(E_ERR,'GetFirstLastObs','No first observation in '//trim(my_fname), &
source,revision,revdate)
endif
call get_obs_def(my_obs1, obs_def)
my_seqT1 = get_obs_def_time(obs_def)
if ( .not. get_last_obs(my_sequence, my_obsN) ) then
- call error_handler(E_ERR,'obs_diag','No last observation in '//trim(my_fname), &
+ call error_handler(E_ERR,'GetFirstLastObs','No last observation in '//trim(my_fname), &
source,revision,revdate)
endif
call get_obs_def(my_obsN, obs_def)
@@ -2425,14 +2358,6 @@ subroutine SetIndices( obs_index, org_qc_index, dart_qc_index, &
call error_handler(E_MSG,'SetIndices',string1)
endif
-if ( any( (/ prior_mean_index, prior_spread_index, &
- posterior_mean_index, posterior_spread_index /) < 0) ) then
- string1 = 'Observation sequence has no prior/posterior information.'
- string2 = 'You will still get a count, maybe observation value, incoming qc, ...'
- string3 = 'For simple information, you may want to use "obs_seq_to_netcdf" instead.'
- call error_handler(E_MSG, 'obs_diag', string1, text2=string2, text3=string3)
-endif
-
end subroutine SetIndices
@@ -2877,36 +2802,43 @@ subroutine CountDartQC_4D(inqc, iepoch, ilevel, iregion, itype, prior, poste, &
if ( myqc == 0 ) then
call IPE(prior%NDartQC_0(iepoch,ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_0(iepoch,ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_0(iepoch,ilevel,iregion,itype), 1)
elseif ( myqc == 1 ) then
call IPE(prior%NDartQC_1(iepoch,ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_1(iepoch,ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_1(iepoch,ilevel,iregion,itype), 1)
elseif ( myqc == 2 ) then
call IPE(prior%NDartQC_2(iepoch,ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_2(iepoch,ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_2(iepoch,ilevel,iregion,itype), 1)
elseif ( myqc == 3 ) then
call IPE(prior%NDartQC_3(iepoch,ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_3(iepoch,ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_3(iepoch,ilevel,iregion,itype), 1)
elseif ( myqc == 4 ) then
call IPE(prior%NDartQC_4(iepoch,ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_4(iepoch,ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_4(iepoch,ilevel,iregion,itype), 1)
elseif ( myqc == 5 ) then
call IPE(prior%NDartQC_5(iepoch,ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_5(iepoch,ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_5(iepoch,ilevel,iregion,itype), 1)
elseif ( myqc == 6 ) then
call IPE(prior%NDartQC_6(iepoch,ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_6(iepoch,ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_6(iepoch,ilevel,iregion,itype), 1)
elseif ( myqc == 7 ) then
call IPE(prior%NDartQC_7(iepoch,ilevel,iregion,itype), 1)
- if (present(posterior_mean)) then
+ if (present(posterior_mean) .and. has_posteriors) then
if ( abs(posterior_mean - MISSING_R8) < 1.0_r8 ) then
! ACTUALLY A FAILED FORWARD OPERATOR - ambiguous case
call IPE(poste%NDartQC_4(iepoch,ilevel,iregion,itype), 1)
@@ -2917,7 +2849,8 @@ subroutine CountDartQC_4D(inqc, iepoch, ilevel, iregion, itype, prior, poste, &
elseif ( myqc == 8 ) then
call IPE(prior%NDartQC_8(iepoch,ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_8(iepoch,ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_8(iepoch,ilevel,iregion,itype), 1)
endif
@@ -2948,36 +2881,43 @@ subroutine CountDartQC_3D(inqc, ilevel, iregion, itype, prior, poste, posterior_
if ( myqc == 0 ) then
call IPE(prior%NDartQC_0(ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_0(ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_0(ilevel,iregion,itype), 1)
elseif ( myqc == 1 ) then
call IPE(prior%NDartQC_1(ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_1(ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_1(ilevel,iregion,itype), 1)
elseif ( myqc == 2 ) then
call IPE(prior%NDartQC_2(ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_2(ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_2(ilevel,iregion,itype), 1)
elseif ( myqc == 3 ) then
call IPE(prior%NDartQC_3(ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_3(ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_3(ilevel,iregion,itype), 1)
elseif ( myqc == 4 ) then
call IPE(prior%NDartQC_4(ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_4(ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_4(ilevel,iregion,itype), 1)
elseif ( myqc == 5 ) then
call IPE(prior%NDartQC_5(ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_5(ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_5(ilevel,iregion,itype), 1)
elseif ( myqc == 6 ) then
call IPE(prior%NDartQC_6(ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_6(ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_6(ilevel,iregion,itype), 1)
elseif ( myqc == 7 ) then
call IPE(prior%NDartQC_7(ilevel,iregion,itype), 1)
- if (present(posterior_mean)) then
+ if (present(posterior_mean) .and. has_posteriors) then
if ( abs(posterior_mean - MISSING_R8) < 1.0_r8 ) then
! ACTUALLY A FAILED FORWARD OPERATOR - ambiguous case
call IPE(poste%NDartQC_4(ilevel,iregion,itype), 1)
@@ -2988,7 +2928,8 @@ subroutine CountDartQC_3D(inqc, ilevel, iregion, itype, prior, poste, posterior_
elseif ( myqc == 8 ) then
call IPE(prior%NDartQC_8(ilevel,iregion,itype), 1)
- call IPE(poste%NDartQC_8(ilevel,iregion,itype), 1)
+ if (has_posteriors) &
+ call IPE(poste%NDartQC_8(ilevel,iregion,itype), 1)
endif
@@ -3128,7 +3069,8 @@ subroutine Bin4D(iqc, iepoch, ilevel, iregion, flavor, trusted, &
!----------------------------------------------------------------------
call IPE(prior%Nposs(iepoch,ilevel,iregion,flavor), 1)
-call IPE(poste%Nposs(iepoch,ilevel,iregion,flavor), 1)
+if (has_posteriors) &
+ call IPE(poste%Nposs(iepoch,ilevel,iregion,flavor), 1)
!----------------------------------------------------------------------
! Select which set of qcs are valid and accrue everything
@@ -3136,7 +3078,8 @@ subroutine Bin4D(iqc, iepoch, ilevel, iregion, flavor, trusted, &
if ( trusted ) then
call IPE(prior%Ntrusted(iepoch,ilevel,iregion,flavor), 1)
- call IPE(poste%Ntrusted(iepoch,ilevel,iregion,flavor), 1)
+ if (has_posteriors) &
+ call IPE(poste%Ntrusted(iepoch,ilevel,iregion,flavor), 1)
endif
! Accrue the PRIOR quantities
@@ -3154,17 +3097,19 @@ subroutine Bin4D(iqc, iepoch, ilevel, iregion, flavor, trusted, &
endif
! Accrue the POSTERIOR quantities
-if (( trusted .and. any(trusted_poste_qcs == posterior_qc)) .or. &
- (.not. trusted .and. any( good_poste_qcs == posterior_qc))) then
- call IPE(poste%Nused( iepoch,ilevel,iregion,flavor), 1 )
- call RPE(poste%observation(iepoch,ilevel,iregion,flavor), obsmean )
- call RPE(poste%ens_mean( iepoch,ilevel,iregion,flavor), postmean )
- call RPE(poste%bias( iepoch,ilevel,iregion,flavor), postbias )
- call RPE(poste%rmse( iepoch,ilevel,iregion,flavor), postsqerr)
- call RPE(poste%spread( iepoch,ilevel,iregion,flavor), posterior_variance)
- call RPE(poste%totspread( iepoch,ilevel,iregion,flavor), posterior_varianceplus)
-else
- call IPE(poste%NbadDartQC(iepoch,ilevel,iregion,flavor), 1 )
+if (has_posteriors) then
+ if (( trusted .and. any(trusted_poste_qcs == posterior_qc)) .or. &
+ (.not. trusted .and. any( good_poste_qcs == posterior_qc))) then
+ call IPE(poste%Nused( iepoch,ilevel,iregion,flavor), 1 )
+ call RPE(poste%observation(iepoch,ilevel,iregion,flavor), obsmean )
+ call RPE(poste%ens_mean( iepoch,ilevel,iregion,flavor), postmean )
+ call RPE(poste%bias( iepoch,ilevel,iregion,flavor), postbias )
+ call RPE(poste%rmse( iepoch,ilevel,iregion,flavor), postsqerr)
+ call RPE(poste%spread( iepoch,ilevel,iregion,flavor), posterior_variance)
+ call RPE(poste%totspread( iepoch,ilevel,iregion,flavor), posterior_varianceplus)
+ else
+ call IPE(poste%NbadDartQC(iepoch,ilevel,iregion,flavor), 1 )
+ endif
endif
end subroutine Bin4D
@@ -3273,7 +3218,8 @@ subroutine Bin3D(iqc, ilevel, iregion, flavor, trusted, &
!----------------------------------------------------------------------
call IPE(priorAVG%Nposs(ilevel,iregion,flavor), 1)
-call IPE(posteAVG%Nposs(ilevel,iregion,flavor), 1)
+if (has_posteriors) &
+ call IPE(posteAVG%Nposs(ilevel,iregion,flavor), 1)
!----------------------------------------------------------------------
! Select which set of qcs are valid and accrue everything
@@ -3281,7 +3227,8 @@ subroutine Bin3D(iqc, ilevel, iregion, flavor, trusted, &
if ( trusted ) then
call IPE(priorAVG%Ntrusted(ilevel,iregion,flavor), 1)
- call IPE(posteAVG%Ntrusted(ilevel,iregion,flavor), 1)
+ if (has_posteriors) &
+ call IPE(posteAVG%Ntrusted(ilevel,iregion,flavor), 1)
endif
! Accrue the PRIOR quantities
@@ -3299,17 +3246,19 @@ subroutine Bin3D(iqc, ilevel, iregion, flavor, trusted, &
endif
! Accrue the POSTERIOR quantities
-if (( trusted .and. any(trusted_poste_qcs == posterior_qc)) .or. &
- (.not. trusted .and. any( good_poste_qcs == posterior_qc))) then
- call IPE(posteAVG%Nused( ilevel,iregion,flavor), 1 )
- call RPE(posteAVG%observation(ilevel,iregion,flavor), obsmean )
- call RPE(posteAVG%ens_mean( ilevel,iregion,flavor), postmean )
- call RPE(posteAVG%bias( ilevel,iregion,flavor), postbias )
- call RPE(posteAVG%rmse( ilevel,iregion,flavor), postsqerr)
- call RPE(posteAVG%spread( ilevel,iregion,flavor), posterior_variance)
- call RPE(posteAVG%totspread( ilevel,iregion,flavor), posterior_varianceplus)
-else
- call IPE(posteAVG%NbadDartQC(ilevel,iregion,flavor), 1 )
+if (has_posteriors) then
+ if (( trusted .and. any(trusted_poste_qcs == posterior_qc)) .or. &
+ (.not. trusted .and. any( good_poste_qcs == posterior_qc))) then
+ call IPE(posteAVG%Nused( ilevel,iregion,flavor), 1 )
+ call RPE(posteAVG%observation(ilevel,iregion,flavor), obsmean )
+ call RPE(posteAVG%ens_mean( ilevel,iregion,flavor), postmean )
+ call RPE(posteAVG%bias( ilevel,iregion,flavor), postbias )
+ call RPE(posteAVG%rmse( ilevel,iregion,flavor), postsqerr)
+ call RPE(posteAVG%spread( ilevel,iregion,flavor), posterior_variance)
+ call RPE(posteAVG%totspread( ilevel,iregion,flavor), posterior_varianceplus)
+ else
+ call IPE(posteAVG%NbadDartQC(ilevel,iregion,flavor), 1 )
+ endif
endif
end subroutine Bin3D
@@ -3528,9 +3477,10 @@ end subroutine Normalize3Dvars
subroutine WriteNetCDF(fname)
+
character(len=*), intent(in) :: fname
-integer :: ncid, i, nobs, typesdimlen
+integer :: ncid, i, nobs, typesdimlen, io
integer :: RegionDimID, RegionVarID
integer :: MlevelDimID, MlevelVarID
integer :: PlevelDimID, PlevelVarID
@@ -3657,15 +3607,14 @@ subroutine WriteNetCDF(fname)
FILEloop : do i = 1, num_input_files
- write(string1,'(''obs_seq_file_'',i3.3)')i
- call nc_check(nf90_put_att(ncid, NF90_GLOBAL, &
- trim(string1), trim(obs_sequence_name(i)) ), &
- 'WriteNetCDF', 'region_names:obs_kinds')
+ write(string1,'(''obs_seq_file_'',i5.5)')i
+ io = nf90_put_att(ncid, NF90_GLOBAL, trim(string1), trim(obs_sequence_name(i)))
+ call nc_check(io, 'WriteNetCDF', 'put_att input file names')
enddo FILEloop
-call nc_check(nf90_put_att(ncid, NF90_GLOBAL, 'NumIdentityObs', Nidentity ), &
- 'WriteNetCDF', 'put_att identity '//trim(fname))
+io = nf90_put_att(ncid, NF90_GLOBAL, 'NumIdentityObs', Nidentity)
+call nc_check(io, 'WriteNetCDF', 'put_att identity '//trim(fname))
!----------------------------------------------------------------------------
! Write all observation types that are used. Requires counting how many
@@ -3687,7 +3636,7 @@ subroutine WriteNetCDF(fname)
typesdimlen = 0
do ivar = 1,max_defined_types_of_obs
- nobs = sum(poste%Nposs(:,:,:,ivar))
+ nobs = sum(prior%Nposs(:,:,:,ivar))
if ( verbose ) then
write(string1,'(i4,1x,(a32),1x,i8,1x,'' obs@vert '',i3,f11.3)') ivar, &
@@ -4059,17 +4008,18 @@ subroutine WriteNetCDF(fname)
!----------------------------------------------------------------------------
! write the data we took such pains to collate ...
+! The priors always have values. It is possible that there are no posteriors.
!----------------------------------------------------------------------------
if ( create_rank_histogram ) then
- ierr = WriteTLRV(ncid, prior, TimeDimID, CopyDimID, RegionDimID, RankDimID)
+ call WriteTLRV(ncid, prior, TimeDimID, CopyDimID, RegionDimID, RankDimID)
else
- ierr = WriteTLRV(ncid, prior, TimeDimID, CopyDimID, RegionDimID)
+ call WriteTLRV(ncid, prior, TimeDimID, CopyDimID, RegionDimID)
endif
+call WriteTLRV(ncid, poste, TimeDimID, CopyDimID, RegionDimID)
-ierr = WriteTLRV(ncid, poste, TimeDimID, CopyDimID, RegionDimID)
-ierr = WriteLRV( ncid, priorAVG, CopyDimID, RegionDimID)
-ierr = WriteLRV( ncid, posteAVG, CopyDimID, RegionDimID)
+call WriteLRV( ncid, priorAVG, CopyDimID, RegionDimID)
+call WriteLRV( ncid, posteAVG, CopyDimID, RegionDimID)
!----------------------------------------------------------------------------
! finish ...
@@ -4084,6 +4034,59 @@ end subroutine WriteNetCDF
!======================================================================
+subroutine DestroyVariables()
+
+if (associated(prior%hist_bin)) deallocate(prior%hist_bin)
+if (allocated(ens_copy_index)) deallocate(ens_copy_index)
+
+deallocate(prior%rmse, prior%bias, prior%spread, prior%totspread, &
+ prior%observation, prior%ens_mean, prior%Nposs, prior%Nused, &
+ prior%NbigQC, prior%NbadIZ, prior%NbadUV, prior%NbadLV, &
+ prior%NbadDartQC, prior%Ntrusted)
+
+deallocate(prior%NDartQC_0, prior%NDartQC_1, prior%NDartQC_2, prior%NDartQC_3, &
+ prior%NDartQC_4, prior%NDartQC_5, prior%NDartQC_6, prior%NDartQC_7, &
+ prior%NDartQC_8)
+
+deallocate(poste%rmse, poste%bias, poste%spread, poste%totspread, &
+ poste%observation, poste%ens_mean, poste%Nposs, poste%Nused, &
+ poste%NbigQC, poste%NbadIZ, poste%NbadUV, poste%NbadLV, &
+ poste%NbadDartQC, poste%Ntrusted)
+
+deallocate(poste%NDartQC_0, poste%NDartQC_1, poste%NDartQC_2, poste%NDartQC_3, &
+ poste%NDartQC_4, poste%NDartQC_5, poste%NDartQC_6, poste%NDartQC_7, &
+ poste%NDartQC_8)
+
+deallocate(priorAVG%rmse, priorAVG%bias, priorAVG%spread, &
+ priorAVG%totspread, priorAVG%observation, priorAVG%ens_mean, &
+ priorAVG%Nposs, priorAVG%Nused, priorAVG%NbigQC, &
+ priorAVG%NbadIZ, priorAVG%NbadUV, priorAVG%NbadLV, &
+ priorAVG%NbadDartQC, priorAVG%Ntrusted)
+
+deallocate(priorAVG%NDartQC_0, priorAVG%NDartQC_1, priorAVG%NDartQC_2, &
+ priorAVG%NDartQC_3, priorAVG%NDartQC_4, priorAVG%NDartQC_5, &
+ priorAVG%NDartQC_6, priorAVG%NDartQC_7, priorAVG%NDartQC_8)
+
+deallocate(posteAVG%rmse, posteAVG%bias, posteAVG%spread, &
+ posteAVG%totspread, posteAVG%observation, posteAVG%ens_mean, &
+ posteAVG%Nposs, posteAVG%Nused, posteAVG%NbigQC, &
+ posteAVG%NbadIZ, posteAVG%NbadUV, posteAVG%NbadLV, &
+ posteAVG%NbadDartQC, posteAVG%Ntrusted)
+
+deallocate(posteAVG%NDartQC_0, posteAVG%NDartQC_1, posteAVG%NDartQC_2, &
+ posteAVG%NDartQC_3, posteAVG%NDartQC_4, posteAVG%NDartQC_5, &
+ posteAVG%NDartQC_6, posteAVG%NDartQC_7, posteAVG%NDartQC_8)
+
+deallocate(epoch_center, epoch_edges, bin_center, obs_used_in_epoch)
+
+deallocate(obs_type_strings, which_vert, scale_factor)
+
+end subroutine DestroyVariables
+
+
+!======================================================================
+
+
function Rlevels2edges(level_middle, level_edge)
! determine layer edges ... ascending vs. descending complications
! pressures should be descending.
@@ -4317,12 +4320,11 @@ end subroutine IPE
!======================================================================
-function WriteTLRV(ncid, vrbl, TimeDimID, CopyDimID, RegionDimID, RankDimID)
+subroutine WriteTLRV(ncid, vrbl, TimeDimID, CopyDimID, RegionDimID, RankDimID)
integer, intent(in) :: ncid
type(TLRV_type), intent(in) :: vrbl
integer, intent(in) :: TimeDimID, CopyDimID, RegionDimID
integer, optional, intent(in) :: RankDimID
-integer :: WriteTLRV
integer :: nobs, Nlevels, ivar, itime, ilevel, iregion
integer :: Nbins, irank, ndata
@@ -4481,19 +4483,16 @@ function WriteTLRV(ncid, vrbl, TimeDimID, CopyDimID, RegionDimID, RankDimID)
enddo FILL
-WriteTLRV = 0
-
-end function WriteTLRV
+end subroutine WriteTLRV
!======================================================================
-function WriteLRV(ncid, vrbl, CopyDimID, RegionDimID)
+subroutine WriteLRV(ncid, vrbl, CopyDimID, RegionDimID)
integer, intent(in) :: ncid
type(LRV_type), intent(in) :: vrbl
integer, intent(in) :: CopyDimID, RegionDimID
-integer :: WriteLRV
integer :: nobs, Nlevels, ivar, ilevel, iregion
character(len=NF90_MAX_NAME) :: string1, string2
@@ -4600,9 +4599,7 @@ function WriteLRV(ncid, vrbl, CopyDimID, RegionDimID)
enddo FILL
-WriteLRV = 0
-
-end function WriteLRV
+end subroutine WriteLRV
!======================================================================
diff --git a/assimilation_code/programs/obs_impact_tool/obs_impact_tool.f90 b/assimilation_code/programs/obs_impact_tool/obs_impact_tool.f90
index 9113a03dc9..05713b4998 100644
--- a/assimilation_code/programs/obs_impact_tool/obs_impact_tool.f90
+++ b/assimilation_code/programs/obs_impact_tool/obs_impact_tool.f90
@@ -4,36 +4,47 @@
!
! $Id$
-!> This program assists in constructing a table which can be read
-!> by filter at run-time to disable or alter how the assimilation
-!> of different types of observations impact the state vector values
-!> based on their kind. This tool allows users to group related
-!> collections of observation types and state vector kinds by name
-!> and then express the relationship of the named groups to each
-!> other in a concise way.
+!> The standard DART algorithms compute increments for an observation and then
+!> compute corresponding increments for each model state variable due to that
+!> observation. To do this, DART computes a sample regression coefficient using
+!> the prior ensemble distributions of a state variable and the observation. The
+!> increments for each member of the observation are multiplied by this
+!> regression coefficient and then added to the corresponding prior ensemble
+!> member for the state variable. However, in many cases, it is appropriate to
+!> reduce the impact of an observation on a state variable; this is called
+!> localization. The standard DART algorithms allow users to specify a
+!> localization that is a function of the horizontal (and optionally vertical)
+!> distance between the observation and the state variable. The localization is
+!> a value between 0 and 1 and multiplies the regression coefficient when
+!> updating state ensemble members.
!>
-!> At run time, filter can read the output file from this tool
-!> and use it to control the impact at assimilation time based
-!> on the relationships specified.
+!> Sometimes, it may be desirable to do an additional localization that is a
+!> function of the type of observation and the state vector quantity. This
+!> program allows users to construct a table that is read by filter at run-time
+!> to localize the impact of sets of observation types on sets of state
+!> vectorquantities. Users can create named sets of observation types and sets
+!> of state vector quantities and specify a localization for the impact of the
+!> specified observation types on the state vector quantities.
!>
-!> The first version of this tool requires the last numeric
-!> column to be 0.0, but future extensions may allow different
-!> values to be used.
-!>
-!> All the listed observation types and state vector kinds
+!> An example would be to create a subset of observations of tracer
+!> concentration for a variety of tracers, and a subset of dynamic state
+!> variable quantities like temperatures and wind components. It has been common
+!> to set this localization value to 0 so that tracer observations have no
+!> impact on dynamic state quantities, however, the tool allows values between 0
+!> and 1 to be specified.
+!>
+!> All the listed observation types and state vector quantities
!> must be known by the system. If they are not, look at the
!> &preprocess_nml :: input_items namelist which specifies
!> which obs_def_xxx_mod.f90 files are included, which is
-!> where observation types are defined. kinds are defined
-!> in the obs_kinds/DEFAULT_obs_kinds_mod.F90 file and
-!> are static. (note you must add new kinds in 2 places
+!> where observation types are defined. Quantities are defined
+!> in the assimilation_code/modules/observations/DEFAULT_obs_kinds_mod.F90 file.
+!> (Note you must add new quantities in 2 places
!> if you do alter this file.)
!>
-! program to read an ascii file with directions for which state and observation
-! KINDS should impact which other state and observation KINDS.
! the format of the ascii input file is:
!
@@ -49,57 +60,38 @@
! END GROUP
!
! GROUP groupnameM
-! ALL EXCEPT QTY_xxx QTY_xxx
-! QTY_xxx
+! ALL EXCEPT QTY_xxx QTY_xxx
+! QTY_xxx
! END GROUP
-! # to choose all kinds except a select few
!
-! # FIXME: this is not supported yet - should it be? yes.
+! # to choose all quantities except a select few
! GROUP groupnameN
-! ALL EXCEPT groupnameY
+! ALL EXCEPT groupnameY
! END GROUP
!
-! also ALLTYPES, ALLKINDS, as well as ALL
+! also ALLTYPES, ALLQTYS, as well as ALL
!
! IMPACT
-! QTY_xxx QTY_xxx 0.0
-! QTY_xxx groupname1 0.0
-! groupname1 QTY_xxx 0.0
-! groupname1 groupname1 0.0
+! QTY_xxx QTY_xxx 0.0
+! QTY_xxx groupname1 0.0
+! groupname1 QTY_xxx 0.0
+! groupname1 groupname2 0.0
! END IMPACT
-! # this also is not supported yet, should it be?
! GROUP groupnameX
-! # not only kinds, but other groups, recursively?
-! different_groupname # but what about loops? even possible?
+! different_groupname # no circular dependencies allowed
! END GROUP
-! alternative output is triplets of 'kind1 kind2 value'
-! which gets put into the 2d array at run time? is that better?
-
-! maybe prototype the application of these values inside assim_tools
-! first before deciding what the output should be. inside the
-! filter run i think it should be a 2d array for speed, but is that
-! the most flexible for input to filter?
-
-! or finally, the input to this tool could be the ascii text file,
-! and the 2d table could be computed and filled in the initialization
-! code (if not too slow) and there is no separate tool needed?
-
-! i started to add types, but they can only appear in column 1 of the
-! triplet line. rethink this.
-
! the output of this tool is a ascii file containing lines:
-! KIND1_string KIND2_string 0.0
+! QTY1_string QTY2_string 0.0
!
-! the 2d table building will now be done at run time in assim_tools
-! use would be if (impact_table(kind1, kind2) > 0.0) then ok else
-! change the increments. this could be done in assim_tools in a generic way.
program obs_impact_tool
use types_mod, only : r8
-use utilities_mod, only : register_module, initialize_utilities, finalize_utilities
+use utilities_mod, only : register_module, initialize_utilities, finalize_utilities, &
+ find_namelist_in_file, check_namelist_read, E_MSG, &
+ do_nml_file, do_nml_term, nmlfileunit, error_handler
use obs_impact_mod, only : create_impact_table
! version controlled file description for error handling, do not edit
@@ -109,16 +101,37 @@ program obs_impact_tool
character(len=128), parameter :: revdate = "$Date$"
character(len=128), parameter :: id = "$Id$"
+integer :: funit, ios
+
+! namelist: input/output names, values, etc
+character(len=512) :: input_filename = ''
+character(len=512) :: output_filename = ''
+logical :: debug = .false. ! .true. for more output
+
+! namelist
+namelist /obs_impact_tool_nml/ &
+ input_filename, &
+ output_filename, &
+ debug
-real(r8), allocatable :: table(:,:)
! initialization and setup
call initialize_utilities('obs_impact_tool')
call register_module(source,revision,revdate)
+call find_namelist_in_file("input.nml", "obs_impact_tool_nml", funit)
+read(funit, nml = obs_impact_tool_nml, iostat = ios)
+call check_namelist_read(funit, ios, "obs_impact_tool_nml")
+
+if (do_nml_file()) write(nmlfileunit, nml=obs_impact_tool_nml)
+if (do_nml_term()) write( * , nml=obs_impact_tool_nml)
+
+if (debug) call error_handler(E_MSG, 'obs_impact_tool', ' debug on')
+
+
! build and output impact_table
-call create_impact_table()
+call create_impact_table(input_filename, output_filename, debug)
! clean up
call finalize_utilities('obs_impact_tool')
diff --git a/assimilation_code/programs/obs_impact_tool/obs_impact_tool.html b/assimilation_code/programs/obs_impact_tool/obs_impact_tool.html
index 014539278e..5039e9bd87 100644
--- a/assimilation_code/programs/obs_impact_tool/obs_impact_tool.html
+++ b/assimilation_code/programs/obs_impact_tool/obs_impact_tool.html
@@ -38,40 +38,54 @@
PROGRAM obs_impact_tool
Overview
-Utility program which assists in constructing a table that is read
-by filter at run time to alter how the assimilation
-of different types of observations impact the state vector values
-based on their quantity, and other observations based on their
-observation type or quantity. This tool allows users to group related
-collections of observation types and state vector quantities by name
-and then express the relationship of the named groups to each
-other in a concise way.
+The standard DART algorithms compute increments for an observation and then
+compute corresponding increments for each model state variable due to that
+observation. To do this, DART computes a sample regression coefficient using
+the prior ensemble distributions of a state variable and the observation. The
+increments for each member of the observation are multiplied by this
+regression coefficient and then added to the corresponding prior ensemble
+member for the state variable. However, in many cases, it is appropriate to
+reduce the impact of an observation on a state variable; this is called
+localization. The standard DART algorithms allow users to specify a
+localization that is a function of the horizontal (and optionally vertical)
+distance between the observation and the state variable. The localization is
+a value between 0 and 1 and multiplies the regression coefficient when
+updating state ensemble members.
-At run time filter reads the output file from this tool
-and uses it to control the impact at assimilation time based
-on the relationships specified.
+Sometimes, it may be desirable to do an additional localization that is a
+function of the type of observation and the state vector quantity. This
+program allows users to construct a table that is read by filter at run-time
+to localize the impact of sets of observation types on sets of state
+vectorquantities. Users can create named sets of observation types and sets
+of state vector quantities and specify a localization for the impact of the
+specified observation types on the state vector quantities.
-This version of this tool requires the last numeric
-column to be 0.0 or 1.0, but future extensions may allow
-different values to be used.
+An example would be to create a subset of observations of tracer
+concentration for a variety of tracers, and a subset of dynamic state
+variable quantities like temperatures and wind components. It has been common
+to set this localization value to 0 so that tracer observations have no
+impact on dynamic state quantities, however, the tool allows values between 0
+and 1 to be specified.
+
+
+
+This tool allows related collections of observation types and state vector
+quantities to be named and then express the relationship of the named groups
+to each other in a concise way.
+It can also define relationships by exceptions.
All the listed observation types and state vector quantities
must be known by the system. If they are not, look at the
-&preprocess_nml :: input_items namelist which specifies
+&preprocess_nml :: input_items namelist which specifies
which obs_def_xxx_mod.f90 files are included, which is
-where observation types are defined. Quantities are defined
-in the obs_kinds/DEFAULT_obs_kinds_mod.F90 file and
-are static. (Note you must add new quantities in 2 places
+where observation types are defined. Quantities are defined in
+assimilation_code/modules/observations/DEFAULT_obs_kinds_mod.F90.
+(Note you must add new quantities in 2 places
if you do alter this file.)
-
-This program can define groups of observation types and
-then describe the relationship of groups to groups.
-It can also define relationships by exceptions.
-
Format of the input file can be any combination of these
@@ -129,9 +143,9 @@
Recommended to stay false. This allows only 0.0 and 1.0 as the
-impact factors, effectively using the full increments or no increments
-during the assimilation. To experiment with partial application of
-the increments this flag can be set to true to allow other values.
-
-
debug
logical
If true print out debugging info.
@@ -221,7 +226,7 @@
+This program creates an output observation sequence
+(obs_seq) file that is shorter than the input obs_seq file.
+There are two ways to restrict the number of observations
+copied to the output: the total number of observations
+regardless of observation type, or up to N observations of each type.
+Observations in an obs_seq file are processed in time order
+so the observations with the earliest timestamps will be copied.
+
+
+
+Set either limit to -1 to disable it.
+If both the maximum count per type and maximum total count are
+given the copying stops when the first limit is reached.
+
+
+
+If you want to subset an obs_seq file starting at a later time
+see the obs_sequence_tool
+for subsetting by time and then use this tool on the output.
+That tool also allows you to subset by obs type, location, data value,
+and a variety of other options.
+
+
+
+The obs_keep_a_few program
+only subsets by numbers of observations. It is expected to be useful
+when prototyping experiments so the run time is short, or for debugging
+or testing. Setting a limit per type ensures you have up to N of
+each type of observation present in the output file.
+
+
+
+Identity observations are all considered to be the same
+identity "observation type" by this tool.
+
+This namelist is read from the file input.nml.
+Namelists start with an ampersand
+'&' and terminate with a slash '/'.
+Character strings that contain a '/' must be
+enclosed in quotes to prevent them from
+prematurely terminating the namelist.
+
Name of the observation sequence file to create.
+An existing file will be overwritten.
+
+
+
max_count_per_type
+
integer
+
The first N observations of each different type
+will be copied to the output file. Observation sequence
+files are processed in time order so these will be
+the ones with the earliest time stamps relative to
+other observations of this same type.
+Set to -1 to disable this limit.
+
+
+
max_total_count
+
integer
+
If greater than 0, sets the upper limit on the
+total number of observations to be copied to the output
+file regardless of type.
+The program quits when either this limit is reached or when
+there are N of each different obs type in the output.
+Set to -1 to disable.
+
+
+
print_only
+
logical
+
If true, does all the work and prints out what
+the output file would have in it (timestamps and counts
+of each obs type) but doesn't create the output file.
+
+
+
calendar
+
character(len=256)
+
Name of the DART calendar type to use.
+Generally 'Gregorian' or 'No calendar'.
+See the DART time manager for more options.
+Only controls the formatting of how the times
+in the output summary messages are displayed.
+
+
+
+
+
+
diff --git a/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.nml b/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.nml
new file mode 100644
index 0000000000..ac6cab7e10
--- /dev/null
+++ b/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.nml
@@ -0,0 +1,10 @@
+
+&obs_keep_a_few_nml
+ filename_in = ''
+ filename_out = ''
+ max_count_per_type = 10
+ max_total_count = -1
+ print_only = .false.
+ calendar = 'Gregorian'
+ /
+
diff --git a/assimilation_code/programs/obs_loop/obs_loop.f90 b/assimilation_code/programs/obs_loop/obs_loop.f90
index dab8c1ab53..8f8a11a8f4 100644
--- a/assimilation_code/programs/obs_loop/obs_loop.f90
+++ b/assimilation_code/programs/obs_loop/obs_loop.f90
@@ -56,12 +56,11 @@ program obs_loop
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 :: num_inserted, iunit, io, j
integer :: max_num_obs, file_id
character(len=129) :: read_format
logical :: pre_I_format, cal
character(len=512) :: msgstring, msgstring1, msgstring2, msgstring3
-type(obs_def_type) :: this_obs_def
character(len=metadatalength) :: meta_data
diff --git a/assimilation_code/programs/obs_seq_coverage/obs_seq_coverage.f90 b/assimilation_code/programs/obs_seq_coverage/obs_seq_coverage.f90
index 8a53abcf0b..d090491386 100644
--- a/assimilation_code/programs/obs_seq_coverage/obs_seq_coverage.f90
+++ b/assimilation_code/programs/obs_seq_coverage/obs_seq_coverage.f90
@@ -49,10 +49,12 @@ program obs_seq_coverage
use utilities_mod, only : get_unit, close_file, register_module, &
file_exist, error_handler, E_ERR, E_WARN, E_MSG, &
initialize_utilities, nmlfileunit, finalize_utilities, &
- find_namelist_in_file, check_namelist_read, nc_check, &
+ find_namelist_in_file, check_namelist_read, &
next_file, set_filename_list, find_textfile_dims, &
file_to_text, do_nml_file, do_nml_term
+use netcdf_utilities_mod, only : nc_check
+
use typeSizes
use netcdf
diff --git a/assimilation_code/programs/obs_seq_to_netcdf/obs_seq_to_netcdf.f90 b/assimilation_code/programs/obs_seq_to_netcdf/obs_seq_to_netcdf.f90
index c61cf5ef08..75d7584a1b 100644
--- a/assimilation_code/programs/obs_seq_to_netcdf/obs_seq_to_netcdf.f90
+++ b/assimilation_code/programs/obs_seq_to_netcdf/obs_seq_to_netcdf.f90
@@ -33,9 +33,10 @@ program obs_seq_to_netcdf
use utilities_mod, only : register_module, &
file_exist, error_handler, E_ERR, E_MSG, &
initialize_utilities, finalize_utilities, nmlfileunit, &
- find_namelist_in_file, check_namelist_read, nc_check, &
+ find_namelist_in_file, check_namelist_read, &
next_file, get_next_filename, find_textfile_dims, &
file_to_text, do_nml_file, do_nml_term
+use netcdf_utilities_mod, only : nc_check
use typeSizes
use netcdf
diff --git a/assimilation_code/programs/obs_seq_verify/obs_seq_verify.f90 b/assimilation_code/programs/obs_seq_verify/obs_seq_verify.f90
index 3e7d7a3de7..eb404b5a15 100644
--- a/assimilation_code/programs/obs_seq_verify/obs_seq_verify.f90
+++ b/assimilation_code/programs/obs_seq_verify/obs_seq_verify.f90
@@ -86,10 +86,12 @@ program obs_seq_verify
use utilities_mod, only : get_unit, close_file, register_module, timestamp, &
file_exist, error_handler, E_ERR, E_WARN, E_MSG, &
initialize_utilities, finalize_utilities, nmlfileunit, &
- find_namelist_in_file, check_namelist_read, nc_check, &
+ find_namelist_in_file, check_namelist_read, &
next_file, set_filename_list, find_textfile_dims, &
file_to_text, do_nml_file, do_nml_term
+use netcdf_utilities_mod, only : nc_check
+
use typeSizes
use netcdf
diff --git a/assimilation_code/programs/obs_total_error/obs_total_error.f90 b/assimilation_code/programs/obs_total_error/obs_total_error.f90
new file mode 100644
index 0000000000..0acb563811
--- /dev/null
+++ b/assimilation_code/programs/obs_total_error/obs_total_error.f90
@@ -0,0 +1,611 @@
+! 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
+
+program obs_total_error
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick summary number of the total error in the mean
+! and spread. This should be run on an obs_seq file which has been
+! through both perfect_model_obs and filter, so it has both a copy
+! of the 'truth' as well as 'ensemble mean' and 'ensemble spread'.
+
+
+use types_mod, only : r8, missing_r8, metadatalength, obstypelength
+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, &
+ file_exist
+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
+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_obs_values, &
+ 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=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+
+type(obs_sequence_type) :: seq_in
+integer :: size_seq_in
+integer :: num_copies_in, num_qc_in
+integer :: iunit, io, ifile
+integer :: max_num_obs, file_id
+character(len = 129) :: read_format, filename_in
+logical :: pre_I_format, cal
+character(len = 256) :: msgstring, msgstring1, msgstring2
+
+!----------------------------------------------------------------
+! Namelist input with default values
+
+
+character(len = 160) :: obs_sequence_name = ''
+character(len = 160) :: obs_sequence_list = ''
+
+character(len=32) :: calendar = 'Gregorian'
+
+
+namelist /obs_total_error_nml/ &
+ obs_sequence_name, obs_sequence_list, calendar
+
+!----------------------------------------------------------------
+! Start of the program:
+!
+! Process each input observation sequence file in turn, optionally
+! selecting observations to insert into the output sequence file.
+!----------------------------------------------------------------
+
+call setup()
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "obs_total_error_nml", iunit)
+read(iunit, nml = obs_total_error_nml, iostat = io)
+call check_namelist_read(iunit, io, "obs_total_error_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=obs_total_error_nml)
+if (do_nml_term()) write( * , nml=obs_total_error_nml)
+
+! the default is a gregorian calendar. if you are using a different type
+! set it in the namelist. this only controls how it prints out the first
+! and last timestamps in the obs_seq files.
+call set_calendar_type(calendar)
+
+! set a logial to see if we have a calendar or not
+cal = (get_calendar_type() /= NO_CALENDAR)
+
+! Check the user input for sanity
+if ((obs_sequence_name /= '') .and. (obs_sequence_list /= '')) then
+ write(msgstring1,*)'specify "obs_sequence_name" or "obs_sequence_list"'
+ write(msgstring2,*)'set other to an empty string ... i.e. ""'
+ call error_handler(E_ERR, 'obs_assim_count', msgstring1, &
+ source, revision, revdate, text2=msgstring2)
+endif
+
+! if you add anything to the namelist, you can process it here.
+
+! end of namelist processing and setup
+
+ifile = 0
+ObsFileLoop : do ! until we run out of names
+!-----------------------------------------------------------------------
+
+ ifile = ifile + 1
+
+ ! Determine the next input filename ...
+
+ if (obs_sequence_list == '') then
+ if (ifile > 1) exit ObsFileLoop
+ filename_in = obs_sequence_name
+ else
+ filename_in = get_next_filename(obs_sequence_list,ifile)
+ if (filename_in == '') exit ObsFileLoop
+ endif
+
+ if ( .not. file_exist(filename_in) ) then
+ write(msgstring1,*)'cannot open ', trim(filename_in)
+ call error_handler(E_ERR,'obs_assim_count:',msgstring1,source,revision,revdate)
+ endif
+
+call read_obs_seq_header(filename_in, num_copies_in, num_qc_in, &
+ size_seq_in, max_num_obs, file_id, read_format, pre_I_format, &
+ close_the_file = .true.)
+
+if (max_num_obs == 0) then
+ write(msgstring,*) 'No obs in input sequence file ', trim(filename_in)
+ call error_handler(E_ERR,'obs_total_error',msgstring)
+endif
+
+write(msgstring, *) 'Starting to process input sequence file: '
+write(msgstring1,*) trim(filename_in)
+call error_handler(E_MSG,'obs_total_error',msgstring, &
+ text2=msgstring1)
+
+call read_obs_seq(filename_in, 0, 0, 0, seq_in)
+
+! sanity check - ensure the linked list times are in increasing time order
+call validate_obs_seq_time(seq_in, filename_in)
+
+! the computation is done here.
+call print_obs_seq_info(seq_in, filename_in)
+
+ ! clean up
+
+ call destroy_obs_sequence(seq_in)
+
+enddo ObsFileLoop
+
+call shutdown()
+
+!---------------------------------------------------------------------
+! end of main program.
+!---------------------------------------------------------------------
+
+
+contains
+
+
+!---------------------------------------------------------------------
+subroutine setup()
+
+! Initialize modules used that require it
+call initialize_utilities('obs_total_error')
+call register_module(source,revision,revdate)
+call static_init_obs_sequence()
+
+end subroutine setup
+
+
+!---------------------------------------------------------------------
+subroutine shutdown()
+
+call finalize_utilities('obs_total_error')
+
+end subroutine shutdown
+
+
+!---------------------------------------------------------------------
+subroutine print_obs_seq_info(seq_in, filename)
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick table of obs types and counts, overall start and
+! stop times, and metadata strings and counts.
+
+! and this one counts up, if there is a 'posterior ensemble mean' copy,
+! how many are missing_r8 and how many are not. it could also count
+! up the 'DART quality control' settings? start with the latter for now.
+
+type(obs_sequence_type), intent(in) :: seq_in
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq_in
+integer :: i
+integer :: this_obs_type
+integer :: type_count(max_defined_types_of_obs), identity_count, qc_count(0:7), qcindex
+integer :: trueindex, meanindex, spreadindex, erritems
+real(r8) :: qcval(1), copyval(1), truth, mean, spread
+real(r8) :: tminusm, spreadsq
+logical :: can_do_error
+
+
+! Initialize counters and sums
+type_count(:) = 0
+identity_count = 0
+qc_count(:) = 0
+tminusm = 0.0_r8
+spreadsq = 0.0_r8
+erritems = 0
+
+size_seq_in = get_num_obs(seq_in)
+if (size_seq_in == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_total_error',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq_in), get_num_qc(seq_in))
+call init_obs(next_obs, get_num_copies(seq_in), get_num_qc(seq_in))
+
+! find the dart qc copy, if there is one
+qcindex = get_dartqc_index(seq_in, filename)
+
+! find the true_state, ensemble_mean, ensemble_spread if they are there
+trueindex = get_dartcopy_index(seq_in, filename, 'truth')
+meanindex = get_dartcopy_index(seq_in, filename, 'posterior ensemble mean')
+spreadindex = get_dartcopy_index(seq_in, filename, 'posterior ensemble spread')
+
+can_do_error = all( (/trueindex, meanindex, spreadindex/) >= 0 )
+
+! blank line
+call error_handler(E_MSG,'',' ')
+
+write(msgstring,*) 'Processing sequence file ', trim(filename)
+call error_handler(E_MSG,'',msgstring)
+
+call print_metadata(seq_in, filename)
+
+!-------------------------------------------------------------
+! Start to process obs from seq_in
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq_in, obs)
+
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first observation in ',trim(filename)
+ call error_handler(E_MSG,'obs_total_error', msgstring)
+endif
+
+! process it here
+is_this_last = .false.
+
+! blank line
+call error_handler(E_MSG, '', ' ')
+
+call get_obs_def(obs, this_obs_def)
+call print_time(get_obs_def_time(this_obs_def), ' First timestamp: ')
+! does not work with NO_CALENDAR
+if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_obs_type = get_obs_def_type_of_obs(this_obs_def)
+ if (this_obs_type < 0) then
+ identity_count = identity_count + 1
+ else
+ type_count(this_obs_type) = type_count(this_obs_type) + 1
+ endif
+! print *, 'obs type index = ', this_obs_type
+! if(this_obs_type > 0)print *, 'obs name = ', get_name_for_type_of_obs(this_obs_type)
+ if (qcindex > 0) then
+ call get_qc(obs, qcval, qcindex)
+ qc_count(nint(qcval(1))) = qc_count(nint(qcval(1))) + 1
+ endif
+
+ if (can_do_error) then
+ call get_obs_values(obs, copyval, trueindex)
+ truth = copyval(1)
+ call get_obs_values(obs, copyval, meanindex)
+ mean = copyval(1)
+ call get_obs_values(obs, copyval, spreadindex)
+ spread = copyval(1)
+
+ tminusm = tminusm + (truth - mean)**2.0
+ spreadsq = spreadsq + spread**2.0
+ erritems = erritems + 1
+ endif
+
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if (.not. is_this_last) then
+ obs = next_obs
+ else
+ call print_time(get_obs_def_time(this_obs_def), ' Last timestamp: ')
+ if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+ endif
+
+enddo ObsLoop
+
+
+write(msgstring, *) 'Number of obs processed : ', size_seq_in
+call error_handler(E_MSG, '', msgstring)
+write(msgstring, *) '---------------------------------------------------------'
+call error_handler(E_MSG, '', msgstring)
+do i = 1, max_defined_types_of_obs
+ if (type_count(i) > 0) then
+ write(msgstring, '(a32,i8,a)') trim(get_name_for_type_of_obs(i)), &
+ type_count(i), ' obs'
+ call error_handler(E_MSG, '', msgstring)
+ endif
+enddo
+if (identity_count > 0) then
+ write(msgstring, '(a32,i8,a)') 'Identity observations', &
+ identity_count, ' obs'
+ call error_handler(E_MSG, '', msgstring)
+endif
+if (qcindex > 0) then
+ call error_handler(E_MSG, '', ' ')
+ write(msgstring, *) 'DART QC results: '
+ call error_handler(E_MSG, '', msgstring)
+ do i=0, 7
+ if (qc_count(i) > 0) then
+ write(msgstring, '(a16,2(i8))') 'DART QC value', i, &
+ qc_count(i)
+ call error_handler(E_MSG, '', msgstring)
+ endif
+ enddo
+ write(msgstring, *) 'Total obs: ', sum(qc_count(:))
+ call error_handler(E_MSG, '', msgstring)
+endif
+
+call error_handler(E_MSG, '', ' ')
+if (can_do_error) then
+ write(msgstring, *) 'Error results: '
+ call error_handler(E_MSG, '', msgstring)
+ write(msgstring, *) 'Total error: ', sqrt(tminusm)
+ call error_handler(E_MSG, '', msgstring)
+ write(msgstring, *) 'Total spread: ', sqrt(spreadsq)
+ call error_handler(E_MSG, '', msgstring)
+else
+ write(msgstring, *) 'No error results printed because one or more of "truth",'
+ call error_handler(E_MSG, '', msgstring)
+ write(msgstring, *) '"posterior ensemble mean", and/or "posterior ensemble spread" are missing'
+ call error_handler(E_MSG, '', msgstring)
+endif
+
+! another blank line
+call error_handler(E_MSG, '', ' ')
+
+! Time to clean up
+
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+end subroutine print_obs_seq_info
+
+
+!---------------------------------------------------------------------
+subroutine validate_obs_seq_time(seq, filename)
+
+! this eventually belongs in the obs_seq_mod code, but for now
+! try it out here. we just fixed a hole in the interactive create
+! routine which would silently let you create out-of-time-order
+! linked lists, which gave no errors but didn't assimilate the
+! right obs at the right time when running filter. this runs
+! through the times in the entire sequence, ensuring they are
+! monotonically increasing in time. this should help catch any
+! bad files which were created with older versions of code.
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq, obs_count
+integer :: key
+type(time_type) :: last_time, this_time
+
+
+! make sure there are obs left to process before going on.
+size_seq = get_num_obs(seq)
+if (size_seq == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_total_error:validate',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq), get_num_qc(seq))
+call init_obs(next_obs, get_num_copies(seq), get_num_qc(seq))
+
+obs_count = 0
+
+!-------------------------------------------------------------
+! Start to process obs from seq
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq, obs)
+
+! we already tested for 0 obs above, so there should be a first obs here.
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first obs in sequence ' // trim(filename)
+ call error_handler(E_ERR,'obs_total_error:validate', &
+ msgstring, source, revision, revdate)
+ return
+endif
+
+is_this_last = .false.
+last_time = set_time(0, 0)
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+
+ if (last_time > this_time) then
+ ! bad time order of observations in linked list
+ call print_time(last_time, ' previous timestamp: ')
+ if (cal) call print_date(last_time, ' calendar date: ')
+ call print_time(this_time, ' next timestamp: ')
+ if (cal) call print_date(this_time, ' calendar date: ')
+
+ key = get_obs_key(obs)
+ write(msgstring1,*)'obs number ', key, ' has earlier time than previous obs'
+ write(msgstring2,*)'observations must be in increasing time order, file ' // trim(filename)
+ call error_handler(E_ERR,'obs_total_error:validate', msgstring2, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ endif
+
+ last_time = this_time
+ obs_count = obs_count + 1
+
+ call get_next_obs(seq, obs, next_obs, is_this_last)
+ if (.not. is_this_last) obs = next_obs
+
+enddo ObsLoop
+
+! clean up
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+! technically not a time validation, but easy to check. obs_count should never
+! be larger than size_seq - that's a fatal error. obs_count < size_seq would
+! suggest there are obs in the file that aren't part of the linked list.
+! this does not necessarily indicate a fatal error but it's not a common
+! situation and might indicate someone should check on the file.
+if (obs_count /= size_seq) then
+ write(msgstring,*) 'input sequence ', trim(filename)
+ call error_handler(E_MSG,'obs_total_error:validate', msgstring)
+
+ write(msgstring,*) 'total obs in file: ', size_seq, ' obs in linked list: ', obs_count
+ if (obs_count > size_seq) then
+ ! this is a fatal error
+ write(msgstring1,*) 'linked list obs_count > total size_seq, should not happen'
+ call error_handler(E_ERR,'obs_total_error:validate', msgstring, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ else
+ ! just warning msg
+ write(msgstring1,*) 'only observations in linked list will be processed'
+ call error_handler(E_MSG,'obs_total_error:validate', msgstring, &
+ source, revision, revdate, text2=msgstring1)
+ endif
+endif
+
+end subroutine validate_obs_seq_time
+
+
+!---------------------------------------------------------------------
+subroutine print_metadata(seq, fname)
+
+!
+! print out the metadata strings, trimmed
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*) :: fname
+
+integer :: num_copies , num_qc, i
+character(len=metadatalength) :: str
+character(len=255) :: msgstring3
+
+num_copies = get_num_copies(seq)
+num_qc = get_num_qc( seq)
+
+if ( num_copies < 0 .or. num_qc < 0 ) then
+ write(msgstring3,*)' illegal copy or obs count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_total_error', msgstring3, &
+ source, revision, revdate)
+endif
+
+MetaDataLoop : do i=1, num_copies
+ str = get_copy_meta_data(seq,i)
+
+ write(msgstring,*)'Data Metadata: ',trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo MetaDataLoop
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ write(msgstring,*)' QC Metadata: ', trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo QCMetaData
+
+end subroutine print_metadata
+
+
+!---------------------------------------------------------------------
+function get_dartqc_index(seq, fname)
+
+!
+! return the index number of the dart qc copy (-1 if none)
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*) :: fname
+integer :: get_dartqc_index
+
+integer :: num_qc, i
+character(len=metadatalength) :: str
+character(len=255) :: msgstring3
+
+num_qc = get_num_qc(seq)
+
+if ( num_qc < 0 ) then
+ write(msgstring3,*)' illegal qc metadata count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_total_error', msgstring3, &
+ source, revision, revdate)
+endif
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ if (str == 'DART quality control') then
+ get_dartqc_index = i
+ return
+ endif
+
+enddo QCMetaData
+
+get_dartqc_index = -1
+
+end function get_dartqc_index
+
+!---------------------------------------------------------------------
+
+function get_dartcopy_index(seq, fname, copyname)
+
+!
+! return the index number of the given dart copy (-1 if none)
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*) :: fname, copyname
+integer :: get_dartcopy_index
+
+integer :: num_copies, i
+character(len=metadatalength) :: str
+character(len=255) :: msgstring3
+
+num_copies = get_num_copies(seq)
+
+if ( num_copies < 0 ) then
+ write(msgstring3,*)' illegal copy metadata count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_total_error', msgstring3, &
+ source, revision, revdate)
+endif
+
+MetaData : do i=1, num_copies
+ str = get_copy_meta_data(seq,i)
+
+ if (str == copyname) then
+ get_dartcopy_index = i
+ return
+ endif
+
+enddo MetaData
+
+get_dartcopy_index = -1
+
+end function get_dartcopy_index
+
+
+!---------------------------------------------------------------------
+end program obs_total_error
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
diff --git a/assimilation_code/programs/obs_total_error/obs_total_error.nml b/assimilation_code/programs/obs_total_error/obs_total_error.nml
new file mode 100644
index 0000000000..0fa9f52e2d
--- /dev/null
+++ b/assimilation_code/programs/obs_total_error/obs_total_error.nml
@@ -0,0 +1,5 @@
+&obs_total_error_nml
+ obs_sequence_name = 'obs_seq.final',
+ obs_sequence_list = '',
+ calendar = 'Gregorian'
+ /
diff --git a/assimilation_code/programs/obs_total_error/work/input.nml b/assimilation_code/programs/obs_total_error/work/input.nml
new file mode 100644
index 0000000000..2be183a93a
--- /dev/null
+++ b/assimilation_code/programs/obs_total_error/work/input.nml
@@ -0,0 +1,62 @@
+
+&obs_total_error_nml
+ obs_sequence_name = 'obs_seq.final',
+ obs_sequence_list = '',
+ calendar = 'Gregorian'
+ /
+
+# for low order models, use this version of preprocess.
+#&preprocess_nml
+# overwrite_output = .true.
+# input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
+# output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90'
+# input_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
+# output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90'
+# input_files = '../../../../observations/forward_operators/obs_def_1d_state_mod.f90
+
+&preprocess_nml
+ overwrite_output = .true.
+ input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
+ output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90'
+ input_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
+ output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90'
+ input_files = '../../../../observations/forward_operators/obs_def_AIRS_mod.f90',
+ '../../../../observations/forward_operators/obs_def_AOD_mod.f90',
+ '../../../../observations/forward_operators/obs_def_AURA_mod.f90',
+ '../../../../observations/forward_operators/obs_def_COSMOS_mod.f90',
+ '../../../../observations/forward_operators/obs_def_CO_Nadir_mod.f90',
+ '../../../../observations/forward_operators/obs_def_GWD_mod.f90',
+ '../../../../observations/forward_operators/obs_def_QuikSCAT_mod.f90',
+ '../../../../observations/forward_operators/obs_def_SABER_mod.f90',
+ '../../../../observations/forward_operators/obs_def_TES_nadir_mod.f90',
+ '../../../../observations/forward_operators/obs_def_altimeter_mod.f90',
+ '../../../../observations/forward_operators/obs_def_cice_mod.f90',
+ '../../../../observations/forward_operators/obs_def_cloud_mod.f90',
+ '../../../../observations/forward_operators/obs_def_cwp_mod.f90',
+ '../../../../observations/forward_operators/obs_def_dew_point_mod.f90',
+ '../../../../observations/forward_operators/obs_def_dwl_mod.f90',
+ '../../../../observations/forward_operators/obs_def_eval_mod.f90',
+ '../../../../observations/forward_operators/obs_def_gps_mod.f90',
+ '../../../../observations/forward_operators/obs_def_gts_mod.f90',
+ '../../../../observations/forward_operators/obs_def_metar_mod.f90',
+ '../../../../observations/forward_operators/obs_def_ocean_mod.f90',
+ '../../../../observations/forward_operators/obs_def_pe2lyr_mod.f90',
+ '../../../../observations/forward_operators/obs_def_radar_mod.f90',
+ '../../../../observations/forward_operators/obs_def_radiance_mod.f90',
+ '../../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90',
+ '../../../../observations/forward_operators/obs_def_rel_humidity_mod.f90',
+ '../../../../observations/forward_operators/obs_def_sqg_mod.f90',
+ '../../../../observations/forward_operators/obs_def_surface_mod.f90',
+ '../../../../observations/forward_operators/obs_def_tower_mod.f90',
+ '../../../../observations/forward_operators/obs_def_tpw_mod.f90',
+ '../../../../observations/forward_operators/obs_def_upper_atm_mod.f90',
+ '../../../../observations/forward_operators/obs_def_vortex_mod.f90',
+ '../../../../observations/forward_operators/obs_def_wind_speed_mod.f90',
+ /
+
+&utilities_nml
+ module_details = .false.
+ write_nml = 'file'
+ /
+
+
diff --git a/assimilation_code/programs/obs_total_error/work/mkmf_obs_total_error b/assimilation_code/programs/obs_total_error/work/mkmf_obs_total_error
new file mode 100755
index 0000000000..9498527b8c
--- /dev/null
+++ b/assimilation_code/programs/obs_total_error/work/mkmf_obs_total_error
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../../build_templates/mkmf -p obs_total_error -t ../../../../build_templates/mkmf.template -c"-Duse_netCDF" \
+ -a "../../../.." path_names_obs_total_error
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/assimilation_code/programs/obs_total_error/work/mkmf_preprocess b/assimilation_code/programs/obs_total_error/work/mkmf_preprocess
new file mode 100755
index 0000000000..ce35969343
--- /dev/null
+++ b/assimilation_code/programs/obs_total_error/work/mkmf_preprocess
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../../build_templates/mkmf -p preprocess -t ../../../../build_templates/mkmf.template \
+ -a "../../../.." path_names_preprocess
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/assimilation_code/programs/obs_total_error/work/path_names_obs_total_error b/assimilation_code/programs/obs_total_error/work/path_names_obs_total_error
new file mode 100644
index 0000000000..15fab22bec
--- /dev/null
+++ b/assimilation_code/programs/obs_total_error/work/path_names_obs_total_error
@@ -0,0 +1,28 @@
+assimilation_code/location/threed_sphere/location_mod.f90
+assimilation_code/location/utilities/default_location_mod.f90
+assimilation_code/location/utilities/location_io_mod.f90
+assimilation_code/modules/assimilation/adaptive_inflate_mod.f90
+assimilation_code/modules/assimilation/assim_model_mod.f90
+assimilation_code/modules/io/dart_time_io_mod.f90
+assimilation_code/modules/io/direct_netcdf_mod.f90
+assimilation_code/modules/io/io_filenames_mod.f90
+assimilation_code/modules/io/state_structure_mod.f90
+assimilation_code/modules/io/state_vector_io_mod.f90
+assimilation_code/modules/observations/obs_kind_mod.f90
+assimilation_code/modules/observations/obs_sequence_mod.f90
+assimilation_code/modules/utilities/distributed_state_mod.f90
+assimilation_code/modules/utilities/ensemble_manager_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/null_win_mod.f90
+assimilation_code/modules/utilities/options_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/obs_total_error/obs_total_error.f90
+models/template/model_mod.f90
+models/utilities/default_model_mod.f90
+observations/forward_operators/obs_def_mod.f90
+observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/assimilation_code/programs/obs_total_error/work/path_names_preprocess b/assimilation_code/programs/obs_total_error/work/path_names_preprocess
new file mode 100644
index 0000000000..ae8022dafe
--- /dev/null
+++ b/assimilation_code/programs/obs_total_error/work/path_names_preprocess
@@ -0,0 +1,5 @@
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/preprocess/preprocess.f90
diff --git a/assimilation_code/programs/obs_total_error/work/quickbuild.csh b/assimilation_code/programs/obs_total_error/work/quickbuild.csh
new file mode 100755
index 0000000000..8306007ca3
--- /dev/null
+++ b/assimilation_code/programs/obs_total_error/work/quickbuild.csh
@@ -0,0 +1,71 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+#
+# Script to manage the compilation of all components.
+
+#----------------------------------------------------------------------
+# 'preprocess' is a program that culls the appropriate sections of the
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
+# so this MUST be run first.
+#----------------------------------------------------------------------
+
+\rm -f preprocess *.o *.mod Makefile .cppdefs
+\rm -f ../../../obs_def/obs_def_mod.f90
+\rm -f ../../../obs_kind/obs_kind_mod.f90
+
+set MODEL = "obs_total_error"
+
+@ n = 1
+
+echo
+echo
+echo "---------------------------------------------------------------"
+echo "${MODEL} build number ${n} is preprocess"
+
+csh mkmf_preprocess
+make || exit $n
+
+./preprocess || exit 99
+
+#----------------------------------------------------------------------
+# Build all the single-threaded targets
+#----------------------------------------------------------------------
+
+foreach TARGET ( mkmf_* )
+
+ set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
+
+ switch ( $TARGET )
+ case mkmf_preprocess:
+ breaksw
+ default:
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "${MODEL} build number ${n} is ${PROG}"
+ \rm -f ${PROG}
+ csh $TARGET || exit $n
+ make || exit $n
+ breaksw
+ endsw
+end
+
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
+
+echo ""
+echo "Success: All single task DART programs compiled."
+echo ""
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/assimilation_code/programs/obs_utils/create_obs_grid.f90 b/assimilation_code/programs/obs_utils/create_obs_grid.f90
new file mode 100644
index 0000000000..7cf853ba5d
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/create_obs_grid.f90
@@ -0,0 +1,162 @@
+! 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
+!
+! DART $Id$
+
+program create_obs_grid
+
+use utilities_mod, only : register_module, open_file, close_file, &
+ initialize_utilities, finalize_utilities
+use obs_sequence_mod, only : obs_sequence_type, interactive_obs, write_obs_seq, &
+ static_init_obs_sequence
+use assim_model_mod, only : static_init_assim_model
+use location_mod
+use obs_def_mod
+use obs_kind_mod
+use obs_sequence_mod
+use time_manager_mod
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+character(len=128), parameter :: id = "$Id$"
+
+type(obs_sequence_type) :: seq
+character(len = 129) :: file_name
+
+! Record the current time, date, etc. to the logfile
+call initialize_utilities('create_obs_grid')
+call register_module(source, revision, revdate)
+
+! Initialize the assim_model module, need this to get model
+! state meta data for locations of identity observations
+call static_init_assim_model()
+
+! Initialize the obs_sequence module
+call static_init_obs_sequence()
+
+! Create grid of obs
+seq = create_grid()
+
+! Write the sequence to a file
+write(*, *) 'Input filename for sequence ( obs_seq.in usually works well)'
+read(*, *) file_name
+call write_obs_seq(seq, file_name)
+
+! Clean up
+call finalize_utilities('create_obs_grid')
+
+contains
+
+function create_grid()
+ type(obs_sequence_type) :: create_grid
+
+type(obs_type) :: obs, prev_obs
+type(obs_def_type) :: obs_def
+type(time_type) :: obs_time, prev_time
+type(location_type) :: loc
+integer :: max_num_grids, num_copies, num_qc, end_it_all, max_num_obs
+integer :: num_dim, n(3), i, j, k, l
+
+! these things aren't prompted for - they're fixed in the code
+num_copies = 1
+num_qc = 0
+max_num_obs = 1000000 ! FIXME: made up
+
+write(*, *) 'Input upper bound on number of grids of observations in sequence'
+read(*, *) max_num_grids
+
+! Initialize an obs_sequence structure
+call init_obs_sequence(create_grid, num_copies, num_qc, max_num_obs)
+
+do i = 1, num_copies
+ call set_copy_meta_data(create_grid, i, 'observations')
+end do
+
+! Initialize the obs variable
+call init_obs(obs, num_copies, num_qc)
+call init_obs(prev_obs, num_copies, num_qc)
+
+! Loop to initialize each observation in turn; terminate by -1
+do l = 1, max_num_grids
+ write(*, *) 'input a -1 if there are no more grids'
+
+
+ read(*, *) end_it_all
+ if(end_it_all == -1) exit
+
+ ! FIXME: this is the corner of a grid, need to prompt for
+ ! extents in each dim (2d or 3d) and number of points in same.
+ ! then loop below using same type and error, just bumping
+ ! location each time.
+
+ write(*, *) 'the location of the next observation defines the corner of a box'
+
+ ! Need to have key available for specialized observation modules
+ call interactive_obs(num_copies, num_qc, obs, i)
+
+ write(*, *) 'enter the location of the opposite corner of the box'
+ call interactive_location(loc)
+
+ num_dim = -1
+ do while (num_dim < 1 .and. num_dim > 3)
+ write(*, *) 'input 1, 2 or 3 for 1d, 2d or 3d grid'
+ read(*, *) num_dim
+ enddo
+
+ n = 0
+ do i=1, num_dim
+ write(*,*) 'input nitems for dimension ', i
+ read(*,*) n(i)
+ enddo
+
+ do k=1, n(3)
+ do j=1, n(2)
+ do i=1, n(1)
+ ! set an obs based on the corner one
+ ! compute new location and set it into an obs
+! fixme here, too
+
+ if(i == 1) then
+ call insert_obs_in_seq(create_grid, obs)
+ else
+ ! if this is not the first obs, make sure the time is larger
+ ! than the previous observation. if so, we can start the
+ ! linked list search at the location of the previous obs.
+ ! otherwise, we have to start at the beginning of the entire
+ ! sequence to be sure the obs are ordered correctly in
+ ! monotonically increasing times.
+ call get_obs_def(obs, obs_def)
+ obs_time = get_obs_def_time(obs_def)
+ call get_obs_def(prev_obs, obs_def)
+ prev_time = get_obs_def_time(obs_def)
+ if(prev_time > obs_time) then
+ call insert_obs_in_seq(create_grid, obs)
+ else
+ call insert_obs_in_seq(create_grid, obs, prev_obs)
+ endif
+ endif
+ prev_obs = obs
+ end do ! i
+ end do ! j
+ end do ! k
+end do ! max_grids
+
+call destroy_obs(obs)
+call destroy_obs(prev_obs)
+
+end function create_grid
+
+end program create_obs_grid
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
diff --git a/assimilation_code/programs/obs_utils/obs_assim_count.f90 b/assimilation_code/programs/obs_utils/obs_assim_count.f90
new file mode 100644
index 0000000000..ea753aba56
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/obs_assim_count.f90
@@ -0,0 +1,506 @@
+! 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
+!
+! DART $Id$
+
+program obs_assim_count
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick table of obs types and counts, overall start and
+! stop times, and metadata strings and counts.
+
+! right now this program counts up the number of obs for each
+! possible 'DART quality control' value (0-7). (it could also
+! check for a 'posterior ensemble mean' copy and count how
+! many are missing_r8 and how many are not.) it does the
+! former right now.
+
+
+use types_mod, only : r8, missing_r8, metadatalength, obstypelength
+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
+use obs_kind_mod, only : max_defined_types_of_obs, get_name_for_type_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, &
+ init_obs, assignment(=), get_obs_def, &
+ static_init_obs_sequence, &
+ read_obs_seq_header, read_obs_seq, get_num_obs, &
+ get_first_obs, get_next_obs, &
+ insert_obs_in_seq, get_num_copies, get_num_qc, &
+ get_copy_meta_data, get_qc_meta_data, &
+ destroy_obs, destroy_obs_sequence, &
+ get_obs_key, get_obs_def, get_qc
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+character(len=128), parameter :: id = "$Id$"
+
+type(obs_sequence_type) :: seq_in
+integer :: size_seq_in
+integer :: num_copies_in, num_qc_in
+integer :: iunit, io
+integer :: max_num_obs, file_id
+character(len = 129) :: read_format
+logical :: pre_I_format, cal
+character(len = 256) :: msgstring, msgstring1, msgstring2
+
+! 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 = 160) :: filename_in = ''
+
+character(len=32) :: calendar = 'Gregorian'
+
+
+namelist /obs_assim_count_nml/ &
+ filename_in, calendar
+
+!----------------------------------------------------------------
+! Start of the program:
+!
+! Process each input observation sequence file in turn, optionally
+! selecting observations to insert into the output sequence file.
+!----------------------------------------------------------------
+
+call setup()
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "obs_assim_count_nml", iunit)
+read(iunit, nml = obs_assim_count_nml, iostat = io)
+call check_namelist_read(iunit, io, "obs_assim_count_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=obs_assim_count_nml)
+if (do_nml_term()) write( * , nml=obs_assim_count_nml)
+
+! the default is a gregorian calendar. if you are using a different type
+! set it in the namelist. this only controls how it prints out the first
+! and last timestamps in the obs_seq files.
+call set_calendar_type(calendar)
+
+! set a logial to see if we have a calendar or not
+cal = (get_calendar_type() /= NO_CALENDAR)
+
+! if you add anything to the namelist, you can process it here.
+
+! end of namelist processing and setup
+
+
+! single pass algorithm (unlike other obs tools).
+
+call read_obs_seq_header(filename_in, num_copies_in, num_qc_in, &
+ size_seq_in, max_num_obs, file_id, read_format, pre_I_format, &
+ close_the_file = .true.)
+
+if (max_num_obs == 0) then
+ write(msgstring,*) 'No obs in input sequence file ', trim(filename_in)
+ call error_handler(E_ERR,'obs_assim_count',msgstring)
+endif
+
+write(msgstring, *) 'Starting to process input sequence file: '
+write(msgstring1,*) trim(filename_in)
+call error_handler(E_MSG,'obs_assim_count',msgstring, &
+ text2=msgstring1)
+
+call read_obs_seq(filename_in, 0, 0, 0, seq_in)
+
+! sanity check - ensure the linked list times are in increasing time order
+call validate_obs_seq_time(seq_in, filename_in)
+
+! the counting up is done here now.
+call print_obs_seq_info(seq_in, filename_in)
+
+! clean up
+
+call destroy_obs_sequence(seq_in)
+
+call shutdown()
+
+!---------------------------------------------------------------------
+! end of main program.
+!---------------------------------------------------------------------
+
+
+contains
+
+
+!---------------------------------------------------------------------
+subroutine setup()
+
+! Initialize modules used that require it
+call initialize_utilities('obs_assim_count')
+call register_module(source, revision, revdate)
+call static_init_obs_sequence()
+
+end subroutine setup
+
+
+!---------------------------------------------------------------------
+subroutine shutdown()
+
+call finalize_utilities('obs_assim_count')
+
+end subroutine shutdown
+
+
+!---------------------------------------------------------------------
+subroutine print_obs_seq_info(seq_in, filename)
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick table of obs types and counts, overall start and
+! stop times, and metadata strings and counts.
+
+! and this one counts up, if there is a 'posterior ensemble mean' copy,
+! how many are missing_r8 and how many are not. it could also count
+! up the 'DART quality control' settings? start with the latter for now.
+
+type(obs_sequence_type), intent(in) :: seq_in
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq_in
+integer :: i
+integer :: this_obs_type
+integer :: type_count(0:max_defined_types_of_obs), identity_count, qc_count(0:8), qcindex
+real(r8) :: qcval(1)
+
+
+! Initialize counters
+type_count(:) = 0
+identity_count = 0
+qc_count(:) = 0
+
+size_seq_in = get_num_obs(seq_in)
+if (size_seq_in == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_assim_count',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq_in), get_num_qc(seq_in))
+call init_obs(next_obs, get_num_copies(seq_in), get_num_qc(seq_in))
+
+! find the dart qc copy, if there is one
+qcindex = get_dartqc_index(seq_in)
+
+! blank line
+call error_handler(E_MSG,'',' ')
+
+write(msgstring,*) 'Processing sequence file ', trim(filename)
+call error_handler(E_MSG,'',msgstring)
+
+call print_metadata(seq_in, filename)
+
+!-------------------------------------------------------------
+! Start to process obs from seq_in
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq_in, obs)
+
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first observation in ',trim(filename)
+ call error_handler(E_MSG,'obs_assim_count', msgstring)
+endif
+
+! process it here
+is_this_last = .false.
+
+call get_obs_def(obs, this_obs_def)
+call print_time(get_obs_def_time(this_obs_def), ' First timestamp: ')
+! does not work with NO_CALENDAR
+if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_obs_type = get_obs_def_type_of_obs(this_obs_def)
+ if (this_obs_type < 0) then
+ identity_count = identity_count + 1
+ else
+ type_count(this_obs_type) = type_count(this_obs_type) + 1
+ endif
+! print *, 'obs type index = ', this_obs_type
+! if(this_obs_type > 0)print *, 'obs name = ', get_name_for_type_of_obs(this_obs_type)
+ if (qcindex > 0) then
+ call get_qc(obs, qcval, qcindex)
+ qc_count(nint(qcval(1))) = qc_count(nint(qcval(1))) + 1
+ endif
+
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if (.not. is_this_last) then
+ obs = next_obs
+ else
+ call print_time(get_obs_def_time(this_obs_def), ' Last timestamp: ')
+ if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+ endif
+
+enddo ObsLoop
+
+
+write(msgstring, *) 'Number of obs processed : ', size_seq_in
+call error_handler(E_MSG, '', msgstring)
+write(msgstring, *) '---------------------------------------------------------'
+call error_handler(E_MSG, '', msgstring)
+do i = 0, max_defined_types_of_obs
+ if (type_count(i) > 0) then
+ write(msgstring, '(a32,i8,a)') trim(get_name_for_type_of_obs(i)), &
+ type_count(i), ' obs'
+ call error_handler(E_MSG, '', msgstring)
+ endif
+enddo
+if (identity_count > 0) then
+ write(msgstring, '(a32,i8,a)') 'Identity observations', &
+ identity_count, ' obs'
+ call error_handler(E_MSG, '', msgstring)
+endif
+if (qcindex > 0) then
+ call error_handler(E_MSG, '', ' ')
+ write(msgstring, *) 'DART QC results: '
+ call error_handler(E_MSG, '', msgstring)
+ do i=0, 7
+ if (qc_count(i) > 0) then
+ write(msgstring, '(a16,2(i8))') 'DART QC value', i, &
+ qc_count(i)
+ call error_handler(E_MSG, '', msgstring)
+ endif
+ enddo
+ write(msgstring, *) 'Total obs: ', sum(qc_count(:))
+ call error_handler(E_MSG, '', msgstring)
+endif
+
+! another blank line
+call error_handler(E_MSG, '', ' ')
+
+! Time to clean up
+
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+end subroutine print_obs_seq_info
+
+
+!---------------------------------------------------------------------
+subroutine validate_obs_seq_time(seq, filename)
+
+! this eventually belongs in the obs_seq_mod code, but for now
+! try it out here. we just fixed a hole in the interactive create
+! routine which would silently let you create out-of-time-order
+! linked lists, which gave no errors but didn't assimilate the
+! right obs at the right time when running filter. this runs
+! through the times in the entire sequence, ensuring they are
+! monotonically increasing in time. this should help catch any
+! bad files which were created with older versions of code.
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq, obs_count
+integer :: key
+type(time_type) :: last_time, this_time
+
+
+! make sure there are obs left to process before going on.
+size_seq = get_num_obs(seq)
+if (size_seq == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_assim_count:validate',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq), get_num_qc(seq))
+call init_obs(next_obs, get_num_copies(seq), get_num_qc(seq))
+
+obs_count = 0
+
+!-------------------------------------------------------------
+! Start to process obs from seq
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq, obs)
+
+! we already tested for 0 obs above, so there should be a first obs here.
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first obs in sequence ' // trim(filename)
+ call error_handler(E_ERR,'obs_assim_count:validate', &
+ msgstring, source, revision, revdate)
+ return
+endif
+
+is_this_last = .false.
+last_time = set_time(0, 0)
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+
+ if (last_time > this_time) then
+ ! bad time order of observations in linked list
+ call print_time(last_time, ' previous timestamp: ')
+ if (cal) call print_date(last_time, ' calendar date: ')
+ call print_time(this_time, ' next timestamp: ')
+ if (cal) call print_date(this_time, ' calendar date: ')
+
+ key = get_obs_key(obs)
+ write(msgstring1,*)'obs number ', key, ' has earlier time than previous obs'
+ write(msgstring2,*)'observations must be in increasing time order, file ' // trim(filename)
+ call error_handler(E_ERR,'obs_assim_count:validate', msgstring2, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ endif
+
+ last_time = this_time
+ obs_count = obs_count + 1
+
+ call get_next_obs(seq, obs, next_obs, is_this_last)
+ if (.not. is_this_last) obs = next_obs
+
+enddo ObsLoop
+
+! clean up
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+! technically not a time validation, but easy to check. obs_count should never
+! be larger than size_seq - that's a fatal error. obs_count < size_seq would
+! suggest there are obs in the file that aren't part of the linked list.
+! this does not necessarily indicate a fatal error but it's not a common
+! situation and might indicate someone should check on the file.
+if (obs_count /= size_seq) then
+ write(msgstring,*) 'input sequence ', trim(filename)
+ call error_handler(E_MSG,'obs_assim_count:validate', msgstring)
+
+ write(msgstring,*) 'total obs in file: ', size_seq, ' obs in linked list: ', obs_count
+ if (obs_count > size_seq) then
+ ! this is a fatal error
+ write(msgstring1,*) 'linked list obs_count > total size_seq, should not happen'
+ call error_handler(E_ERR,'obs_assim_count:validate', msgstring, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ else
+ ! just warning msg
+ write(msgstring1,*) 'only observations in linked list will be processed'
+ call error_handler(E_MSG,'obs_assim_count:validate', msgstring, &
+ source, revision, revdate, text2=msgstring1)
+ endif
+endif
+
+end subroutine validate_obs_seq_time
+
+
+!---------------------------------------------------------------------
+subroutine print_metadata(seq, fname)
+
+!
+! print out the metadata strings, trimmed
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), optional :: fname
+
+integer :: num_copies , num_qc, i
+character(len=metadatalength) :: str
+character(len=255) :: msgstring3
+
+num_copies = get_num_copies(seq)
+num_qc = get_num_qc( seq)
+
+if ( num_copies < 0 .or. num_qc < 0 ) then
+ write(msgstring3,*)' illegal copy or obs count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_assim_count', msgstring3, &
+ source, revision, revdate)
+endif
+
+MetaDataLoop : do i=1, num_copies
+ str = get_copy_meta_data(seq,i)
+
+ write(msgstring,*)'Data Metadata: ',trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo MetaDataLoop
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ write(msgstring,*)' QC Metadata: ', trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo QCMetaData
+
+end subroutine print_metadata
+
+
+!---------------------------------------------------------------------
+function get_dartqc_index(seq, fname)
+
+!
+! return the index number of the dart qc copy (-1 if none)
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), optional :: fname
+integer :: get_dartqc_index
+
+integer :: num_qc, i
+character(len=metadatalength) :: str
+character(len=255) :: msgstring3
+
+num_qc = get_num_qc( seq)
+
+if ( num_qc < 0 ) then
+ write(msgstring3,*)' illegal qc metadata count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_assim_count', msgstring3, &
+ source, revision, revdate)
+endif
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ if (str == 'DART quality control') then
+ get_dartqc_index = i
+ return
+ endif
+
+enddo QCMetaData
+
+get_dartqc_index = -1
+
+end function get_dartqc_index
+
+
+!---------------------------------------------------------------------
+end program obs_assim_count
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
diff --git a/assimilation_code/programs/obs_utils/obs_assim_count.nml b/assimilation_code/programs/obs_utils/obs_assim_count.nml
new file mode 100644
index 0000000000..c469162c68
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/obs_assim_count.nml
@@ -0,0 +1,4 @@
+&obs_assim_count_nml
+ filename_in = ''
+ calendar = 'GREGORIAN'
+/
diff --git a/assimilation_code/programs/obs_utils/obs_data_denial.f90 b/assimilation_code/programs/obs_utils/obs_data_denial.f90
new file mode 100644
index 0000000000..1a60c87ddd
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/obs_data_denial.f90
@@ -0,0 +1,600 @@
+! 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
+!
+! DART $Id$
+
+
+!> open an obs_seq file and randomly change the error variance of N of
+!> each obs type to a huge value before copying obs over to the output file.
+!> the value of N is namelist-settable. this effectively removes the
+!> impact of those observations on the assimilation. it is intended to
+!> help implement a data-denial experiment where you assimilate all obs
+!> (the original obs_seq file) and then with some obs disabled
+!> (the output obs_seq from this program) and compare the results.
+!> the default is to remove N of each obs type but the types of obs
+!> is also namelist-settable.
+
+!> THIS IS NOT YET DONE! it was cloned from obs_keep_a_few
+!> and has not been implemented yet.
+
+program obs_data_denial
+
+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, 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 :: max_count_per_type = 10
+integer :: max_total_count = -1
+
+logical :: print_only = .false.
+character(len=32) :: calendar = 'Gregorian'
+
+
+namelist /obs_data_denial_nml/ &
+ filename_in, filename_out, &
+ max_count_per_type, max_total_count, &
+ print_only, calendar
+
+!----------------------------------------------------------------
+! Start of the program:
+!
+! Process each input observation sequence file in turn, optionally
+! selecting observations to insert into the output sequence file.
+!----------------------------------------------------------------
+
+call setup()
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "obs_data_denial_nml", iunit)
+read(iunit, nml = obs_data_denial_nml, iostat = io)
+call check_namelist_read(iunit, io, "obs_data_denial_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=obs_data_denial_nml)
+if (do_nml_term()) write( * , nml=obs_data_denial_nml)
+
+! the default is a gregorian calendar. if you are using a different type
+! set it in the namelist. this only controls how it prints out the first
+! and last timestamps in the obs_seq files.
+call set_calendar_type(calendar)
+
+! set a logial to see if we have a calendar or not
+cal = (get_calendar_type() /= NO_CALENDAR)
+
+! if you add anything to the namelist, you can process it here.
+
+! end of namelist processing and setup
+
+! make space for the counts. 0 is for all identity obs.
+allocate(n_this_type(0:get_num_types_of_obs()))
+n_this_type(:) = 0
+
+! single pass algorithm (unlike other obs tools).
+
+call read_obs_seq_header(filename_in, num_copies_in, num_qc_in, &
+ size_seq_in, max_num_obs, file_id, read_format, pre_I_format, &
+ close_the_file = .true.)
+
+if (max_num_obs == 0) then
+ write(msgstring,*) 'No obs in input sequence file ', trim(filename_in)
+ call error_handler(E_ERR,'obs_data_denial',msgstring)
+endif
+
+write(msgstring, *) 'Starting to process input sequence file: '
+write(msgstring1,*) trim(filename_in)
+call error_handler(E_MSG,'obs_data_denial',msgstring, &
+ text2=msgstring1)
+
+call read_obs_seq(filename_in, 0, 0, 0, seq_in)
+
+! sanity check - ensure the linked list times are in increasing time order
+call validate_obs_seq_time(seq_in, filename_in)
+
+! output is same size (or less) than input, generally.
+! if this program is going to dup obs, account for it here.
+size_seq_out = max_num_obs
+
+! blank line, start of actually creating output file
+call error_handler(E_MSG,' ',' ')
+
+! Initialize individual observation variables
+call init_obs( obs_in, num_copies_in, num_qc_in)
+call init_obs(next_obs_in, num_copies_in, num_qc_in)
+call init_obs( obs_out, num_copies_in, num_qc_in)
+call init_obs(prev_obs_out, num_copies_in, num_qc_in)
+
+! create the output sequence here
+call init_obs_sequence(seq_out, num_copies_in, num_qc_in, size_seq_out)
+do j=1, num_copies_in
+ meta_data = get_copy_meta_data(seq_in, j)
+ call set_copy_meta_data(seq_out, j, meta_data)
+enddo
+do j=1, num_qc_in
+ meta_data = get_qc_meta_data(seq_in, j)
+ call set_qc_meta_data(seq_out, j, meta_data)
+enddo
+
+! is this needed?
+if (print_only) call print_obs_seq(seq_in, filename_in)
+
+!-------------------------------------------------------------
+! Start to insert obs from sequence_in into sequence_out
+!
+! NOTE: insert_obs_in_seq CHANGES the obs passed in.
+! Must pass a copy of incoming obs to insert_obs_in_seq.
+!--------------------------------------------------------------
+num_inserted = 0
+num_rejected_badqc = 0
+num_rejected_diffqc = 0
+num_rejected_other = 0
+
+if ( get_first_obs(seq_in, obs_in) ) then
+
+ is_this_last = .false.
+ next_obs_in = obs_in
+
+ ObsLoop : do while ( .not. is_this_last )
+
+ obs_in = next_obs_in
+
+ ! obs_out will be modified when it is inserted in the output sequence
+ ! so we have to make a copy of obs_in before modifiying it.
+ obs_out = obs_in
+
+ ! count up how many of this type you already have
+ ! and skip it if you've got enough.
+
+ call get_obs_def(obs_out, this_obs_def)
+
+ this_type = get_obs_def_type_of_obs(this_obs_def)
+
+ if (this_type < 0) this_type = 0 ! identity obs
+
+ if (n_this_type(this_type) < max_count_per_type .or. max_count_per_type < 0) then
+
+ ! copy to output obs_seq and increment the count for this type
+ n_this_type(this_type) = n_this_type(this_type) + 1
+
+ if (num_inserted > 0) then
+ call insert_obs_in_seq(seq_out, obs_out, prev_obs_out)
+ else
+ call insert_obs_in_seq(seq_out, obs_out)
+ endif
+
+ prev_obs_out = obs_out ! update position in seq for next insert
+ num_inserted = num_inserted + 1
+
+ if (print_every > 0) then
+ if (mod(num_inserted,print_every) == 0) then
+ print*, 'inserted number ',num_inserted,' of ',size_seq_out
+ endif
+ endif
+
+ endif
+
+ if (max_total_count > 0 .and. num_inserted >= max_total_count) exit ObsLoop
+
+ call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
+
+ enddo ObsLoop
+
+else
+ write(msgstring, *)'no first observation in ',trim(filename_in)
+ call error_handler(E_MSG,'obs_data_denial', msgstring)
+endif
+
+if (.not. print_only) then
+ print*, '--------- Obs seqs '
+ print*, 'Number of obs input sequence : ', size_seq_in
+ print*, 'Number of obs copied to output : ', num_inserted
+ print*, '---------------------------------------------------------'
+endif
+
+
+write(msgstring, *) 'Starting to process output sequence file ', &
+ trim(filename_out)
+call error_handler(E_MSG,'obs_data_denial',msgstring)
+
+print*, 'Number of obs in the output seq file :', get_num_key_range(seq_out)
+
+call print_obs_seq(seq_out, filename_out)
+if (.not. print_only) then
+ call write_obs_seq(seq_out, filename_out)
+else
+ write(msgstring,*) 'Output sequence file not created; print_only in namelist is .true.'
+ call error_handler(E_MSG,'', msgstring)
+endif
+
+! clean up
+
+call destroy_obs_sequence(seq_in)
+call destroy_obs_sequence(seq_out)
+call destroy_obs( obs_in )
+call destroy_obs(next_obs_in )
+call destroy_obs( obs_out)
+!call destroy_obs(prev_obs_out) ! copy of something already deleted
+deallocate(n_this_type)
+
+call shutdown()
+
+!---------------------------------------------------------------------
+! end of main program.
+!---------------------------------------------------------------------
+
+
+contains
+
+
+!---------------------------------------------------------------------
+subroutine setup()
+
+! Initialize modules used that require it
+call initialize_utilities('obs_data_denial')
+call register_module(source,revision,revdate)
+call static_init_obs_sequence()
+
+call error_handler(E_ERR, 'obs_data_denial', 'this program is not finished yet', &
+ source, revision, revdate, text2='contact dart@ucar.edu for more info')
+
+end subroutine setup
+
+
+!---------------------------------------------------------------------
+subroutine shutdown()
+
+call finalize_utilities('obs_data_denial')
+
+end subroutine shutdown
+
+
+!---------------------------------------------------------------------
+subroutine print_obs_seq(seq_in, filename)
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick table of obs types and counts, overall start and
+! stop times, and metadata strings and counts.
+
+type(obs_sequence_type), intent(in) :: seq_in
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq_in
+integer :: i
+integer :: this_obs_kind
+! max_defined_types_of_obs is a public from obs_kind_mod.f90 and really is
+! counting the max number of types, not kinds
+integer :: type_count(max_defined_types_of_obs), identity_count
+
+
+! Initialize input obs_types
+do i = 1, max_defined_types_of_obs
+ type_count(i) = 0
+enddo
+identity_count = 0
+
+! make sure there are obs left to process before going on.
+! num_obs should be ok since we just constructed this seq so it should
+! have no unlinked obs. if it might for some reason, use this instead:
+! size_seq_in = get_num_key_range(seq_in) !current size of seq_in
+
+size_seq_in = get_num_obs(seq_in)
+if (size_seq_in == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_data_denial',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq_in), get_num_qc(seq_in))
+call init_obs(next_obs, get_num_copies(seq_in), get_num_qc(seq_in))
+
+! blank line
+call error_handler(E_MSG,'',' ')
+
+write(msgstring,*) 'Processing sequence file ', trim(filename)
+call error_handler(E_MSG,'',msgstring)
+
+call print_metadata(seq_in, filename)
+
+!-------------------------------------------------------------
+! Start to process obs from seq_in
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq_in, obs)
+
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first observation in ',trim(filename)
+ call error_handler(E_MSG,'obs_data_denial', msgstring)
+endif
+
+! process it here
+is_this_last = .false.
+
+call get_obs_def(obs, this_obs_def)
+call print_time(get_obs_def_time(this_obs_def), ' First timestamp: ')
+! does not work with NO_CALENDAR
+if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_obs_kind = get_obs_def_type_of_obs(this_obs_def)
+ if (this_obs_kind < 0) then
+ identity_count = identity_count + 1
+ else
+ type_count(this_obs_kind) = type_count(this_obs_kind) + 1
+ endif
+! print *, 'obs kind index = ', this_obs_kind
+! if(this_obs_kind > 0)print *, 'obs name = ', get_name_for_type_of_obs(this_obs_kind)
+
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if (.not. is_this_last) then
+ obs = next_obs
+ else
+ call print_time(get_obs_def_time(this_obs_def), ' Last timestamp: ')
+ if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+ endif
+
+enddo ObsLoop
+
+
+write(msgstring, *) 'Number of obs processed : ', size_seq_in
+call error_handler(E_MSG, '', msgstring)
+write(msgstring, *) '---------------------------------------------------------'
+call error_handler(E_MSG, '', msgstring)
+do i = 1, max_defined_types_of_obs
+ if (type_count(i) > 0) then
+ write(msgstring, '(a32,i8,a)') trim(get_name_for_type_of_obs(i)), &
+ type_count(i), ' obs'
+ call error_handler(E_MSG, '', msgstring)
+ endif
+enddo
+if (identity_count > 0) then
+ write(msgstring, '(a32,i8,a)') 'Identity observations', &
+ identity_count, ' obs'
+ call error_handler(E_MSG, '', msgstring)
+endif
+
+! another blank line
+call error_handler(E_MSG, '', ' ')
+
+! Time to clean up
+
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+end subroutine print_obs_seq
+
+
+!---------------------------------------------------------------------
+subroutine validate_obs_seq_time(seq, filename)
+
+! this eventually belongs in the obs_seq_mod code, but for now
+! try it out here. we just fixed a hole in the interactive create
+! routine which would silently let you create out-of-time-order
+! linked lists, which gave no errors but didn't assimilate the
+! right obs at the right time when running filter. this runs
+! through the times in the entire sequence, ensuring they are
+! monotonically increasing in time. this should help catch any
+! bad files which were created with older versions of code.
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq, obs_count
+integer :: key
+type(time_type) :: last_time, this_time
+
+
+! make sure there are obs left to process before going on.
+size_seq = get_num_obs(seq)
+if (size_seq == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_data_denial:validate',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq), get_num_qc(seq))
+call init_obs(next_obs, get_num_copies(seq), get_num_qc(seq))
+
+obs_count = 0
+
+!-------------------------------------------------------------
+! Start to process obs from seq
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq, obs)
+
+! we already tested for 0 obs above, so there should be a first obs here.
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first obs in sequence ' // trim(filename)
+ call error_handler(E_ERR,'obs_data_denial:validate', &
+ msgstring, source, revision, revdate)
+ return
+endif
+
+is_this_last = .false.
+last_time = set_time(0, 0)
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+
+ if (last_time > this_time) then
+ ! bad time order of observations in linked list
+ call print_time(last_time, ' previous timestamp: ')
+ if (cal) call print_date(last_time, ' calendar date: ')
+ call print_time(this_time, ' next timestamp: ')
+ if (cal) call print_date(this_time, ' calendar date: ')
+
+ key = get_obs_key(obs)
+ write(msgstring1,*)'obs number ', key, ' has earlier time than previous obs'
+ write(msgstring2,*)'observations must be in increasing time order, file ' // trim(filename)
+ call error_handler(E_ERR,'obs_data_denial:validate', msgstring2, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ endif
+
+ last_time = this_time
+ obs_count = obs_count + 1
+
+ call get_next_obs(seq, obs, next_obs, is_this_last)
+ if (.not. is_this_last) obs = next_obs
+
+enddo ObsLoop
+
+! clean up
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+! technically not a time validation, but easy to check. obs_count should never
+! be larger than size_seq - that's a fatal error. obs_count < size_seq would
+! suggest there are obs in the file that aren't part of the linked list.
+! this does not necessarily indicate a fatal error but it's not a common
+! situation and might indicate someone should check on the file.
+if (obs_count /= size_seq) then
+ write(msgstring,*) 'input sequence ', trim(filename)
+ call error_handler(E_MSG,'obs_data_denial:validate', msgstring)
+
+ write(msgstring,*) 'total obs in file: ', size_seq, ' obs in linked list: ', obs_count
+ if (obs_count > size_seq) then
+ ! this is a fatal error
+ write(msgstring1,*) 'linked list obs_count > total size_seq, should not happen'
+ call error_handler(E_ERR,'obs_data_denial:validate', msgstring, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ else
+ ! just warning msg
+ write(msgstring1,*) 'only observations in linked list will be processed'
+ call error_handler(E_MSG,'obs_data_denial:validate', msgstring, &
+ source, revision, revdate, text2=msgstring1)
+ endif
+endif
+
+end subroutine validate_obs_seq_time
+
+
+!---------------------------------------------------------------------
+subroutine print_metadata(seq, fname)
+
+!
+! print out the metadata strings, trimmed
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), optional, intent(in) :: fname
+
+integer :: num_copies , num_qc, i
+character(len=metadatalength) :: str
+
+num_copies = get_num_copies(seq)
+num_qc = get_num_qc( seq)
+
+if ( num_copies < 0 .or. num_qc < 0 ) then
+ write(msgstring3,*)' illegal copy or obs count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_data_denial', msgstring3, &
+ source, revision, revdate)
+endif
+
+MetaDataLoop : do i=1, num_copies
+ str = get_copy_meta_data(seq,i)
+
+ write(msgstring,*)'Data Metadata: ',trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo MetaDataLoop
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ write(msgstring,*)' QC Metadata: ', trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo QCMetaData
+
+end subroutine print_metadata
+
+
+!---------------------------------------------------------------------
+end program obs_data_denial
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/assimilation_code/programs/obs_utils/obs_info.f90 b/assimilation_code/programs/obs_utils/obs_info.f90
new file mode 100644
index 0000000000..8392179397
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/obs_info.f90
@@ -0,0 +1,679 @@
+! 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
+!
+! DART $Id$
+
+!> print out information about observation sequence file(s).
+!> summarizes obs types, times, counts.
+
+program obs_info
+
+use types_mod, only : r8, missing_r8, metadatalength, obstypelength
+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 parse_args_mod, only : get_args_from_string
+use location_mod, only : location_type, get_location, set_location, &
+ write_location
+use obs_def_mod, only : obs_def_type, get_obs_def_time, &
+ get_obs_def_type_of_obs, get_obs_def_location
+use obs_kind_mod, only : max_defined_types_of_obs, get_name_for_type_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(-), set_time_missing, operator(<)
+use obs_sequence_mod, only : obs_sequence_type, obs_type, write_obs_seq, &
+ init_obs, assignment(=), get_obs_def, &
+ static_init_obs_sequence, &
+ read_obs_seq_header, read_obs_seq, get_num_obs, &
+ get_first_obs, get_next_obs, &
+ get_num_copies, get_num_qc, &
+ get_copy_meta_data, get_qc_meta_data, &
+ destroy_obs, destroy_obs_sequence, &
+ get_num_key_range, get_obs_key, get_qc, &
+ get_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$"
+character(len=128), parameter :: id = "$Id$"
+
+type(obs_sequence_type) :: seq_in
+type(obs_type) :: obs_in, next_obs_in
+logical :: is_this_last
+integer :: size_seq_in
+integer :: num_copies_in, num_qc_in
+integer :: iunit, io, i, fnum
+integer :: num_input_files = 0
+integer :: max_num_obs, file_id
+character(len=129) :: read_format
+logical :: pre_I_format, cal
+character(len=512) :: msgstring, msgstring1, msgstring2, msgstring3
+type(obs_def_type) :: this_obs_def
+type(time_type) :: obs_time
+
+! 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 = 600
+
+type obs_info_type
+ integer :: count
+ type(time_type) :: first_time
+ type(time_type) :: last_time
+end type
+
+! in spite of the name, this is the number of specific types.
+! also one for all obs types.
+type(obs_info_type) :: oinfo(0:max_defined_types_of_obs)
+type(obs_info_type) :: all_obs
+
+type(location_type) :: location
+integer :: obs_type_ind
+character(len=256) :: string
+
+!----------------------------------------------------------------
+! Namelist input with default values
+
+integer, parameter :: MAX_IN_FILES = 5000
+
+character(len=256) :: filename_in(MAX_IN_FILES) = ''
+character(len=256) :: filelist_in = ''
+character(len=32) :: calendar = 'Gregorian'
+logical :: filenames_from_terminal = .false.
+
+
+namelist /obs_info_nml/ filename_in, filelist_in, &
+ calendar, filenames_from_terminal
+
+!----------------------------------------------------------------
+! Start of the program:
+!
+! Process the input observations in the input sequence file
+!----------------------------------------------------------------
+
+call setup()
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "obs_info_nml", iunit)
+read(iunit, nml = obs_info_nml, iostat = io)
+call check_namelist_read(iunit, io, "obs_info_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=obs_info_nml)
+if (do_nml_term()) write( * , nml=obs_info_nml)
+
+! the default is a gregorian calendar. if you are using a different type
+! set it in the namelist. this only controls how it prints out the first
+! and last timestamps in the obs_seq files.
+call set_calendar_type(calendar)
+
+! set a logial to see if we have a calendar or not
+cal = (get_calendar_type() /= NO_CALENDAR)
+
+! after this call, filelist_in() has the names
+if (filenames_from_terminal) then
+ call parse_filenames_from_stdin(num_input_files, filename_in)
+else
+ call handle_filenames(filename_in, filelist_in, num_input_files)
+endif
+
+! end of namelist processing and setup
+
+! for each file...
+
+do fnum = 1, num_input_files
+
+ ! initialize the bookkeeping structures
+ do i=0, max_defined_types_of_obs
+ call initialize(oinfo(i))
+ enddo
+ call initialize(all_obs)
+
+ ! single pass algorithm (unlike other obs tools).
+
+ call read_obs_seq_header(filename_in(fnum), num_copies_in, num_qc_in, &
+ size_seq_in, max_num_obs, file_id, read_format, pre_I_format, &
+ close_the_file = .true.)
+
+ if (max_num_obs == 0) then
+ write(msgstring,*) 'No obs in input sequence file ', trim(filename_in(fnum))
+ call error_handler(E_ERR,'obs_info',msgstring)
+ endif
+
+ write(msgstring, *) 'Starting to process input sequence file: '
+ write(msgstring1,*) trim(filename_in(fnum))
+ call error_handler(E_MSG,'obs_info',msgstring, &
+ text2=msgstring1)
+
+ call read_obs_seq(filename_in(fnum), 0, 0, 0, seq_in)
+
+ ! sanity check - ensure the linked list times are in increasing time order
+ call validate_obs_seq_time(seq_in, filename_in(fnum))
+
+ ! blank line
+ call error_handler(E_MSG,' ',' ')
+
+ ! Initialize individual observation variables
+ call init_obs( obs_in, num_copies_in, num_qc_in)
+ call init_obs(next_obs_in, num_copies_in, num_qc_in)
+
+ !-------------------------------------------------------------
+ ! Start of obs loop
+ !--------------------------------------------------------------
+
+ if ( get_first_obs(seq_in, obs_in) ) then
+
+ is_this_last = .false.
+ next_obs_in = obs_in
+
+ ObsLoop : do while ( .not. is_this_last )
+
+ obs_in = next_obs_in
+
+ ! get obs_def info
+ call get_obs_def(obs_in, this_obs_def)
+ location = get_obs_def_location(this_obs_def)
+ obs_type_ind = get_obs_def_type_of_obs(this_obs_def)
+ obs_time = get_obs_def_time(this_obs_def)
+
+ call update(all_obs, obs_time)
+ call update(oinfo(obs_type_ind), obs_time)
+
+ call write_location(0, location, charstring = string)
+ !write(*, *) trim(string) // ' ' // trim(get_name_for_type_of_obs(obs_type_ind))
+
+ call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
+
+ enddo ObsLoop
+
+ else
+ write(msgstring, *)'no first observation in ',trim(filename_in(fnum))
+ call error_handler(E_MSG,'obs_info', msgstring)
+ endif
+
+ print*, 'Totals for all obs types:'
+ print*, ' Count: ', all_obs%count
+ call print_date(all_obs%first_time, '. First obs:')
+ call print_date(all_obs%last_time, '. Last obs:')
+ print*, '---------------------------------------------------------'
+
+
+ ! print out the results
+ ALLTYPES: do i=0, max_defined_types_of_obs
+ if (oinfo(i)%count == 0) cycle ALLTYPES
+ write(msgstring, '(A,I8)') get_name_for_type_of_obs(i), oinfo(i)%count
+ call error_handler(E_MSG, '', msgstring)
+ call print_date(oinfo(i)%first_time, '. First obs:')
+ call print_date(oinfo(i)%last_time, '. Last obs:')
+ enddo ALLTYPES
+
+ call destroy_obs_sequence(seq_in)
+ call destroy_obs( obs_in )
+ call destroy_obs(next_obs_in )
+
+enddo
+
+call shutdown()
+
+!---------------------------------------------------------------------
+! end of main program.
+!---------------------------------------------------------------------
+
+
+contains
+
+
+!---------------------------------------------------------------------
+subroutine setup()
+
+! Initialize modules used that require it
+call initialize_utilities('obs_info')
+call register_module(source,revision,revdate)
+call static_init_obs_sequence()
+
+end subroutine setup
+
+
+!---------------------------------------------------------------------
+subroutine shutdown()
+
+call finalize_utilities('obs_info')
+
+end subroutine shutdown
+
+
+!---------------------------------------------------------------------
+subroutine initialize(op)
+
+! set everything to 0 or missing
+
+type(obs_info_type), intent(inout) :: op
+
+op%count = 0
+
+op%first_time = set_time_missing()
+op%last_time = set_time_missing()
+
+end subroutine initialize
+
+!---------------------------------------------------------------------
+subroutine update(op, otime)
+
+! add one to the count and set the time if either are outliers
+
+type(obs_info_type), intent(inout) :: op
+type(time_type), intent(in) :: otime
+
+op%count = op%count + 1
+
+if (op%first_time == set_time_missing()) then
+ op%first_time = otime
+else
+ if (otime < op%first_time) op%first_time = otime
+endif
+
+if (op%last_time == set_time_missing()) then
+ op%last_time = otime
+else
+ if (otime > op%last_time) op%last_time = otime
+endif
+
+end subroutine update
+
+!---------------------------------------------------------------------
+subroutine print_obs_seq(seq_in, filename)
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick table of obs types and counts, overall start and
+! stop times, and metadata strings and counts.
+
+type(obs_sequence_type), intent(in) :: seq_in
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq_in
+integer :: i
+integer :: this_obs_type
+integer :: type_count(max_defined_types_of_obs), identity_count
+
+
+! Initialize input obs_types
+do i = 0, max_defined_types_of_obs
+ type_count(i) = 0
+enddo
+identity_count = 0
+
+! make sure there are obs left to process before going on.
+! num_obs should be ok since we just constructed this seq so it should
+! have no unlinked obs. if it might for some reason, use this instead:
+! size_seq_in = get_num_key_range(seq_in) !current size of seq_in
+
+size_seq_in = get_num_obs(seq_in)
+if (size_seq_in == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_info',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq_in), get_num_qc(seq_in))
+call init_obs(next_obs, get_num_copies(seq_in), get_num_qc(seq_in))
+
+! blank line
+call error_handler(E_MSG,'',' ')
+
+write(msgstring,*) 'Processing sequence file ', trim(filename)
+call error_handler(E_MSG,'',msgstring)
+
+call print_metadata(seq_in, filename)
+
+!-------------------------------------------------------------
+! Start to process obs from seq_in
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq_in, obs)
+
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first observation in ',trim(filename)
+ call error_handler(E_MSG,'obs_info', msgstring)
+endif
+
+! process it here
+is_this_last = .false.
+
+call get_obs_def(obs, this_obs_def)
+call print_time(get_obs_def_time(this_obs_def), ' First timestamp: ')
+! does not work with NO_CALENDAR
+if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_obs_type = get_obs_def_type_of_obs(this_obs_def)
+ if (this_obs_type < 0) then
+ identity_count = identity_count + 1
+ else
+ type_count(this_obs_type) = type_count(this_obs_type) + 1
+ endif
+! print *, 'obs type index = ', this_obs_type
+! if(this_obs_type > 0)print *, 'obs name = ', get_name_for_type_of_obs(this_obs_type)
+
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if (.not. is_this_last) then
+ obs = next_obs
+ else
+ call print_time(get_obs_def_time(this_obs_def), ' Last timestamp: ')
+ if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+ endif
+
+enddo ObsLoop
+
+
+write(msgstring, *) 'Number of obs processed : ', size_seq_in
+call error_handler(E_MSG, '', msgstring)
+write(msgstring, *) '---------------------------------------------------------'
+call error_handler(E_MSG, '', msgstring)
+do i = 0, max_defined_types_of_obs
+ if (type_count(i) > 0) then
+ write(msgstring, '(a32,i8,a)') trim(get_name_for_type_of_obs(i)), &
+ type_count(i), ' obs'
+ call error_handler(E_MSG, '', msgstring)
+ endif
+enddo
+if (identity_count > 0) then
+ write(msgstring, '(a32,i8,a)') 'Identity observations', &
+ identity_count, ' obs'
+ call error_handler(E_MSG, '', msgstring)
+endif
+
+! another blank line
+call error_handler(E_MSG, '', ' ')
+
+! Time to clean up
+
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+end subroutine print_obs_seq
+
+
+!---------------------------------------------------------------------
+subroutine validate_obs_seq_time(seq, filename)
+
+! this eventually belongs in the obs_seq_mod code, but for now
+! try it out here. we just fixed a hole in the interactive create
+! routine which would silently let you create out-of-time-order
+! linked lists, which gave no errors but didn't assimilate the
+! right obs at the right time when running filter. this runs
+! through the times in the entire sequence, ensuring they are
+! monotonically increasing in time. this should help catch any
+! bad files which were created with older versions of code.
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq, obs_count
+integer :: key
+type(time_type) :: last_time, this_time
+
+
+! make sure there are obs left to process before going on.
+size_seq = get_num_obs(seq)
+if (size_seq == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_info:validate',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq), get_num_qc(seq))
+call init_obs(next_obs, get_num_copies(seq), get_num_qc(seq))
+
+obs_count = 0
+
+!-------------------------------------------------------------
+! Start to process obs from seq
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq, obs)
+
+! we already tested for 0 obs above, so there should be a first obs here.
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first obs in sequence ' // trim(filename)
+ call error_handler(E_ERR,'obs_info:validate', &
+ msgstring, source, revision, revdate)
+ return
+endif
+
+is_this_last = .false.
+last_time = set_time(0, 0)
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+
+ if (last_time > this_time) then
+ ! bad time order of observations in linked list
+ call print_time(last_time, ' previous timestamp: ')
+ if (cal) call print_date(last_time, ' calendar date: ')
+ call print_time(this_time, ' next timestamp: ')
+ if (cal) call print_date(this_time, ' calendar date: ')
+
+ key = get_obs_key(obs)
+ write(msgstring1,*)'obs number ', key, ' has earlier time than previous obs'
+ write(msgstring2,*)'observations must be in increasing time order, file ' // trim(filename)
+ call error_handler(E_ERR,'obs_info:validate', msgstring2, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ endif
+
+ last_time = this_time
+ obs_count = obs_count + 1
+
+ call get_next_obs(seq, obs, next_obs, is_this_last)
+ if (.not. is_this_last) obs = next_obs
+
+enddo ObsLoop
+
+! clean up
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+! technically not a time validation, but easy to check. obs_count should never
+! be larger than size_seq - that's a fatal error. obs_count < size_seq would
+! suggest there are obs in the file that aren't part of the linked list.
+! this does not necessarily indicate a fatal error but it's not a common
+! situation and might indicate someone should check on the file.
+if (obs_count /= size_seq) then
+ write(msgstring,*) 'input sequence ', trim(filename)
+ call error_handler(E_MSG,'obs_info:validate', msgstring)
+
+ write(msgstring,*) 'total obs in file: ', size_seq, ' obs in linked list: ', obs_count
+ if (obs_count > size_seq) then
+ ! this is a fatal error
+ write(msgstring1,*) 'linked list obs_count > total size_seq, should not happen'
+ call error_handler(E_ERR,'obs_info:validate', msgstring, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ else
+ ! just warning msg
+ write(msgstring1,*) 'only observations in linked list will be processed'
+ call error_handler(E_MSG,'obs_info:validate', msgstring, &
+ source, revision, revdate, text2=msgstring1)
+ endif
+endif
+
+end subroutine validate_obs_seq_time
+
+
+!---------------------------------------------------------------------
+subroutine print_metadata(seq, fname)
+
+!
+! print out the metadata strings, trimmed
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), optional, intent(in) :: fname
+
+integer :: num_copies , num_qc, i
+character(len=metadatalength) :: str
+
+num_copies = get_num_copies(seq)
+num_qc = get_num_qc( seq)
+
+if ( num_copies < 0 .or. num_qc < 0 ) then
+ write(msgstring3,*)' illegal copy or obs count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_info', msgstring3, &
+ source, revision, revdate)
+endif
+
+MetaDataLoop : do i=1, num_copies
+ str = get_copy_meta_data(seq,i)
+
+ write(msgstring,*)'Data Metadata: ',trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo MetaDataLoop
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ write(msgstring,*)' QC Metadata: ', trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo QCMetaData
+
+end subroutine print_metadata
+
+
+!---------------------------------------------------------------------
+subroutine parse_filenames_from_stdin(num_in, filenames)
+integer, intent(out) :: num_in
+character(len=*), intent(out) :: filenames(:)
+
+character(len=512) :: inline
+
+! let the user know, if they don't type anything, why we are
+! waiting for input. comment this out if it gets annoying.
+print *, 'reading input filename(s) from terminal'
+
+read (*, '(A512)'), inline
+call get_args_from_string(inline, num_in, filenames)
+
+end subroutine parse_filenames_from_stdin
+
+!---------------------------------------------------------------------
+subroutine handle_filenames(filename_in, filelist_in, num_input_files)
+! sort out the input lists, set the length if not given by user,
+! make sure what's specified is consistent.
+character(len=*), intent(inout) :: filename_in(:)
+character(len=*), intent(in) :: filelist_in
+integer, intent(inout) :: num_input_files
+
+integer :: index
+logical :: from_file
+character(len=32) :: fsource
+
+! ok, here's the new logic:
+! if the user specifies neither filename_in nor filelist_in, we
+! default to trying 'obs_seq.out' and num files = 1.
+! if the user specifies both, it's an error.
+! if the user gives a filelist, we make sure the length is not more
+! than maxfiles and read it into the explicit list and continue.
+! if num_input_files = 0, we count up the non-null items in the list
+! and set num_input_files to that.
+! if the user specifies num_input_files but it doesn't match the list length,
+! we give an error (and maybe suggest 0 if they don't want to keep
+! updating the num_input_files.)
+
+! default case - input file is 'obs_seq.out' and count is 1.
+if (filename_in(1) == '' .and. filelist_in == '') then
+
+ if (num_input_files /= 0 .and. num_input_files /= 1) then
+ call error_handler(E_ERR,'obs_info', &
+ 'if no filenames specified, num_input_files must be 0 or 1', &
+ source,revision,revdate)
+ endif
+
+ num_input_files = 1
+ filename_in(1) = 'obs_seq.out'
+ return
+endif
+
+! make sure the namelist specifies one or the other but not both
+if (filename_in(1) /= '' .and. filelist_in /= '') then
+ call error_handler(E_ERR,'obs_info', &
+ 'cannot specify both filename_in and filelist_in', &
+ source,revision,revdate)
+endif
+
+! if they have specified a file which contains a list, read it into
+! the filename_in array and set the count.
+if (filelist_in /= '') then
+ fsource = 'filelist_in'
+ from_file = .true.
+else
+ fsource = 'filename_in'
+ from_file = .false.
+endif
+
+do index = 1, MAX_IN_FILES
+ if (from_file) &
+ filename_in(index) = get_next_filename(filelist_in, index)
+
+ if (filename_in(index) == '') then
+ if (index == 1) then
+ call error_handler(E_ERR,'obs_info', &
+ 'namelist item '//trim(fsource)//' contains no filenames', &
+ source,revision,revdate)
+ endif
+ ! leaving num_input_files unspecified (or set to 0) means use
+ ! whatever number of files is in the list.
+ if (num_input_files == 0) then
+ num_input_files = index - 1
+ return
+ else
+ ! if they do give a count, make it match.
+ if (num_input_files == (index - 1)) return
+
+ write(msgstring, *) 'num_input_files is ', num_input_files, &
+ ' but namelist item '//trim(fsource)//' has filecount ', index - 1
+
+ write(msgstring2, *) 'if num_input_files is 0, the number of files will be automatically computed'
+ write(msgstring3, *) 'if num_input_files is not 0, it must match the number of filenames specified'
+
+ call error_handler(E_ERR,'obs_info', msgstring, &
+ source,revision,revdate, text2=msgstring2, text3=msgstring3)
+
+ endif
+ endif
+enddo
+
+write(msgstring, *) 'cannot specify more than ',MAX_IN_FILES,' files'
+call error_handler(E_ERR,'obs_info', msgstring, &
+ source,revision,revdate)
+
+end subroutine handle_filenames
+
+
+!---------------------------------------------------------------------
+end program obs_info
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/assimilation_code/programs/obs_utils/obs_info.nml b/assimilation_code/programs/obs_utils/obs_info.nml
new file mode 100644
index 0000000000..a3240622b3
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/obs_info.nml
@@ -0,0 +1,7 @@
+
+&obs_info_nml
+ filename_in = 'obs_seq.out'
+ filelist_in = ''
+ calendar = 'Gregorian'
+ /
+
diff --git a/assimilation_code/programs/obs_utils/obs_remove_dups.f90 b/assimilation_code/programs/obs_utils/obs_remove_dups.f90
new file mode 100644
index 0000000000..74179bd7ca
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/obs_remove_dups.f90
@@ -0,0 +1,829 @@
+! 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
+!
+! DART $Id$
+
+!> This file contains 1 module and 1 program. the module code has
+!> to come first, so page down for the main program.
+!> The module is a custom sort routine needed to compare 2 observations,
+!> and then the program uses the sort to match duplicate observations
+!> in an obs_seq file.
+
+
+!> Module:
+!> Routine to sort observations at the same time into a consistent order.
+!> Obs sequence files are guarenteed to be traversed in time order;
+!> running them through the standard obs_sequence_tool will physically
+!> order them in the file in the same way a linked-list traversal would.
+!>
+!> But for multiple obs at the same time there is no way to indicate or
+!> control how to order them relative to each other. This tool sorts
+!> same-time obs based on location, then kind, then variance. If there
+!> are duplicate obs in the same file this helps get them together and
+!> pass through only one copy of the observation.
+
+module special_sort
+
+use types_mod, only : r8
+use sort_mod, only : index_sort
+use location_mod, only : location_type, get_location, set_location, &
+ LocationName, read_location, operator(/=), &
+ write_location, LocationDims
+use obs_def_mod, only : obs_def_type, get_obs_def_time, get_obs_def_type_of_obs, &
+ get_obs_def_location, get_obs_def_error_variance, operator(==)
+use time_manager_mod, only : time_type, operator(/=), print_time
+use obs_sequence_mod, only : get_obs_def, obs_type
+
+implicit none
+private
+
+public :: obssort, obs_this_bin
+
+type(obs_type), allocatable :: obs_this_bin(:)
+
+contains
+
+
+!---------------------------------------------------------------------
+
+function obssort(i, j)
+ integer, intent(in) :: i, j
+ integer :: obssort
+
+! this is requesting a compare of obs_this_bin(i) and obs_this_bin(j)
+! they should have identical times, so the compare needs to be by
+! location, type, value, etc. return -1 if i < j ; 0 if == ; 1 if i > j
+
+type(obs_def_type) :: this_obs_def1, this_obs_def2
+integer :: this_kind1, this_kind2
+type(location_type) :: this_loc1, this_loc2
+type(time_type) :: this_time1, this_time2
+real(r8) :: this_var1, this_var2
+real(r8) :: loc1(LocationDims), loc2(LocationDims) ! try for general?
+integer :: ndim
+character(len=129) :: locstring1, locstring2
+logical :: local_debug
+
+local_debug = .false.
+
+call get_obs_def(obs_this_bin(i), this_obs_def1)
+call get_obs_def(obs_this_bin(j), this_obs_def2)
+
+this_time1 = get_obs_def_time(this_obs_def1)
+this_time2 = get_obs_def_time(this_obs_def2)
+
+this_loc1 = get_obs_def_location(this_obs_def1)
+this_loc2 = get_obs_def_location(this_obs_def2)
+
+loc1 = get_location(this_loc1)
+loc2 = get_location(this_loc2)
+
+this_kind1 = get_obs_def_type_of_obs(this_obs_def1)
+this_kind2 = get_obs_def_type_of_obs(this_obs_def2)
+
+this_var1 = get_obs_def_error_variance(this_obs_def1)
+this_var2 = get_obs_def_error_variance(this_obs_def2)
+
+if (this_time1 /= this_time2) then
+ print *, 'error, times not the same'
+ print *, 'comparing items ', i, j
+ call print_time(this_time1, 'time1')
+ call print_time(this_time2, 'time2')
+ stop
+endif
+
+if (local_debug) then
+ print *, 'comparing items ', i, j
+ call print_time(this_time1, 'time: ')
+ print *, 'kinds ', this_kind1, this_kind2
+ print *, 'vars ', this_var1, this_var2
+ call write_location(0, this_loc1, charstring=locstring1)
+ call write_location(0, this_loc2, charstring=locstring2)
+ print *, 'locs: '
+ print *, trim(locstring1)
+ print *, trim(locstring2)
+ print *, ''
+endif
+
+! try for a general location solution
+do ndim=1, LocationDims
+
+ if (loc1(ndim) > loc2(ndim)) then
+ obssort = 1
+ return
+ else if (loc1(ndim) < loc2(ndim)) then
+ obssort = -1
+ return
+ endif
+
+enddo
+
+! locations the same, so try types
+if (this_kind1 > this_kind2) then
+ obssort = 1
+ return
+else if (this_kind1 < this_kind2) then
+ obssort = -1
+ return
+endif
+
+! same up to now, so try errors (variance)
+if (this_var1 > this_var2) then
+ obssort = 1
+ return
+else if (this_var1 < this_var2) then
+ obssort = -1
+ return
+endif
+
+! ok, i give up. they're the same.
+! or enough for us to not try to resort them.
+obssort = 0
+
+if (local_debug) then
+ print *, 'decided items ', i, j, ' are same'
+ call print_time(this_time1, 'time: ')
+ print *, 'kinds ', this_kind1, this_kind2
+ print *, 'vars ', this_var1, this_var2
+ call write_location(0, this_loc1, charstring=locstring1)
+ call write_location(0, this_loc2, charstring=locstring2)
+ print *, 'locs: '
+ print *, trim(locstring1)
+ print *, trim(locstring2)
+ print *, ''
+endif
+
+end function obssort
+
+end module special_sort
+
+!---------------------------------------------------------------------
+
+!> Program:
+!> simple program that opens an obs_seq file and loops over the obs
+!> and copies them to a new output file. this is intended to be a
+!> template for programs that want to alter existing obs in some simple way.
+
+program obs_remove_dups
+
+use types_mod, only : r8, missing_r8, metadatalength, obstypelength
+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 sort_mod, only : index_sort
+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, &
+ operator(==) !, print_obs_def
+use obs_kind_mod, only : max_defined_types_of_obs, get_name_for_type_of_obs
+use time_manager_mod, only : time_type, operator(>), print_time, set_time, &
+ print_date, set_calendar_type, operator(==), &
+ operator(/=), get_calendar_type, NO_CALENDAR, &
+ operator(-), set_time_missing
+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, &
+ get_num_key_range, get_obs_key, get_qc, &
+ copy_partial_obs, get_next_obs_from_key, &
+ get_obs_def, set_obs_def, operator(==), operator(/=)
+
+use special_sort
+
+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$"
+character(len=128), parameter :: id = "$Id$"
+
+type(obs_sequence_type) :: seq_in, seq_out
+type(obs_type) :: obs_in, next_obs_in, last_obs
+type(obs_type) :: obs_out, prev_obs_out
+type(time_type) :: this_time, prev_time
+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, sort_count, last_in
+integer, allocatable :: index(:)
+character(len = 129) :: read_format
+logical :: pre_I_format, cal
+character(len = 256) :: msgstring, msgstring1, msgstring2
+type(obs_def_type) :: this_obs_def, that_obs_def
+
+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 = 160) :: filename_in = ''
+character(len = 160) :: filename_out = ''
+
+! if true, only compare the obs_defs and not the obs values
+logical :: ignore_values = .false.
+
+logical :: print_only = .false.
+character(len=32) :: calendar = 'Gregorian'
+
+! true for more output
+logical :: debug = .false.
+
+namelist /obs_remove_dups_nml/ &
+ filename_in, filename_out, &
+ ignore_values, print_only, calendar, debug
+
+!----------------------------------------------------------------
+! Start of the program:
+!
+! Process each input observation sequence file in turn, optionally
+! selecting observations to insert into the output sequence file.
+!----------------------------------------------------------------
+
+call setup()
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "obs_remove_dups_nml", iunit)
+read(iunit, nml = obs_remove_dups_nml, iostat = io)
+call check_namelist_read(iunit, io, "obs_remove_dups_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=obs_remove_dups_nml)
+if (do_nml_term()) write( * , nml=obs_remove_dups_nml)
+
+! the default is a gregorian calendar. if you are using a different type
+! set it in the namelist. this only controls how it prints out the first
+! and last timestamps in the obs_seq files.
+call set_calendar_type(calendar)
+
+! set a logial to see if we have a calendar or not
+cal = (get_calendar_type() /= NO_CALENDAR)
+
+! if you add anything to the namelist, you can process it here.
+
+! end of namelist processing and setup
+
+
+! single pass algorithm (unlike other obs tools).
+
+call read_obs_seq_header(filename_in, num_copies_in, num_qc_in, &
+ size_seq_in, max_num_obs, file_id, read_format, pre_I_format, &
+ close_the_file = .true.)
+
+if (max_num_obs == 0) then
+ write(msgstring,*) 'No obs in input sequence file ', trim(filename_in)
+ call error_handler(E_ERR,'obs_remove_dups',msgstring)
+endif
+
+write(msgstring, *) 'Starting to process input sequence file: '
+write(msgstring1,*) trim(filename_in)
+call error_handler(E_MSG,'obs_remove_dups',msgstring, &
+ text2=msgstring1)
+
+call read_obs_seq(filename_in, 0, 0, 0, seq_in)
+
+! sanity check - ensure the linked list times are in increasing time order
+call validate_obs_seq_time(seq_in, filename_in)
+
+! output is same size (or less) than input, generally.
+! if this program is going to dup obs, account for it here.
+size_seq_out = max_num_obs
+
+! blank line, start of actually creating output file
+call error_handler(E_MSG,' ',' ')
+
+! Initialize individual observation variables
+call init_obs( obs_in, num_copies_in, num_qc_in)
+call init_obs(next_obs_in, num_copies_in, num_qc_in)
+call init_obs( obs_out, num_copies_in, num_qc_in)
+call init_obs(prev_obs_out, num_copies_in, num_qc_in)
+
+! space for sorting obs with the same timestamp
+allocate(obs_this_bin(max_num_obs), index(max_num_obs))
+do i=1, max_num_obs
+ call init_obs(obs_this_bin(i), num_copies_in, num_qc_in)
+enddo
+
+! create the output sequence here
+call init_obs_sequence(seq_out, num_copies_in, num_qc_in, size_seq_out)
+do j=1, num_copies_in
+ meta_data = get_copy_meta_data(seq_in, j)
+ call set_copy_meta_data(seq_out, j, meta_data)
+enddo
+do j=1, num_qc_in
+ meta_data = get_qc_meta_data(seq_in, j)
+ call set_qc_meta_data(seq_out, j, meta_data)
+enddo
+
+call print_obs_seq(seq_in, filename_in)
+
+!! is this needed?
+!if (print_only) call print_obs_seq(seq_in, filename_in)
+
+!-------------------------------------------------------------
+! Start to insert obs from sequence_in into sequence_out
+!
+! NOTE: insert_obs_in_seq CHANGES the obs passed in.
+! Must pass a copy of incoming obs to insert_obs_in_seq.
+!--------------------------------------------------------------
+num_inserted = 0
+
+if ( get_first_obs(seq_in, obs_in) ) then
+
+ is_this_last = .false.
+ next_obs_in = obs_in
+ call get_obs_def(obs_in, this_obs_def)
+ prev_time = get_obs_def_time(this_obs_def)
+
+ ObsLoop : do while ( .not. is_this_last )
+
+ obs_in = next_obs_in
+
+ ! obs_out will be modified when it is inserted in the output sequence
+ ! so we have to make a copy of obs_in before modifiying it.
+ obs_out = obs_in
+
+ ! see if this obs is the same time as the prev obs
+ ! if not, carry on by putting it into the output.
+ ! if it's the same time, we have to sort first.
+
+ call get_obs_def(obs_out, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+ if (debug) print *, 'next observation: '
+ if (debug) call print_time(this_time, 'obs_in this_time')
+ if (debug) call print_time(prev_time, 'obs_in prev_time')
+
+ if (prev_time == this_time) then
+
+ if (debug) print *, 'matched prev_time'
+ sort_count = 0
+
+ SortObsLoop : do while ( .not. is_this_last )
+
+ obs_in = next_obs_in
+
+ sort_count = sort_count + 1
+ obs_this_bin(sort_count) = obs_in
+
+ call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
+
+ call get_obs_def(next_obs_in, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+ if (debug) call print_time(this_time, 'next_obs_in')
+ if (debug) print *, 'sort_count = ', sort_count
+
+ if (prev_time /= this_time) exit SortObsLoop
+
+ enddo SortObsLoop
+
+ if (debug) print *, 'out of loop, sort_count = ', sort_count
+ ! sort obs here
+ call index_sort(index, sort_count, obssort)
+ if (debug) print *, 'sorted index:'
+ if (debug) print *, index(1:sort_count)
+
+ ! the first obs in this time bin can't be a dup, so output it
+ if (num_inserted > 0) then
+ call insert_obs_in_seq(seq_out, obs_this_bin(index(1)), prev_obs_out)
+ else
+ call insert_obs_in_seq(seq_out, obs_this_bin(index(1)))
+ endif
+
+ prev_obs_out = obs_this_bin(index(1))
+ last_in = 1
+ call get_obs_def(obs_this_bin(index(1)), this_obs_def)
+ SAMEOBS: do i=2, sort_count
+ if (debug) print *, i, 'comparing obs ', index(last_in), index(i)
+ if (ignore_values) then
+ call get_obs_def(obs_this_bin(index(i)), that_obs_def)
+ if (debug) print *, 'obs ', index(last_in)
+ !if (debug) call print_obs_def(this_obs_def)
+ if (debug) print *, 'obs ', index(i)
+ !if (debug) call print_obs_def(that_obs_def)
+ if (this_obs_def == that_obs_def) then
+ if (debug) print *, 'same in obs_def - dup being ignored.'
+ if (debug) print *, ''
+ cycle SAMEOBS
+ endif
+ else
+ if (debug) print *, 'obs ', index(last_in)
+ !if (debug) call print_obs(obs_this_bin(index(last_in)))
+ if (debug) print *, 'obs ', index(i)
+ !if (debug) call print_obs(obs_this_bin(index(i)))
+ if (obs_this_bin(index(last_in)) == obs_this_bin(index(i))) then
+ if (debug) print *, 'same in obs vals - dup being ignored.'
+ if (debug) print *, ''
+ cycle SAMEOBS
+ endif
+ endif
+ if (debug) print *, 'obs differ - next obs being added to output.'
+ if (debug) print *, ''
+ last_in = i
+ call get_obs_def(obs_this_bin(index(i)), this_obs_def)
+
+ call insert_obs_in_seq(seq_out, obs_this_bin(index(i)), prev_obs_out)
+ prev_obs_out = obs_this_bin(index(i))
+ enddo SAMEOBS
+
+ num_inserted = num_inserted + sort_count
+
+ prev_time = this_time
+
+ if (print_every > 0) then
+ if ((mod(num_inserted,print_every) == 0) .or. &
+ (num_inserted > print_every)) then
+ print*, 'inserted number ',num_inserted,' of ',size_seq_out
+ endif
+ endif
+
+ ! no call to get_next_obs() because we've already done it
+
+ else
+
+ ! Since the stride through the observation sequence file is always
+ ! guaranteed to be in temporally-ascending order, we can use the
+ ! 'previous' observation as the starting point to search for the
+ ! correct insertion point. This speeds up the insert code a lot.
+
+ if (num_inserted > 0) then
+ call insert_obs_in_seq(seq_out, obs_out, prev_obs_out)
+ else
+ call insert_obs_in_seq(seq_out, obs_out)
+ endif
+
+ prev_obs_out = obs_out ! update position in seq for next insert
+ num_inserted = num_inserted + 1
+
+ prev_time = this_time
+
+ if (print_every > 0) then
+ if (mod(num_inserted,print_every) == 0) then
+ print*, 'inserted number ',num_inserted,' of ',size_seq_out
+ endif
+ endif
+
+ call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
+ endif
+
+ enddo ObsLoop
+
+else
+ write(msgstring, *)'no first observation in ',trim(filename_in)
+ call error_handler(E_MSG,'obs_remove_dups', msgstring)
+endif
+
+if (.not. print_only) then
+ print*, '--------- Obs seqs '
+ print*, 'Number of obs input sequence : ', size_seq_in
+ print*, 'Number of obs copied to output : ', num_inserted
+ print*, '---------------------------------------------------------'
+endif
+
+
+
+write(msgstring, *) 'Starting to process output sequence file ', &
+ trim(filename_out)
+call error_handler(E_MSG,'obs_remove_dups',msgstring)
+
+print*, 'Number of obs in the output seq file :', get_num_key_range(seq_out)
+
+call print_obs_seq(seq_out, filename_out)
+if (.not. print_only) then
+ call write_obs_seq(seq_out, filename_out)
+else
+ write(msgstring,*) 'Output sequence file not created; print_only in namelist is .true.'
+ call error_handler(E_MSG,'', msgstring)
+endif
+
+! clean up
+
+call destroy_obs_sequence(seq_in)
+call destroy_obs_sequence(seq_out)
+call destroy_obs( obs_in )
+call destroy_obs(next_obs_in )
+call destroy_obs( obs_out)
+!call destroy_obs(prev_obs_out) ! copy of something already deleted
+
+call shutdown()
+
+!---------------------------------------------------------------------
+! end of main program.
+!---------------------------------------------------------------------
+
+
+contains
+
+
+!---------------------------------------------------------------------
+subroutine setup()
+
+! Initialize modules used that require it
+call initialize_utilities('obs_remove_dups')
+call register_module(source, revision, revdate)
+call static_init_obs_sequence()
+
+end subroutine setup
+
+
+!---------------------------------------------------------------------
+subroutine shutdown()
+
+call finalize_utilities('obs_remove_dups')
+
+end subroutine shutdown
+
+
+!---------------------------------------------------------------------
+subroutine print_obs_seq(seq_in, filename)
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick table of obs types and counts, overall start and
+! stop times, and metadata strings and counts.
+
+type(obs_sequence_type), intent(in) :: seq_in
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq_in
+integer :: i
+integer :: this_obs_type
+integer :: type_count(0:max_defined_types_of_obs), identity_count
+
+
+! Initialize input obs_types
+type_count(:) = 0
+identity_count = 0
+
+! make sure there are obs left to process before going on.
+! num_obs should be ok since we just constructed this seq so it should
+! have no unlinked obs. if it might for some reason, use this instead:
+! size_seq_in = get_num_key_range(seq_in) !current size of seq_in
+
+size_seq_in = get_num_obs(seq_in)
+if (size_seq_in == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_remove_dups',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq_in), get_num_qc(seq_in))
+call init_obs(next_obs, get_num_copies(seq_in), get_num_qc(seq_in))
+
+! blank line
+call error_handler(E_MSG,'',' ')
+
+write(msgstring,*) 'Processing sequence file ', trim(filename)
+call error_handler(E_MSG,'',msgstring)
+
+call print_metadata(seq_in, filename)
+
+!-------------------------------------------------------------
+! Start to process obs from seq_in
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq_in, obs)
+
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first observation in ',trim(filename)
+ call error_handler(E_MSG,'obs_remove_dups', msgstring)
+endif
+
+! process it here
+is_this_last = .false.
+
+call get_obs_def(obs, this_obs_def)
+call print_time(get_obs_def_time(this_obs_def), ' First timestamp: ')
+! does not work with NO_CALENDAR
+if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_obs_type = get_obs_def_type_of_obs(this_obs_def)
+ if (this_obs_type < 0) then
+ identity_count = identity_count + 1
+ else
+ type_count(this_obs_type) = type_count(this_obs_type) + 1
+ endif
+! print *, 'obs type index = ', this_obs_type
+! if(this_obs_type > 0)print *, 'obs name = ', get_name_for_type_of_obs(this_obs_type)
+
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if (.not. is_this_last) then
+ obs = next_obs
+ else
+ call print_time(get_obs_def_time(this_obs_def), ' Last timestamp: ')
+ if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+ endif
+
+enddo ObsLoop
+
+
+write(msgstring, *) 'Number of obs processed : ', size_seq_in
+call error_handler(E_MSG, '', msgstring)
+write(msgstring, *) '---------------------------------------------------------'
+call error_handler(E_MSG, '', msgstring)
+do i = 0, max_defined_types_of_obs
+ if (type_count(i) > 0) then
+ write(msgstring, '(a32,i8,a)') trim(get_name_for_type_of_obs(i)), &
+ type_count(i), ' obs'
+ call error_handler(E_MSG, '', msgstring)
+ endif
+enddo
+if (identity_count > 0) then
+ write(msgstring, '(a32,i8,a)') 'Identity observations', &
+ identity_count, ' obs'
+ call error_handler(E_MSG, '', msgstring)
+endif
+
+! another blank line
+call error_handler(E_MSG, '', ' ')
+
+! Time to clean up
+
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+end subroutine print_obs_seq
+
+
+!---------------------------------------------------------------------
+subroutine validate_obs_seq_time(seq, filename)
+
+! this eventually belongs in the obs_seq_mod code, but for now
+! try it out here. we just fixed a hole in the interactive create
+! routine which would silently let you create out-of-time-order
+! linked lists, which gave no errors but didn't assimilate the
+! right obs at the right time when running filter. this runs
+! through the times in the entire sequence, ensuring they are
+! monotonically increasing in time. this should help catch any
+! bad files which were created with older versions of code.
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq, obs_count
+integer :: key
+type(time_type) :: last_time, this_time
+
+
+! make sure there are obs left to process before going on.
+size_seq = get_num_obs(seq)
+if (size_seq == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_remove_dups:validate',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq), get_num_qc(seq))
+call init_obs(next_obs, get_num_copies(seq), get_num_qc(seq))
+
+obs_count = 0
+
+!-------------------------------------------------------------
+! Start to process obs from seq
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq, obs)
+
+! we already tested for 0 obs above, so there should be a first obs here.
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first obs in sequence ' // trim(filename)
+ call error_handler(E_ERR,'obs_remove_dups:validate', &
+ msgstring, source, revision, revdate)
+ return
+endif
+
+is_this_last = .false.
+last_time = set_time(0, 0)
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+
+ if (last_time > this_time) then
+ ! bad time order of observations in linked list
+ call print_time(last_time, ' previous timestamp: ')
+ if (cal) call print_date(last_time, ' calendar date: ')
+ call print_time(this_time, ' next timestamp: ')
+ if (cal) call print_date(this_time, ' calendar date: ')
+
+ key = get_obs_key(obs)
+ write(msgstring1,*)'obs number ', key, ' has earlier time than previous obs'
+ write(msgstring2,*)'observations must be in increasing time order, file ' // trim(filename)
+ call error_handler(E_ERR,'obs_remove_dups:validate', msgstring2, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ endif
+
+ last_time = this_time
+ obs_count = obs_count + 1
+
+ call get_next_obs(seq, obs, next_obs, is_this_last)
+ if (.not. is_this_last) obs = next_obs
+
+enddo ObsLoop
+
+! clean up
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+! technically not a time validation, but easy to check. obs_count should never
+! be larger than size_seq - that's a fatal error. obs_count < size_seq would
+! suggest there are obs in the file that aren't part of the linked list.
+! this does not necessarily indicate a fatal error but it's not a common
+! situation and might indicate someone should check on the file.
+if (obs_count /= size_seq) then
+ write(msgstring,*) 'input sequence ', trim(filename)
+ call error_handler(E_MSG,'obs_remove_dups:validate', msgstring)
+
+ write(msgstring,*) 'total obs in file: ', size_seq, ' obs in linked list: ', obs_count
+ if (obs_count > size_seq) then
+ ! this is a fatal error
+ write(msgstring1,*) 'linked list obs_count > total size_seq, should not happen'
+ call error_handler(E_ERR,'obs_remove_dups:validate', msgstring, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ else
+ ! just warning msg
+ write(msgstring1,*) 'only observations in linked list will be processed'
+ call error_handler(E_MSG,'obs_remove_dups:validate', msgstring, &
+ source, revision, revdate, text2=msgstring1)
+ endif
+endif
+
+end subroutine validate_obs_seq_time
+
+
+!---------------------------------------------------------------------
+subroutine print_metadata(seq, fname)
+
+!
+! print out the metadata strings, trimmed
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), optional :: fname
+
+integer :: num_copies , num_qc, i
+character(len=metadatalength) :: str
+character(len=255) :: msgstring3
+
+num_copies = get_num_copies(seq)
+num_qc = get_num_qc( seq)
+
+if ( num_copies < 0 .or. num_qc < 0 ) then
+ write(msgstring3,*)' illegal copy or obs count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_remove_dups', msgstring3, &
+ source, revision, revdate)
+endif
+
+MetaDataLoop : do i=1, num_copies
+ str = get_copy_meta_data(seq,i)
+
+ write(msgstring,*)'Data Metadata: ',trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo MetaDataLoop
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ write(msgstring,*)' QC Metadata: ', trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo QCMetaData
+
+end subroutine print_metadata
+
+end program obs_remove_dups
+
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/assimilation_code/programs/obs_utils/obs_remove_dups.nml b/assimilation_code/programs/obs_utils/obs_remove_dups.nml
new file mode 100644
index 0000000000..4c3b76641e
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/obs_remove_dups.nml
@@ -0,0 +1,14 @@
+! if ignore_values = .true. it will ignore the
+! obs data values and only compare the obs_def part
+! (time, location, type, error). the default compares
+! the obs values and qcs as well before declaring a
+! duplicate obs.
+
+&obs_remove_dups_nml
+ filename_in = ''
+ filename_out = ''
+ ignore_values = .false.
+ print_only = .false.
+ calendar = 'Gregorian'
+ debug = .false.
+/
diff --git a/assimilation_code/programs/obs_utils/obs_sort.f90 b/assimilation_code/programs/obs_utils/obs_sort.f90
new file mode 100644
index 0000000000..64aad20e73
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/obs_sort.f90
@@ -0,0 +1,816 @@
+! 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
+!
+! DART $Id$
+
+!> Utility to try to sort observations at the same time into a
+!> consistent order. Obs sequence files are guarenteed to be
+!> traversed in time order, so running them through the standard
+!> obs_sequence_tool will physically order them in the file in
+!> the same way a linked-list traversal would. But for multiple
+!> obs at the same time, there is no way to indicate how to order
+!> them relative to each other. This tool tries to sort same-time
+!> obs based on location, then kind, then variance. If there are
+!> duplicate obs in the same file, this might be a way to get them
+!> together, and possibly add code to remove them.
+
+module special_sort
+
+use types_mod, only : r8, missing_r8, metadatalength, obstypelength
+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 sort_mod, only : index_sort
+use location_mod, only : location_type, get_location, set_location, &
+ LocationName, read_location, operator(/=), &
+ write_location, LocationDims
+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, get_obs_def_error_variance
+use obs_kind_mod, only : max_defined_types_of_obs, get_name_for_type_of_obs
+use time_manager_mod, only : time_type, operator(>), print_time, set_time, &
+ print_date, set_calendar_type, operator(==), &
+ operator(/=), get_calendar_type, NO_CALENDAR, &
+ operator(-), set_time_missing
+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, &
+ 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
+private
+
+public :: obssort, obs_this_bin
+
+type(obs_type), allocatable :: obs_this_bin(:)
+
+contains
+
+
+!---------------------------------------------------------------------
+
+function obssort(i, j)
+ integer, intent(in) :: i, j
+ integer :: obssort
+
+! this is requesting a compare of obs_this_bin(i) and obs_this_bin(j)
+! they should have identical times, so the compare needs to be by
+! location, type, value, etc. return -1 if i < j ; 0 if == ; 1 if i > j
+
+type(obs_def_type) :: this_obs_def1, this_obs_def2
+integer :: this_type1, this_type2
+type(location_type) :: this_loc1, this_loc2
+type(time_type) :: this_time1, this_time2
+real(r8) :: this_var1, this_var2
+real(r8) :: loc1(LocationDims), loc2(LocationDims) ! try for general?
+integer :: ndim
+character(len=129) :: locstring1, locstring2
+logical :: local_debug = .false.
+
+call get_obs_def(obs_this_bin(i), this_obs_def1)
+call get_obs_def(obs_this_bin(j), this_obs_def2)
+
+
+this_time1 = get_obs_def_time(this_obs_def1)
+this_time2 = get_obs_def_time(this_obs_def2)
+
+this_loc1 = get_obs_def_location(this_obs_def1)
+this_loc2 = get_obs_def_location(this_obs_def2)
+
+loc1 = get_location(this_loc1)
+loc2 = get_location(this_loc2)
+
+this_type1 = get_obs_def_type_of_obs(this_obs_def1)
+this_type2 = get_obs_def_type_of_obs(this_obs_def2)
+
+this_var1 = get_obs_def_error_variance(this_obs_def1)
+this_var2 = get_obs_def_error_variance(this_obs_def2)
+
+if (this_time1 /= this_time2) then
+ print *, 'error, times not the same'
+ print *, 'comparing items ', i, j
+ call print_time(this_time1, 'time1')
+ call print_time(this_time2, 'time2')
+ stop
+endif
+
+if (local_debug) then
+ print *, 'comparing items ', i, j
+ call print_time(this_time1, 'time: ')
+ print *, 'types ', this_type1, this_type2
+ print *, 'vars ', this_var1, this_var2
+ call write_location(0, this_loc1, charstring=locstring1)
+ call write_location(0, this_loc2, charstring=locstring2)
+ print *, 'locs: '
+ print *, trim(locstring1)
+ print *, trim(locstring2)
+ print *, ''
+endif
+
+! try for a general location solution
+do ndim=1, LocationDims
+
+ if (loc1(ndim) > loc2(ndim)) then
+ obssort = 1
+ return
+ else if (loc1(ndim) < loc2(ndim)) then
+ obssort = -1
+ return
+ endif
+
+enddo
+
+! locations the same, so try types
+if (this_type1 > this_type2) then
+ obssort = 1
+ return
+else if (this_type1 < this_type2) then
+ obssort = -1
+ return
+endif
+
+! same up to now, so try errors (variance)
+if (this_var1 > this_var2) then
+ obssort = 1
+ return
+else if (this_var1 < this_var2) then
+ obssort = -1
+ return
+endif
+
+! ok, i give up. they're the same.
+! or enough for us to not try to resort them.
+obssort = 0
+
+if (local_debug) then
+ print *, 'decided items ', i, j, ' are same'
+ call print_time(this_time1, 'time: ')
+ print *, 'types ', this_type1, this_type2
+ print *, 'vars ', this_var1, this_var2
+ call write_location(0, this_loc1, charstring=locstring1)
+ call write_location(0, this_loc2, charstring=locstring2)
+ print *, 'locs: '
+ print *, trim(locstring1)
+ print *, trim(locstring2)
+ print *, ''
+endif
+
+end function obssort
+
+end module special_sort
+
+!---------------------------------------------------------------------
+
+program obs_sort
+
+! simple program that opens an obs_seq file and loops over the obs
+! and copies them to a new output file. this is intended to be a
+! template for programs that want to alter existing obs in some simple way.
+
+use types_mod, only : r8, missing_r8, metadatalength, obstypelength
+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 sort_mod, only : index_sort
+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, get_obs_def_error_variance
+use obs_kind_mod, only : max_defined_types_of_obs, get_name_for_type_of_obs
+use time_manager_mod, only : time_type, operator(>), print_time, set_time, &
+ print_date, set_calendar_type, operator(==), &
+ operator(/=), get_calendar_type, NO_CALENDAR, &
+ operator(-), set_time_missing
+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
+
+use special_sort
+
+implicit none
+
+!interface
+! integer function obssort(i, j)
+! integer, intent(in) :: i, j
+! end function obssort
+!end interface
+
+! 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$"
+character(len=128), parameter :: id = "$Id$"
+
+type(obs_sequence_type) :: seq_in, seq_out
+type(obs_type) :: obs_in, next_obs_in, last_obs
+type(obs_type) :: obs_out, prev_obs_out
+type(time_type) :: this_time, prev_time
+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, sort_count
+integer :: num_rejected_badqc, num_rejected_diffqc
+integer :: num_rejected_other
+integer, allocatable :: index(:)
+character(len = 129) :: read_format
+logical :: pre_I_format, cal
+character(len = 256) :: msgstring, msgstring1, msgstring2
+type(obs_def_type) :: this_obs_def
+
+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 = 160) :: filename_in = ''
+character(len = 160) :: filename_out = ''
+
+logical :: print_only = .false.
+character(len=32) :: calendar = 'Gregorian'
+
+! true for more output
+logical :: debug = .false.
+
+namelist /obs_sort_nml/ &
+ filename_in, filename_out, &
+ print_only, calendar, debug
+
+!----------------------------------------------------------------
+! Start of the program:
+!
+! Process each input observation sequence file in turn, optionally
+! selecting observations to insert into the output sequence file.
+!----------------------------------------------------------------
+
+call setup()
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "obs_sort_nml", iunit)
+read(iunit, nml = obs_sort_nml, iostat = io)
+call check_namelist_read(iunit, io, "obs_sort_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=obs_sort_nml)
+if (do_nml_term()) write( * , nml=obs_sort_nml)
+
+! the default is a gregorian calendar. if you are using a different type
+! set it in the namelist. this only controls how it prints out the first
+! and last timestamps in the obs_seq files.
+call set_calendar_type(calendar)
+
+! set a logial to see if we have a calendar or not
+cal = (get_calendar_type() /= NO_CALENDAR)
+
+! if you add anything to the namelist, you can process it here.
+
+! end of namelist processing and setup
+
+
+! single pass algorithm (unlike other obs tools).
+
+call read_obs_seq_header(filename_in, num_copies_in, num_qc_in, &
+ size_seq_in, max_num_obs, file_id, read_format, pre_I_format, &
+ close_the_file = .true.)
+
+if (max_num_obs == 0) then
+ write(msgstring,*) 'No obs in input sequence file ', trim(filename_in)
+ call error_handler(E_ERR,'obs_sort',msgstring)
+endif
+
+write(msgstring, *) 'Starting to process input sequence file: '
+write(msgstring1,*) trim(filename_in)
+call error_handler(E_MSG,'obs_sort',msgstring, &
+ text2=msgstring1)
+
+call read_obs_seq(filename_in, 0, 0, 0, seq_in)
+
+! sanity check - ensure the linked list times are in increasing time order
+call validate_obs_seq_time(seq_in, filename_in)
+
+! output is same size (or less) than input, generally.
+! if this program is going to dup obs, account for it here.
+size_seq_out = max_num_obs
+
+! blank line, start of actually creating output file
+call error_handler(E_MSG,' ',' ')
+
+! Initialize individual observation variables
+call init_obs( obs_in, num_copies_in, num_qc_in)
+call init_obs(next_obs_in, num_copies_in, num_qc_in)
+call init_obs( obs_out, num_copies_in, num_qc_in)
+call init_obs(prev_obs_out, num_copies_in, num_qc_in)
+
+! space for sorting obs with the same timestamp
+allocate(obs_this_bin(max_num_obs), index(max_num_obs))
+do i=1, max_num_obs
+ call init_obs(obs_this_bin(i), num_copies_in, num_qc_in)
+enddo
+
+! create the output sequence here
+call init_obs_sequence(seq_out, num_copies_in, num_qc_in, size_seq_out)
+do j=1, num_copies_in
+ meta_data = get_copy_meta_data(seq_in, j)
+ call set_copy_meta_data(seq_out, j, meta_data)
+enddo
+do j=1, num_qc_in
+ meta_data = get_qc_meta_data(seq_in, j)
+ call set_qc_meta_data(seq_out, j, meta_data)
+enddo
+
+! is this needed?
+if (print_only) call print_obs_seq(seq_in, filename_in)
+
+!-------------------------------------------------------------
+! Start to insert obs from sequence_in into sequence_out
+!
+! NOTE: insert_obs_in_seq CHANGES the obs passed in.
+! Must pass a copy of incoming obs to insert_obs_in_seq.
+!--------------------------------------------------------------
+num_inserted = 0
+num_rejected_badqc = 0
+num_rejected_diffqc = 0
+num_rejected_other = 0
+
+if ( get_first_obs(seq_in, obs_in) ) then
+
+ is_this_last = .false.
+ next_obs_in = obs_in
+ call get_obs_def(obs_in, this_obs_def)
+ prev_time = get_obs_def_time(this_obs_def)
+
+ ObsLoop : do while ( .not. is_this_last )
+
+ obs_in = next_obs_in
+
+ ! obs_out will be modified when it is inserted in the output sequence
+ ! so we have to make a copy of obs_in before modifiying it.
+ obs_out = obs_in
+
+ ! see if this obs is the same time as the prev obs
+ ! if not, carry on by putting it into the output.
+ ! if it's the same time, we have to sort first.
+
+ call get_obs_def(obs_out, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+ if (debug) print *, 'next observation: '
+ if (debug) call print_time(this_time, 'obs_in this_time')
+ if (debug) call print_time(prev_time, 'obs_in prev_time')
+
+ if (prev_time == this_time) then
+
+ if (debug) print *, 'matched prev_time'
+ sort_count = 0
+
+ SortObsLoop : do while ( .not. is_this_last )
+
+ obs_in = next_obs_in
+
+ sort_count = sort_count + 1
+ obs_this_bin(sort_count) = obs_in
+
+ call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
+
+ call get_obs_def(next_obs_in, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+ if (debug) call print_time(this_time, 'next_obs_in')
+ if (debug) print *, 'sort_count = ', sort_count
+
+ if (prev_time /= this_time) exit SortObsLoop
+
+ enddo SortObsLoop
+
+ if (debug) print *, 'out of loop, sort_count = ', sort_count
+ ! sort obs here
+ call index_sort(index, sort_count, obssort)
+ if (debug) print *, 'sorted index:'
+ if (debug) print *, index(1:sort_count)
+
+ if (num_inserted > 0) then
+ call insert_obs_in_seq(seq_out, obs_this_bin(index(1)), prev_obs_out)
+ else
+ call insert_obs_in_seq(seq_out, obs_this_bin(index(1)))
+ endif
+
+ prev_obs_out = obs_this_bin(index(1))
+ do i=2, sort_count
+ call insert_obs_in_seq(seq_out, obs_this_bin(index(i)), prev_obs_out)
+ prev_obs_out = obs_this_bin(index(i))
+ enddo
+
+ num_inserted = num_inserted + sort_count
+
+ prev_time = this_time
+
+ if (print_every > 0) then
+ if ((mod(num_inserted,print_every) == 0) .or. &
+ (num_inserted > print_every)) then
+ print*, 'inserted number ',num_inserted,' of ',size_seq_out
+ endif
+ endif
+
+ ! no call to get_next_obs() because we've already done it
+
+ else
+
+ ! Since the stride through the observation sequence file is always
+ ! guaranteed to be in temporally-ascending order, we can use the
+ ! 'previous' observation as the starting point to search for the
+ ! correct insertion point. This speeds up the insert code a lot.
+
+ if (num_inserted > 0) then
+ call insert_obs_in_seq(seq_out, obs_out, prev_obs_out)
+ else
+ call insert_obs_in_seq(seq_out, obs_out)
+ endif
+
+ prev_obs_out = obs_out ! update position in seq for next insert
+ num_inserted = num_inserted + 1
+
+ prev_time = this_time
+
+ if (print_every > 0) then
+ if (mod(num_inserted,print_every) == 0) then
+ print*, 'inserted number ',num_inserted,' of ',size_seq_out
+ endif
+ endif
+
+ call get_next_obs(seq_in, obs_in, next_obs_in, is_this_last)
+ endif
+
+ enddo ObsLoop
+
+else
+ write(msgstring, *)'no first observation in ',trim(filename_in)
+ call error_handler(E_MSG,'obs_sort', msgstring)
+endif
+
+if (.not. print_only) then
+ print*, '--------- Obs seqs '
+ print*, 'Number of obs input sequence : ', size_seq_in
+ print*, 'Number of obs copied to output : ', num_inserted
+ print*, '---------------------------------------------------------'
+endif
+
+
+
+write(msgstring, *) 'Starting to process output sequence file ', &
+ trim(filename_out)
+call error_handler(E_MSG,'obs_sort',msgstring)
+
+print*, 'Number of obs in the output seq file :', get_num_key_range(seq_out)
+
+call print_obs_seq(seq_out, filename_out)
+if (.not. print_only) then
+ call write_obs_seq(seq_out, filename_out)
+else
+ write(msgstring,*) 'Output sequence file not created; print_only in namelist is .true.'
+ call error_handler(E_MSG,'', msgstring)
+endif
+
+! clean up
+
+call destroy_obs_sequence(seq_in)
+call destroy_obs_sequence(seq_out)
+call destroy_obs( obs_in )
+call destroy_obs(next_obs_in )
+call destroy_obs( obs_out)
+!call destroy_obs(prev_obs_out) ! copy of something already deleted
+
+call shutdown()
+
+!---------------------------------------------------------------------
+! end of main program.
+!---------------------------------------------------------------------
+
+
+contains
+
+
+!---------------------------------------------------------------------
+subroutine setup()
+
+! Initialize modules used that require it
+call initialize_utilities('obs_sort')
+call register_module(source, revision, revdate)
+call static_init_obs_sequence()
+
+end subroutine setup
+
+
+!---------------------------------------------------------------------
+subroutine shutdown()
+
+call finalize_utilities('obs_sort')
+
+end subroutine shutdown
+
+
+!---------------------------------------------------------------------
+subroutine print_obs_seq(seq_in, filename)
+
+! you can get more info by running the obs_diag program, but this
+! prints out a quick table of obs types and counts, overall start and
+! stop times, and metadata strings and counts.
+
+type(obs_sequence_type), intent(in) :: seq_in
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq_in
+integer :: i, this_obs_type
+integer :: type_count(0:max_defined_types_of_obs), identity_count
+
+
+! Initialize input obs_types
+type_count(:) = 0
+identity_count = 0
+
+! make sure there are obs left to process before going on.
+! num_obs should be ok since we just constructed this seq so it should
+! have no unlinked obs. if it might for some reason, use this instead:
+! size_seq_in = get_num_key_range(seq_in) !current size of seq_in
+
+size_seq_in = get_num_obs(seq_in)
+if (size_seq_in == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_sort',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq_in), get_num_qc(seq_in))
+call init_obs(next_obs, get_num_copies(seq_in), get_num_qc(seq_in))
+
+! blank line
+call error_handler(E_MSG,'',' ')
+
+write(msgstring,*) 'Processing sequence file ', trim(filename)
+call error_handler(E_MSG,'',msgstring)
+
+call print_metadata(seq_in, filename)
+
+!-------------------------------------------------------------
+! Start to process obs from seq_in
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq_in, obs)
+
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first observation in ',trim(filename)
+ call error_handler(E_MSG,'obs_sort', msgstring)
+endif
+
+! process it here
+is_this_last = .false.
+
+call get_obs_def(obs, this_obs_def)
+call print_time(get_obs_def_time(this_obs_def), ' First timestamp: ')
+! does not work with NO_CALENDAR
+if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_obs_type = get_obs_def_type_of_obs(this_obs_def)
+ if (this_obs_type < 0) then
+ identity_count = identity_count + 1
+ else
+ type_count(this_obs_type) = type_count(this_obs_type) + 1
+ endif
+! print *, 'obs type index = ', this_obs_type
+! if(this_obs_type > 0)print *, 'obs name = ', get_name_for_type_of_obs(this_obs_type)
+
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if (.not. is_this_last) then
+ obs = next_obs
+ else
+ call print_time(get_obs_def_time(this_obs_def), ' Last timestamp: ')
+ if (cal) call print_date(get_obs_def_time(this_obs_def), ' calendar Date: ')
+ endif
+
+enddo ObsLoop
+
+
+write(msgstring, *) 'Number of obs processed : ', size_seq_in
+call error_handler(E_MSG, '', msgstring)
+write(msgstring, *) '---------------------------------------------------------'
+call error_handler(E_MSG, '', msgstring)
+do i = 0, max_defined_types_of_obs
+ if (type_count(i) > 0) then
+ write(msgstring, '(a32,i8,a)') trim(get_name_for_type_of_obs(i)), &
+ type_count(i), ' obs'
+ call error_handler(E_MSG, '', msgstring)
+ endif
+enddo
+if (identity_count > 0) then
+ write(msgstring, '(a32,i8,a)') 'Identity observations', &
+ identity_count, ' obs'
+ call error_handler(E_MSG, '', msgstring)
+endif
+
+! another blank line
+call error_handler(E_MSG, '', ' ')
+
+! Time to clean up
+
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+end subroutine print_obs_seq
+
+
+!---------------------------------------------------------------------
+subroutine validate_obs_seq_time(seq, filename)
+
+! this eventually belongs in the obs_seq_mod code, but for now
+! try it out here. we just fixed a hole in the interactive create
+! routine which would silently let you create out-of-time-order
+! linked lists, which gave no errors but didn't assimilate the
+! right obs at the right time when running filter. this runs
+! through the times in the entire sequence, ensuring they are
+! monotonically increasing in time. this should help catch any
+! bad files which were created with older versions of code.
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), intent(in) :: filename
+
+type(obs_type) :: obs, next_obs
+type(obs_def_type) :: this_obs_def
+logical :: is_there_one, is_this_last
+integer :: size_seq, obs_count
+integer :: key
+type(time_type) :: last_time, this_time
+
+
+! make sure there are obs left to process before going on.
+size_seq = get_num_obs(seq)
+if (size_seq == 0) then
+ msgstring = 'Obs_seq file '//trim(filename)//' is empty.'
+ call error_handler(E_MSG,'obs_sort:validate',msgstring)
+ return
+endif
+
+! Initialize individual observation variables
+call init_obs( obs, get_num_copies(seq), get_num_qc(seq))
+call init_obs(next_obs, get_num_copies(seq), get_num_qc(seq))
+
+obs_count = 0
+
+!-------------------------------------------------------------
+! Start to process obs from seq
+!--------------------------------------------------------------
+is_there_one = get_first_obs(seq, obs)
+
+! we already tested for 0 obs above, so there should be a first obs here.
+if ( .not. is_there_one ) then
+ write(msgstring,*)'no first obs in sequence ' // trim(filename)
+ call error_handler(E_ERR,'obs_sort:validate', &
+ msgstring, source, revision, revdate)
+ return
+endif
+
+is_this_last = .false.
+last_time = set_time(0, 0)
+ObsLoop : do while ( .not. is_this_last)
+
+ call get_obs_def(obs, this_obs_def)
+ this_time = get_obs_def_time(this_obs_def)
+
+ if (last_time > this_time) then
+ ! bad time order of observations in linked list
+ call print_time(last_time, ' previous timestamp: ')
+ if (cal) call print_date(last_time, ' calendar date: ')
+ call print_time(this_time, ' next timestamp: ')
+ if (cal) call print_date(this_time, ' calendar date: ')
+
+ key = get_obs_key(obs)
+ write(msgstring1,*)'obs number ', key, ' has earlier time than previous obs'
+ write(msgstring2,*)'observations must be in increasing time order, file ' // trim(filename)
+ call error_handler(E_ERR,'obs_sort:validate', msgstring2, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ endif
+
+ last_time = this_time
+ obs_count = obs_count + 1
+
+ call get_next_obs(seq, obs, next_obs, is_this_last)
+ if (.not. is_this_last) obs = next_obs
+
+enddo ObsLoop
+
+! clean up
+call destroy_obs( obs)
+call destroy_obs(next_obs)
+
+! technically not a time validation, but easy to check. obs_count should never
+! be larger than size_seq - that's a fatal error. obs_count < size_seq would
+! suggest there are obs in the file that aren't part of the linked list.
+! this does not necessarily indicate a fatal error but it's not a common
+! situation and might indicate someone should check on the file.
+if (obs_count /= size_seq) then
+ write(msgstring,*) 'input sequence ', trim(filename)
+ call error_handler(E_MSG,'obs_sort:validate', msgstring)
+
+ write(msgstring,*) 'total obs in file: ', size_seq, ' obs in linked list: ', obs_count
+ if (obs_count > size_seq) then
+ ! this is a fatal error
+ write(msgstring1,*) 'linked list obs_count > total size_seq, should not happen'
+ call error_handler(E_ERR,'obs_sort:validate', msgstring, &
+ source, revision, revdate, &
+ text2=msgstring1)
+ else
+ ! just warning msg
+ write(msgstring1,*) 'only observations in linked list will be processed'
+ call error_handler(E_MSG,'obs_sort:validate', msgstring, &
+ source, revision, revdate, text2=msgstring1)
+ endif
+endif
+
+end subroutine validate_obs_seq_time
+
+
+!---------------------------------------------------------------------
+subroutine print_metadata(seq, fname)
+
+!
+! print out the metadata strings, trimmed
+!
+
+type(obs_sequence_type), intent(in) :: seq
+character(len=*), optional :: fname
+
+integer :: num_copies , num_qc, i
+character(len=metadatalength) :: str
+character(len=255) :: msgstring3
+
+num_copies = get_num_copies(seq)
+num_qc = get_num_qc( seq)
+
+if ( num_copies < 0 .or. num_qc < 0 ) then
+ write(msgstring3,*)' illegal copy or obs count in file '//trim(fname)
+ call error_handler(E_ERR, 'obs_sort', msgstring3, &
+ source, revision, revdate)
+endif
+
+MetaDataLoop : do i=1, num_copies
+ str = get_copy_meta_data(seq,i)
+
+ write(msgstring,*)'Data Metadata: ',trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo MetaDataLoop
+
+QCMetaData : do i=1, num_qc
+ str = get_qc_meta_data(seq,i)
+
+ write(msgstring,*)' QC Metadata: ', trim(str)
+ call error_handler(E_MSG, '', msgstring)
+
+enddo QCMetaData
+
+end subroutine print_metadata
+
+end program obs_sort
+
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/assimilation_code/programs/obs_utils/obs_timejitter.f90 b/assimilation_code/programs/obs_utils/obs_timejitter.f90
new file mode 100644
index 0000000000..af6c4f9938
--- /dev/null
+++ b/assimilation_code/programs/obs_utils/obs_timejitter.f90
@@ -0,0 +1,144 @@
+! 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
+!
+! DART $Id$
+
+program obs_timejitter
+
+use types_mod, only : r8
+use utilities_mod, only : register_module, open_file, close_file, &
+ initialize_utilities, finalize_utilities
+use random_seq_mod, only : random_seq_type, init_random_seq, random_gaussian
+use obs_def_mod, only : obs_def_type, get_obs_def_time, set_obs_def_time
+use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
+ get_num_obs, init_obs_sequence, get_first_obs, write_obs_seq, set_copy_meta_data, &
+ get_obs_def, set_obs_def, get_next_obs, insert_obs_in_seq, init_obs, &
+ assignment(=), static_init_obs_sequence, get_num_copies, get_num_qc, &
+ get_copy_meta_data, get_qc_meta_data, set_qc_meta_data
+use time_manager_mod, only : time_type, set_time, get_time, interactive_time, &
+ operator(*), operator(+), operator(-), operator(<)
+use model_mod, only : static_init_model
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=128), parameter :: &
+ source = "$URL$", &
+ revision = "$Revision$", &
+ revdate = "$Date$"
+character(len=128), parameter :: id = "$Id$"
+
+
+type(obs_sequence_type) :: seq, seq_in
+type(obs_type) :: obs, next_obs, new_obs, last_obs
+type(obs_def_type) :: obs_def
+character(len = 129) :: file_name
+logical :: is_there_one, is_this_last
+type(time_type) :: ob_time, last_time
+integer :: seconds, days, i, num_obs, num_copies, num_qc
+type(random_seq_type) :: random_seq
+real(r8) :: perturbation_amplitude, delseconds ! size of perturbations
+
+
+
+! Record the current time, date, etc. to the logfile
+call initialize_utilities('obs_timejitter')
+call register_module(source, revision, revdate)
+
+! Call the underlying model's static initialization for calendar info
+call static_init_model()
+
+! Initialize the obs_sequence module
+call static_init_obs_sequence()
+
+! Initialize the random number sequence
+call init_random_seq(random_seq, 1)
+
+! Write the sequence to a file
+write(*, *) 'Input filename for network definition sequence (usually set_def.out )'
+read(*, *) file_name
+call read_obs_seq(file_name, 0, 0, 0, seq_in)
+
+! Find out how many obs there are
+num_obs = get_num_obs(seq_in)
+
+! Initialize the obs_type variables
+num_copies = get_num_copies(seq_in)
+num_qc = get_num_qc(seq_in)
+call init_obs( obs, num_copies, num_qc)
+call init_obs(next_obs, num_copies, num_qc)
+call init_obs( new_obs, num_copies, num_qc)
+call init_obs(last_obs, num_copies, num_qc)
+
+! Get the time spread information
+
+write(*, *) 'Input the spread in time in seconds'
+read(*, *) perturbation_amplitude
+
+! Initialize the output sequence
+call init_obs_sequence(seq, num_copies, num_qc, num_obs)
+do i = 1, num_copies
+ call set_copy_meta_data(seq, i, get_copy_meta_data(seq_in, i))
+end do
+do i = 1, num_qc
+ call set_qc_meta_data(seq, i, get_qc_meta_data(seq_in, i))
+end do
+
+last_time = set_time(0, 0)
+is_there_one = get_first_obs(seq_in, obs)
+
+do i = 1, num_obs
+ new_obs = obs
+
+ ! Set the time
+ call get_obs_def(new_obs, obs_def)
+ ob_time = get_obs_def_time(obs_def)
+
+ ! jitter here
+ call get_time(ob_time, seconds, days)
+ delseconds = int(random_gaussian(random_seq, real(seconds, r8), perturbation_amplitude))
+ if (delseconds > 0) then
+ ob_time = ob_time + set_time(int(delseconds), 0)
+ else
+ if (days == 0 .and. delseconds > seconds) then
+ ob_time = set_time(0, 0)
+ else
+ ob_time = ob_time - set_time(-int(delseconds), 0)
+ endif
+ endif
+
+ call set_obs_def_time(obs_def, ob_time)
+ call set_obs_def(new_obs, obs_def)
+
+ ! Insert it in the new sequence. If time has not been
+ ! moved back before the time of the last obs, use it
+ ! as the start of the insert to save search time.
+ ! Otherwise, start at the first obs in the sequence.
+ if (i == 1 .or. ob_time < last_time) then
+ call insert_obs_in_seq(seq, new_obs)
+ else
+ call insert_obs_in_seq(seq, new_obs, last_obs)
+ endif
+ last_obs = new_obs
+ last_time = ob_time
+
+ ! Find the next observation in the input set
+ call get_next_obs(seq_in, obs, next_obs, is_this_last)
+ if(.not. is_this_last) obs = next_obs
+end do
+
+write(*, *) 'What is output file name for sequence ( obs_seq.in is recommended )'
+read(*, *) file_name
+call write_obs_seq(seq, file_name)
+
+! Clean up
+call finalize_utilities()
+
+end program obs_timejitter
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/assimilation_code/programs/perfect_model_obs/perfect_model_obs.f90 b/assimilation_code/programs/perfect_model_obs/perfect_model_obs.f90
index cd1a0131c8..78554bed1e 100644
--- a/assimilation_code/programs/perfect_model_obs/perfect_model_obs.f90
+++ b/assimilation_code/programs/perfect_model_obs/perfect_model_obs.f90
@@ -10,10 +10,10 @@ program perfect_model_obs
use types_mod, only : r8, i8, metadatalength, MAX_NUM_DOMS
use utilities_mod, only : register_module, error_handler, &
- find_namelist_in_file, check_namelist_read, &
- E_ERR, E_MSG, E_DBG, nmlfileunit, timestamp, &
+ find_namelist_in_file, check_namelist_read, &
+ E_ERR, E_MSG, E_DBG, nmlfileunit, timestamp, &
do_nml_file, do_nml_term, logfileunit, &
- open_file, close_file, finalize_utilities
+ open_file, close_file
use time_manager_mod, only : time_type, get_time, set_time, operator(/=), print_time, &
generate_seed
use obs_sequence_mod, only : read_obs_seq, obs_type, obs_sequence_type, &
diff --git a/assimilation_code/programs/perturb_single_instance/perturb_single_instance.f90 b/assimilation_code/programs/perturb_single_instance/perturb_single_instance.f90
new file mode 100644
index 0000000000..aca06b2552
--- /dev/null
+++ b/assimilation_code/programs/perturb_single_instance/perturb_single_instance.f90
@@ -0,0 +1,284 @@
+! 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: perturb_single_instance.f90 12665 2018-06-12 22:32:05Z hendric@ucar.edu $
+
+!>@todo FIXME the html needs to be made consistent with the namelist once the namelist
+!> is fleshed out.
+
+!> This is a utility program that computes an ensemble of restarts
+!> using the models pert_model_copies, if provided, or uses standard
+!> gaussian noise with perturbation_amplitude standard deviation if
+!> no routine is provided.
+
+program perturb_single_instance
+
+use types_mod, only : r8, i8, obstypelength, MAX_NUM_DOMS, MAX_FILES
+
+use time_manager_mod, only : time_type, set_time_missing, operator(/=), &
+ print_time
+
+use utilities_mod, only : register_module, find_namelist_in_file, &
+ error_handler, nmlfileunit, E_MSG, E_ERR, &
+ check_namelist_read, do_nml_file, do_nml_term, &
+ open_file, close_file, set_multiple_filename_lists
+
+use location_mod, only : location_type
+
+use obs_kind_mod, only : get_num_quantities, get_index_for_quantity, &
+ get_name_for_quantity
+
+use sort_mod, only : index_sort
+
+use assim_model_mod, only : static_init_assim_model, get_model_size, &
+ get_state_meta_data, pert_model_copies
+
+use state_vector_io_mod, only : read_state, write_state
+
+use io_filenames_mod, only : file_info_type, io_filenames_init, &
+ set_io_copy_flag, set_file_metadata, &
+ set_member_file_metadata, file_info_dump, &
+ stage_metadata_type, get_stage_metadata, &
+ get_restart_filename, READ_COPY, WRITE_COPY
+
+use state_structure_mod, only : get_num_domains
+
+use mpi_utilities_mod, only : initialize_mpi_utilities, task_count, &
+ finalize_mpi_utilities, my_task_id, &
+ send_sum_to
+
+use ensemble_manager_mod, only : ensemble_type, init_ensemble_manager, compute_copy_mean, &
+ get_my_num_vars, end_ensemble_manager
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=256), parameter :: source = &
+ "$URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/pertirb_tool/assimilation_code/programs/perturb_single_instance/perturb_single_instance.f90 $"
+character(len=32 ), parameter :: revision = "$Revision: 12665 $"
+character(len=128), parameter :: revdate = "$Date: 2018-06-12 16:32:05 -0600 (Tue, 12 Jun 2018) $"
+
+
+!----------------------------------------------------------------
+! These variables are namelist-controllable.
+!
+integer :: ens_size = 1
+character(len=256) :: input_files(MAX_FILES) = ''
+character(len=256) :: output_file_list(MAX_NUM_DOMS) = ''
+character(len=256) :: output_files(MAX_FILES) = ''
+real(r8) :: perturbation_amplitude = 0.0
+logical :: single_restart_file_in = .false.
+
+namelist /perturb_single_instance_nml/ &
+ ens_size, &
+ input_files, &
+ output_files, &
+ output_file_list, &
+ perturbation_amplitude, &
+ single_restart_file_in
+
+!----------------------------------------------------------------
+! Additional global variables
+!
+type(ensemble_type) :: ens_handle
+character(len=256), allocatable :: file_array_input(:,:)
+character(len=256), allocatable :: file_array_output(:,:)
+character(len=512) :: msgstring, msgstring1
+character(len=256) :: my_base, my_desc
+integer :: idom, imem, iunit, io, i
+integer :: ndomains
+logical :: interf_provided
+integer(i8) :: model_size
+type(time_type) :: member_time
+type(file_info_type) :: file_info_input, file_info_output
+type(stage_metadata_type) :: input_restart_files
+type(stage_metadata_type) :: output_restart_files
+
+!----------------------------------------------------------------
+! program start
+!----------------------------------------------------------------
+
+call initialize_mpi_utilities('perturb_single_instance')
+
+call register_module(source,revision,revdate)
+
+! Read the namelist entry and print it
+call find_namelist_in_file("input.nml", "perturb_single_instance_nml", iunit)
+read(iunit, nml = perturb_single_instance_nml, iostat = io)
+call check_namelist_read(iunit, io, "perturb_single_instance_nml")
+
+if (do_nml_file()) write(nmlfileunit, nml=perturb_single_instance_nml)
+if (do_nml_term()) write( * , nml=perturb_single_instance_nml)
+
+if (single_restart_file_in) then
+ write(msgstring, *) 'single_restart_file_in is not supported.'
+ write(msgstring1, *) 'Please contact DART if you would like to use this capability.'
+ call error_handler(E_ERR,msgstring,msgstring1)
+endif
+
+!----------------------------------------------------------------------
+! Calling static_init_assim_model() is required, which also calls
+! static_init_model(), so there is no need to explicitly call it.
+!----------------------------------------------------------------------
+
+call static_init_assim_model()
+
+!----------------------------------------------------------------------
+! initialization code, model size
+!----------------------------------------------------------------------
+
+model_size = get_model_size()
+
+!----------------------------------------------------------------------
+! Make space that is ensemble handle
+!----------------------------------------------------------------------
+call init_ensemble_manager(ens_handle, ens_size, model_size)
+
+!----------------------------------------------------------------------
+! Allocate space for file arrays.
+! Contains a matrix of files (ncopies x ndomains)
+! If perturbing from a single instance the number of
+! input files does not have to be ens_size but rather
+! a single file (or multiple files if more than one domain)
+!----------------------------------------------------------------------
+
+ndomains = get_num_domains()
+
+!----------------------------------------------------------------------
+! can be ens_size but rather a single file
+! (or multiple files if more than one domain)
+!----------------------------------------------------------------------
+allocate(file_array_input(ens_size, ndomains))
+
+file_array_input = RESHAPE(input_files, (/1, ndomains/))
+
+!----------------------------------------------------------------------
+! read in a single ensemble member
+!----------------------------------------------------------------------
+call io_filenames_init(file_info_input, &
+ ncopies = 1, &
+ cycling = single_restart_file_in, &
+ single_file = single_restart_file_in, &
+ restart_files = file_array_input)
+
+!----------------------------------------------------------------------
+! Read the template file to get the shape of netCDF file
+! and its variables. It is possible to have multiple domains
+! but only require one member.
+!----------------------------------------------------------------------
+write(my_base,'(A)') 'template'
+write(my_desc,'(A)') 'template file'
+call set_file_metadata(file_info_input, &
+ cnum = 1, &
+ fnames = file_array_input(1,:), &
+ basename = my_base, &
+ desc = my_desc)
+
+call set_io_copy_flag(file_info_input, &
+ cnum = 1, &
+ io_flag = READ_COPY)
+
+input_restart_files = get_stage_metadata(file_info_input)
+
+imem = 1
+do idom = 1, ndomains
+ write(msgstring1, *) '- Reading File : ', &
+ trim(get_restart_filename(input_restart_files, &
+ copy = imem, &
+ domain = idom))
+ call error_handler(E_MSG, 'perturb_single_instance: ', msgstring1, &
+ source, revision, revdate)
+enddo
+
+!----------------------------------------------------------------------
+! Read the ensemble from files
+!----------------------------------------------------------------------
+member_time = set_time_missing()
+call read_state(ens_handle, file_info_input, read_time_from_file=.true., time=member_time)
+
+!----------------------------------------------------------------------
+! Copy from ensemble member 1 to the other copies
+!----------------------------------------------------------------------
+do i = 1, get_my_num_vars(ens_handle)
+ ens_handle%copies(2:ens_size, i) = ens_handle%copies(1, i)
+enddo
+
+call pert_model_copies(ens_handle, ens_size, perturbation_amplitude, interf_provided)
+
+!----------------------------------------------------------------------
+! can be ens_size but rather a single file
+! (or multiple files if more than one domain)
+!----------------------------------------------------------------------
+allocate(file_array_output(ens_size, ndomains))
+
+!----------------------------------------------------------------------
+! Given either a vector of in/output_files or a text file containing
+! a list of files, return a vector of files containing the filenames.
+!----------------------------------------------------------------------
+call set_multiple_filename_lists(output_files(:), &
+ output_file_list(:), &
+ ndomains, &
+ ens_size, &
+ 'perturb_single_instance', &
+ 'output_files', &
+ 'output_file_list')
+
+file_array_output = RESHAPE(output_files, (/ens_size, ndomains/))
+
+!----------------------------------------------------------------------
+! output ens_size perturbed restarts
+!----------------------------------------------------------------------
+call io_filenames_init(file_info_output, &
+ ncopies = ens_size, &
+ cycling = single_restart_file_in, &
+ single_file = single_restart_file_in, &
+ restart_files = file_array_output)
+
+do imem = 1, ens_size
+ write(my_base,'(A,I0.2)') 'output_', imem
+ write(my_desc,'(A,I0.2)') 'output ensemble member ', imem
+ call set_file_metadata(file_info_output, &
+ cnum = imem, &
+ fnames = file_array_output(imem,:), &
+ basename = my_base, &
+ desc = my_desc)
+
+ call set_io_copy_flag(file_info_output, &
+ cnum = imem, &
+ io_flag = WRITE_COPY)
+enddo
+
+output_restart_files = get_stage_metadata(file_info_output)
+do imem = 1, ens_size
+ do idom = 1, ndomains
+ write(msgstring1, *) '- Writing File : ', imem, idom, &
+ trim(get_restart_filename(output_restart_files, &
+ copy = imem, &
+ domain = idom))
+ call error_handler(E_MSG, 'perturb_single_instance: ', msgstring1, &
+ source, revision, revdate)
+ enddo
+enddo
+
+call write_state(ens_handle, file_info_output)
+
+!----------------------------------------------------------------------
+! clean up allocated memory
+!----------------------------------------------------------------------
+call end_ensemble_manager(ens_handle)
+deallocate(file_array_output, file_array_input)
+
+call finalize_mpi_utilities()
+
+!----------------------------------------------------------------
+!----------------------------------------------------------------
+!----------------------------------------------------------------
+
+end program perturb_single_instance
+
+!
+! $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/pertirb_tool/assimilation_code/programs/perturb_single_instance/perturb_single_instance.f90 $
+! $Id: perturb_single_instance.f90 12665 2018-06-12 22:32:05Z hendric@ucar.edu $
+! $Revision: 12665 $
+! $Date: 2018-06-12 16:32:05 -0600 (Tue, 12 Jun 2018) $
diff --git a/assimilation_code/programs/perturb_single_instance/perturb_single_instance.html b/assimilation_code/programs/perturb_single_instance/perturb_single_instance.html
new file mode 100644
index 0000000000..742e32d937
--- /dev/null
+++ b/assimilation_code/programs/perturb_single_instance/perturb_single_instance.html
@@ -0,0 +1,240 @@
+
+
+
+program perturb_single_instance
+
+
+
+
+
+
+
PROGRAM perturb_single_instance
+
+
+
+
+
+
+
+
Jump to DART Documentation Main Index
+ version information for this file:
+
+ $Id: perturb_single_instance.html 12663 2018-06-12 21:55:34Z nancy@ucar.edu $
+
+Utility program to generate an ensemble of perturbed ensemble
+member restart files. This program can be run in parallel and
+used as a stand alone program.
+
+This namelist is read from the file input.nml.
+Namelists start with an ampersand
+'&' and terminate with a slash '/'.
+Character strings that contain a '/' must be
+enclosed in quotes to prevent them from
+prematurely terminating the namelist.
+
The restart file you would like to perturb from.
+
+
+
output_file_list
+
character(len=256)
+
A file containing a list of the desired output names.
+
+
+
output_files
+
character(len=256)
+
An array of filenames
+
+
+
perturbation_amplitude
+
real(r8)
+
The desired perturbation amplitude. If the model provides
+ an interface then it will use that subroutine, otherwise it
+ will simply add gaussian noise to the entire state, and this
+ is the standard deviation.
+
+
+
single_restart_file_in
+
logical
+
A boolean, specifying if you have a single file restart, such
+ as the case for lower order models.
+
+
+
+
+
+
+
+Below is an example of a typical namelist for the
+perturb_single_instance.
+
$Date: 2018-06-12 15:55:34 -0600 (Tue, 12 Jun 2018) $
+
Change history:
try "svn log" or "svn diff"
+
+
+
+
+
+
diff --git a/assimilation_code/programs/perturb_single_instance/perturb_single_instance.nml b/assimilation_code/programs/perturb_single_instance/perturb_single_instance.nml
new file mode 100644
index 0000000000..69ca028cdd
--- /dev/null
+++ b/assimilation_code/programs/perturb_single_instance/perturb_single_instance.nml
@@ -0,0 +1,10 @@
+
+&perturb_single_instance_nml
+ ens_size = 1
+ input_files = ''
+ output_files = ''
+ output_file_list = ''
+ perturbation_amplitude = 0.0
+ single_restart_file_in = .false.,
+ /
+
diff --git a/assimilation_code/programs/preprocess/preprocess.f90 b/assimilation_code/programs/preprocess/preprocess.f90
index 2bef1e12fa..f87dc47f5b 100644
--- a/assimilation_code/programs/preprocess/preprocess.f90
+++ b/assimilation_code/programs/preprocess/preprocess.f90
@@ -109,14 +109,14 @@ program preprocess
! relative to the working directory in which preprocess is being executed
! and these files are used to fill in observation kind details in
! DEFAULT_obs_def_mod.f90 and DEFAULT_obs_kind_mod.f90.
-character(len = 129) :: input_obs_def_mod_file = &
- '../../../obs_def/DEFAULT_obs_def_mod.F90'
-character(len = 129) :: output_obs_def_mod_file = &
- '../../../obs_def/obs_def_mod.f90'
-character(len = 129) :: input_obs_kind_mod_file = &
- '../../../obs_kind/DEFAULT_obs_kind_mod.F90'
-character(len = 129) :: output_obs_kind_mod_file = &
- '../../../obs_kind/obs_kind_mod.f90'
+character(len=129) :: input_obs_def_mod_file = &
+ '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
+character(len=129) :: output_obs_def_mod_file = &
+ '../../../observations/forward_operators/obs_def_mod.f90'
+character(len=129) :: input_obs_kind_mod_file = &
+ '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
+character(len=129) :: output_obs_kind_mod_file = &
+ '../../../assimilation_code/modules/observations/obs_kind_mod.f90'
character(len = 129) :: input_files(max_input_files) = 'null'
character(len = 129) :: model_files(max_model_files) = 'null'
logical :: overwrite_output = .true.
diff --git a/assimilation_code/programs/preprocess/preprocess.html b/assimilation_code/programs/preprocess/preprocess.html
index e4446d09dd..baea1cf332 100644
--- a/assimilation_code/programs/preprocess/preprocess.html
+++ b/assimilation_code/programs/preprocess/preprocess.html
@@ -56,7 +56,8 @@
Overview
0 or more special obs_def modules which contain
observation specific types and code, such as
obs_def_mod_reanalysis_bufr_mod.f90.
-By convention these files are in the obs_def directory.
+By convention these files are in the
+observations/forward_operators directory.
Path name of input obs definition module to be preprocessed. Normally
-this is DEFAULT_obs_def_mod.F90 in the obs_def directory.
+this is DEFAULT_obs_def_mod.F90 in the
+observations/forward_operators directory.
This file must have the appropriate commented lines indicating where the different
parts of the input special obs definition modules are to be inserted.
@@ -147,13 +149,15 @@
NAMELIST
output_obs_def_mod_file
character(len=129)
Path name of output obs definition module to be created by preprocessor.
-Normally this is obs_def_mod.f90 in the obs_def directory.
+Normally this is obs_def_mod.f90 in the
+observations/forward_operators directory.
input_obs_kind_mod_file
character(len=129)
Path name of input obs kind module to be preprocessed. Normally this is
-DEFAULT_obs_kind_mod.F90 in the obs_kind directory.
+DEFAULT_obs_kind_mod.F90 in the
+assimilation_code/modules/observations directory.
This file must have the appropriate commented lines indicating where the
different parts of the input special obs definition modules are to be inserted.
@@ -161,7 +165,8 @@
NAMELIST
output_obs_kind_mod_file
character(len=129)
Path name of output obs kind module to be created by the preprocessor.
-Normally this is obs_kind_mod.F90 in the obs_kind directory.
+Normally this is obs_kind_mod.F90 in the
+assimilation_code/modules/observations directory.
input_files
@@ -170,8 +175,9 @@
NAMELIST
obs definition files that are to be incorporated into the preprocessed
obs_kind_mod.f90 and obs_def_mod.f90. The files must be in the special obs
definition format that includes commented F90 lines delimitting information
-about the observation type(s). These files normally reside in the obs_def
-directory in files such as obs_def_reanalysis_bufr_mod.f90.
+about the observation type(s). These files normally reside in the
+observations/forward_operators directory in files such as
+obs_def_reanalysis_bufr_mod.f90.
overwrite_output
diff --git a/assimilation_code/programs/preprocess/preprocess.nml b/assimilation_code/programs/preprocess/preprocess.nml
index 8ed448abc1..2e0a830e4d 100644
--- a/assimilation_code/programs/preprocess/preprocess.nml
+++ b/assimilation_code/programs/preprocess/preprocess.nml
@@ -1,8 +1,8 @@
&preprocess_nml
overwrite_output = .true.,
- input_obs_def_mod_file = '../../../obs_def/DEFAULT_obs_def_mod.F90',
- output_obs_def_mod_file = '../../../obs_def/obs_def_mod.f90',
- input_obs_kind_mod_file = '../../../obs_kind/DEFAULT_obs_kind_mod.F90',
- output_obs_kind_mod_file = '../../../obs_kind/obs_kind_mod.f90',
- input_files = '../../../obs_def/null',
+ input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90',
+ output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90',
+ input_obs_kind_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90',
+ output_obs_kind_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90',
+ input_files = 'null',
/
diff --git a/assimilation_code/programs/run_tests.csh b/assimilation_code/programs/run_tests.csh
new file mode 100755
index 0000000000..6ef6c0fa9e
--- /dev/null
+++ b/assimilation_code/programs/run_tests.csh
@@ -0,0 +1,231 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+#
+# build and test all the programs given in the list.
+#
+# usage: [ -mpi | -nompi ] [ -mpicmd name_of_mpi_launch_command ]
+#
+#----------------------------------------------------------------------
+
+
+set usingmpi=no
+set MPICMD=""
+set LOGDIR=`pwd`/testing_logs
+
+if ( $#argv > 0 ) then
+ if ( "$argv[1]" == "-mpi" ) then
+ set usingmpi=yes
+ else if ( "$argv[1]" == "-nompi" ) then
+ set usingmpi=no
+ else
+ echo "Unrecognized argument to $0: $argv[1]"
+ echo "Usage: $0 [ -mpi | -nompi ] [ -mpicmd name_of_mpi_launch_command ]"
+ echo " default is to run tests without MPI"
+ exit -1
+ endif
+ shift
+endif
+
+if ( $#argv > 1 ) then
+ if ( "$argv[1]" == "-mpicmd" ) then
+ set MPICMD = "$argv[2]"
+ else
+ echo "Unrecognized argument to $0: $argv[1]"
+ echo "Usage: $0 [ -mpi | -nompi ] [ -mpicmd name_of_mpi_launch_command ]"
+ echo " default is to run tests without MPI"
+ exit -1
+ endif
+ shift
+endif
+
+# set the environment variable MPI to anything in order to enable the
+# MPI builds and tests. set the argument to the build scripts so it
+# knows which ones to build.
+if ( "$usingmpi" == "yes" ) then
+ echo "Building with MPI support."
+ set QUICKBUILD_ARG='-mpi'
+ if ( ! $?MPICMD) then
+ set MPICMD='mpirun -n 2'
+ endif
+else if ( "$usingmpi" == "no" ) then
+ echo "Building WITHOUT MPI support."
+ set QUICKBUILD_ARG='-nompi'
+ set MPICMD=""
+else
+ echo "Internal error: unrecognized value of usingmpi; should not happen"
+ exit -1
+endif
+
+#----------------------------------------------------------------------
+
+if ( ! $?REMOVE) then
+ setenv REMOVE 'rm -f'
+endif
+if ( ! $?REMOVE_DIR) then
+ setenv REMOVE_DIR 'rmdir'
+endif
+if ( ! $?COPY) then
+ setenv COPY 'cp -f'
+endif
+if ( ! $?MOVE) then
+ setenv MOVE 'mv -f'
+endif
+
+if ( ! $?host) then
+ setenv host `uname -n`
+endif
+
+echo "Running DART programs test on $host"
+
+#----------------------------------------------------------------------
+
+set programdir = `pwd`
+
+# set the list of programs to include here
+
+# FIXME: note that an important set of programs has no testing done
+# on them yet. programs currently in this directory which aren't
+# run otherwise in any test scripts include:
+#
+# closest_member_tool
+# compare_states
+# compute_error
+# fill_inflation_restart
+# gen_sampling_err_table
+# integrate_model
+# obs_assim_count
+# obs_common_subset
+# obs_diag
+# obs_impact_tool
+# obs_keep_a_few
+# obs_loop
+# obs_selection
+# obs_seq_coverage
+# obs_seq_to_netcdf
+# obs_sequence_tool
+# obs_seq_verify
+# obs_total_error
+# obs_utils
+# perturb_single_instance
+
+
+# expand these tests.
+set DO_THESE_PROGRAMS = ( \
+ compare_states \
+ system_simulation \
+)
+
+#----------------------------------------------------------------------
+# Compile all executables for each program.
+#----------------------------------------------------------------------
+
+echo
+echo
+echo "=================================================================="
+echo "Starting tests of dart programs at "`date`
+echo "=================================================================="
+echo
+echo
+
+mkdir -p $LOGDIR
+\rm -f $LOGDIR/*
+echo putting build and run logs in $LOGDIR
+
+@ programnum = 0
+
+foreach PROGRAM ( $DO_THESE_PROGRAMS )
+
+ echo
+ echo
+ echo "=================================================================="
+ echo "Compiling $PROGRAM starting at "`date`
+ echo "=================================================================="
+ echo
+ echo
+
+ cd ${programdir}/${PROGRAM}/work
+ set FAILURE = 0
+
+ ( ./quickbuild.csh ${QUICKBUILD_ARG} > ${LOGDIR}/buildlog.$PROGRAM.out ) || set FAILURE = 1
+
+ @ programnum = $programnum + 1
+
+ echo
+ echo
+ if ( $FAILURE ) then
+ echo "=================================================================="
+ echo "ERROR - unsuccessful build of $PROGRAM at "`date`
+ echo "=================================================================="
+ echo
+ echo
+ continue
+ else
+ echo "=================================================================="
+ echo "End of successful build of $PROGRAM at "`date`
+ echo "=================================================================="
+ echo
+ echo
+
+# FIXME add this back when we can successfully run tests on these programs
+
+# echo
+# echo
+# echo "=================================================================="
+# echo "Running tests for $PROGRAM starting at "`date`
+# echo "=================================================================="
+# echo
+# echo
+#
+# foreach TARGET ( mkmf_* )
+#
+# \rm -f *.o *.mod
+# \rm -f Makefile input.nml.*_default .cppdefs
+#
+ set FAILURE = 0
+# set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
+# echo "++++++++++++++++++"
+# echo Starting $PROG
+# ( ${MPICMD} ./$PROG > ${LOGDIR}/runlog.$PROG.out ) || set FAILURE = 1
+# echo Finished $PROG
+# echo "++++++++++++++++++"
+# echo
+#
+# \rm -f $PROG
+#
+# end
+#
+# echo
+# echo
+# echo "=================================================================="
+# echo "Done with tests of $PROGRAM at "`date`
+# echo "=================================================================="
+# echo
+# echo
+
+ endif
+
+
+end
+
+echo
+echo $programnum programs built.
+echo
+
+echo
+echo
+echo "=================================================================="
+echo "Ending tests of dart programs at "`date`
+echo "=================================================================="
+echo
+echo
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/assimilation_code/programs/system_simulation/full_error.f90 b/assimilation_code/programs/system_simulation/full_error.f90
index 8ee8700087..9670e6c0cb 100644
--- a/assimilation_code/programs/system_simulation/full_error.f90
+++ b/assimilation_code/programs/system_simulation/full_error.f90
@@ -66,9 +66,9 @@ program full_error
call initialize_utilities('full_error')
! Read the namelist entry
-call find_namelist_in_file("input.nml", "full_error_nml", iunit, .false.)
+call find_namelist_in_file("input.nml", "full_error_nml", iunit)
read(iunit, nml = full_error_nml, iostat = io)
-call check_namelist_read(iunit, io, "full_error_nml", .false.)
+call check_namelist_read(iunit, io, "full_error_nml")
! Record the namelist values used for the run
if (do_nml_file()) write(nmlfileunit, nml=full_error_nml)
diff --git a/assimilation_code/programs/system_simulation/test_sampling_err_table.f90 b/assimilation_code/programs/system_simulation/test_sampling_err_table.f90
index 4024a03ff7..983e59d067 100644
--- a/assimilation_code/programs/system_simulation/test_sampling_err_table.f90
+++ b/assimilation_code/programs/system_simulation/test_sampling_err_table.f90
@@ -16,14 +16,12 @@
program test_sampling_err_table
use types_mod, only : r8
-use utilities_mod, only : error_handler, E_ERR, nc_check, &
+use utilities_mod, only : error_handler, E_ERR, &
initialize_utilities, finalize_utilities
use sampling_error_correction_mod, only : get_sampling_error_table_size, &
read_sampling_error_correction
-use netcdf
-
implicit none
! version controlled file description for error handling, do not edit
diff --git a/assimilation_code/programs/system_simulation/work/path_names_test_sampling_err_table b/assimilation_code/programs/system_simulation/work/path_names_test_sampling_err_table
index 0ba7dd739e..5e75101c95 100644
--- a/assimilation_code/programs/system_simulation/work/path_names_test_sampling_err_table
+++ b/assimilation_code/programs/system_simulation/work/path_names_test_sampling_err_table
@@ -4,4 +4,5 @@ assimilation_code/modules/utilities/random_seq_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
assimilation_code/programs/system_simulation/test_sampling_err_table.f90
diff --git a/assimilation_code/programs/system_simulation/work/quickbuild.csh b/assimilation_code/programs/system_simulation/work/quickbuild.csh
index efa4bd6fa2..6f8d3a64c7 100755
--- a/assimilation_code/programs/system_simulation/work/quickbuild.csh
+++ b/assimilation_code/programs/system_simulation/work/quickbuild.csh
@@ -8,7 +8,7 @@
#
# This script compiles all executables in this directory.
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
set MODEL = "system_simulation"
@@ -25,7 +25,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -33,9 +33,9 @@ foreach TARGET ( mkmf_* )
end
# clean up. comment this out if you want to keep the .o and .mod files around
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml.*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All DART programs compiled."
exit 0
diff --git a/build_templates/mkmf.template.nag.linux b/build_templates/mkmf.template.nag.linux
new file mode 100755
index 0000000000..36cd066527
--- /dev/null
+++ b/build_templates/mkmf.template.nag.linux
@@ -0,0 +1,82 @@
+# Template for NAG Fortran Compiler on Linux clusters and workstations.
+#
+# 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
+#
+# DART $Id$
+
+# typical use with mkmf
+# mkmf -t mkmf.template.xxxx ...
+#
+# FFLAGS useful for DEBUGGING.
+# information if you LEAVE the object and module files intact.
+# Do not remove the *.o and *.mod files when debugging code.
+#
+# -g include debugging information. these are all synonyms.
+# -O0 setting -g will make this the default (no optimization).
+# it is possible to set -g and then explicitly set -O2 if
+# the behavior being debugged depends on optimization changes.
+#
+# FFLAGS useful for bitwise reproducibility and accuracy control
+# (these will slow down performance to various degrees)
+#
+# FFLAGS useful for production
+# -O2 default. optimize without too much unrepeatable numerical games
+# -O3 more aggressive optimizations. check numerical differences
+# before using this indiscriminately.
+# -O1 if you get compile-time errors about out of memory or unable to
+# complete compilation because of complexity, try lowering the
+# optimization level on the offending source files.
+#
+# FFLAGS possibly useful, not normally used by DART
+#
+# Runtime environment variables that influence the compiler behavior:
+#
+#
+# IF YOU HAVE MORE CURRENT COMPILER INFORMATION, PLEASE SHARE IT WITH US.
+
+MPIFC = mpif90
+MPILD = mpif90
+FC = nagfor
+LD = nagfor
+
+# DISCUSSION ABOUT NETCDF. DART works with both V3 and V4 flavors of netCDF.
+# Some V4 installations also require the HDF5 libraries. Some don't.
+# Some netCDF installations require both -lnetcdff and -lnetcdf, some only
+# require -lnetcdf. The permutations make it difficult to cover the possible
+# installations. Here are some candidates, you might just have to resort to
+# trial and error:
+# LIBS = -L$(NETCDF)/lib -lnetcdf
+# LIBS = -L$(NETCDF)/lib -lnetcdff -lnetcdf
+# LIBS = -L$(NETCDF)/lib -lnetcdf -lcurl -lhdf5_hl -lhdf5 -lz -lm
+# LIBS = -L$(NETCDF)/lib -lnetcdff -lnetcdf -lcurl -lhdf5_hl -lhdf5 -lz -lm
+#
+# If you get an error "ld: library not found for -lnetcdff" (note 2 f's),
+# remove it from the LIBS line. The same is true for any library. If 'ld'
+# does not complain - it worked.
+
+# If your NETCDF environment variable is not set correctly,
+# uncomment the following line and set value to where lib and include
+# are found for the netcdf files that match this compiler.
+#
+# NETCDF = /opt/local
+NETCDF = /usr/local/netcdf_c-4.3.2_f-4.4.1-nag-6.0
+
+INCS = -I$(NETCDF)/include
+LIBS = -L$(NETCDF)/lib -lnetcdff -lnetcdf
+FFLAGS = -O $(INCS)
+LDFLAGS = $(FFLAGS) $(LIBS)
+
+# for development or debugging, use this instead:
+# FFLAGS = -g -C $(INCS)
+#
+#
+# Some optimized (BLAS, LAPACK) libraries may be available with:
+# LIBS = -L$(NETCDF)/lib -lnetcdff -lnetcdf -lmkl -lmkl_lapack -lguide -lpthread
+#
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/developer_tests/compare_two_tests.csh b/developer_tests/compare_two_tests.csh
new file mode 100755
index 0000000000..f3c16104a7
--- /dev/null
+++ b/developer_tests/compare_two_tests.csh
@@ -0,0 +1,122 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+#
+# Script to compare the output files from running test_dart.csh on two
+# code bases (in preparation to merge, for example). The files under version
+# control are not considered, and the executables themselves are not considered.
+#
+# If the file is a netCDF file, the compare_states utility is run and will only
+# create output if there is a difference in one of the numeric fields.
+# If the file is a text file, 'xxdiff' is used to compare the files.
+# Otherwise, the file must be a binary file and 'cmp' is used.
+#
+# The list of files to check is created from the BRANCH1 directory.
+# Nuisance files (dart_log.*, input*default) and compiled executables
+# are removed from each directory to facilitate meaningful comparison.
+
+# FIXME ... this script should not be run in either the BRANCH1 or the BRANCH2
+# because the compare_states executable will be removed by the findexec step.
+
+set nonomatch
+set SNAME = $0
+
+set BRANCH1 = /glade/work/thoar/DART/clean_rma_trunk
+set BRANCH2 = /glade/work/thoar/DART/candidate_rma_trunk
+set orgdir = `pwd`
+
+cp $BRANCH1/assimilation_code/programs/compare_states/work/compare_states .
+cp $BRANCH1/assimilation_code/programs/compare_states/work/input.nml .
+
+# We want to remove the newly-compiled executables.
+# long-winded alias to find binary executables and not mkmf_ for example.
+alias findexec "find . -type f -print | grep -v '\.svn' | xargs file | grep -i executable | grep -v 'text executable' | sed -e 's/: .*//'"
+
+foreach CANDIDATE ( $BRANCH1 $BRANCH2 )
+ cd $CANDIDATE
+ echo "Removing nuisance files from $CANDIDATE"
+ \rm `find . -name dart_log.nml`
+ \rm `find . -name dart_log.out`
+ \rm `find . -name input*default`
+ echo "Removing DART executables from $CANDIDATE"
+ \rm `findexec`
+ cd -
+end
+
+# Want to compare the unversioned output files from running test_dart.csh
+# The unversioned files have a '?' in column 1, and we need to remove the
+# question mark and the blank spaces before the filename. We want FileList
+# to contain the filenames relative to the base directory.
+
+cd ${BRANCH1}
+set FileList = `svn status | grep '^?' | sed -e "s#. *##"`
+cd ${orgdir}
+
+foreach FileName ( $FileList ) # loop through all the files
+
+ # some versions of 'file' identify *.nml files as Sendmail
+
+ set OrgFile = ${BRANCH1}/${FileName}
+ set NewFile = ${BRANCH2}/${FileName}
+
+ set asciicheck = `(file ${OrgFile} | grep ASCII)`
+ set isascii = $status
+ set textcheck = `(file ${OrgFile} | grep " text")`
+ set istext = $status
+ set textcheck = `(file ${OrgFile} | grep " FORTRAN")`
+ set isfortranish = $status
+ set mailcheck = `(file ${OrgFile} | grep " Sendmail")`
+ set isnamelist = $status
+
+ if ($isascii == 0 || $istext == 0 || $isfortranish == 0 || $isnamelist == 0) then
+ set isascii = 0
+ else
+ set isascii = 1
+ endif
+
+ switch ( $OrgFile:e )
+ case 'nc'
+ set netcdf = 1
+ breaksw
+ default:
+ set netcdf = 0
+ breaksw
+ endsw
+
+ if ( -f ${NewFile} && $isascii == 0 ) then ;# ASCII file exists
+
+ set numdiffs = `cmp ${OrgFile} ${NewFile} | wc`
+ if ( $numdiffs[1] > 0 ) then
+ echo "${OrgFile} and ${NewFile} differ ... comparing ..."
+ xxdiff ${OrgFile} ${NewFile}
+ else
+ echo "${OrgFile} and ${NewFile} are identical ... nothing to do."
+ endif
+
+ else if ( $netcdf > 0 ) then ;# netCDF file, use compare_states to summarize
+ echo ${OrgFile} ${NewFile} | ./compare_states
+
+ else if ( -f ${NewFile} ) then ;# binary file exists, compare
+
+ cmp ${OrgFile} ${NewFile}
+ set DIFFSTAT = $status
+ if ( $DIFFSTAT != 0 ) then
+ echo "${OrgFile} and ${NewFile} differ ... non_ASCII"
+ endif
+
+ else
+ echo "${NewFile} does not exist"
+ endif
+
+end
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/developer_tests/io/test_cf_conventions.f90 b/developer_tests/io/test_cf_conventions.f90
index 72dc311862..eb7e669a64 100644
--- a/developer_tests/io/test_cf_conventions.f90
+++ b/developer_tests/io/test_cf_conventions.f90
@@ -6,33 +6,23 @@
program test_cf_conventions
-use types_mod, only : r4, r8, i8, metadatalength, MISSING_R8
+use types_mod, only : r4, r8, i8, MISSING_R8 , MISSING_R4
use utilities_mod, only : register_module, error_handler, E_MSG, E_ERR
-use adaptive_inflate_mod, only : adaptive_inflate_init, &
- adaptive_inflate_type
-use mpi_utilities_mod, only : initialize_mpi_utilities, &
- finalize_mpi_utilities
-use assim_model_mod, only : static_init_assim_model, &
- get_model_size
-use state_vector_io_mod, only : read_state, write_state
-use ensemble_manager_mod, only : init_ensemble_manager, &
- ensemble_type, &
+use adaptive_inflate_mod, only : adaptive_inflate_init
+use mpi_utilities_mod, only : initialize_mpi_utilities, finalize_mpi_utilities
+use state_vector_io_mod, only : read_state, write_state, state_vector_io_init
+use ensemble_manager_mod, only : init_ensemble_manager, ensemble_type, &
set_num_extra_copies
-use io_filenames_mod, only : io_filenames_init, &
- io_filenames_finalize, &
- file_info_type, &
- get_output_file
-use state_structure_mod, only : get_xtype, &
- get_units, &
- get_long_name, &
- get_short_name, &
- get_has_missing_value, &
- get_FillValue, &
- get_missing_value, &
- get_add_offset, &
- get_scale_factor
-use time_manager_mod, only : time_type, &
- set_time
+use io_filenames_mod, only : io_filenames_init, io_filenames_finalize, &
+ file_info_type, netcdf_file_type, READ_COPY, &
+ set_file_metadata, set_io_copy_flag
+use state_structure_mod, only : get_xtype, get_units, get_long_name, &
+ get_short_name, get_has_missing_value, &
+ get_FillValue, get_missing_value, &
+ get_add_offset, get_scale_factor, &
+ add_domain, state_structure_info, &
+ get_sum_variables
+use time_manager_mod, only : time_type, set_time
use filter_mod, only : filter_set_initial_time
use assert_mod, only : assert_equal
@@ -46,26 +36,22 @@ program test_cf_conventions
character(len=32 ), parameter :: revision = "$Revision$"
character(len=128), parameter :: revdate = "$Date$"
-logical, save :: module_initialized = .false.
+! this should be a namelist variable
+logical :: verbose = .false.
type(ensemble_type) :: ens_handle
type(file_info_type) :: file_info_input
-type(file_info_type) :: file_info_output
type(time_type) :: time1
-type(adaptive_inflate_type) :: prior_inflate_handle, post_inflate_handle
-type(netcdf_file_type) :: PriorStateUnit_handle, PosteriorStateUnit_handle
type(time_type) :: curr_ens_time
+character(len=256) :: test_file(1) = "cf_test.nc"
integer(i8) :: model_size
-integer :: ens_size, num_extras, num_copies
+integer :: num_ens = 1
+integer :: num_extras = 0
+integer :: num_copies
logical :: read_time_from_file
-integer :: num_output_state_members = 3
-integer :: output_state_mean_index, output_state_spread_index
-
-logical :: output_inflation = .true. ! This is for the diagnostic files, no separate option for prior and posterior
-
integer :: domid = 1 ! only one domain
integer :: var_xtype
character(len=NF90_MAX_NAME) :: var_units, blank_string, var_att_name
@@ -76,52 +62,38 @@ program test_cf_conventions
blank_string = ' '
-! main code here
-
! initialize the dart libs
call initialize_module()
-call error_handler(E_ERR,'test_cf_conventions ',&
- 'Has not been tested yet with new naming conventions.',source,revision,revdate)
+!>@todo FIXME ... add variable E when scale/offset are supported
+domid = add_domain(test_file(1), num_vars=4, var_names=(/'A', 'B', 'C', 'D'/))
-model_size = get_model_size()
+if (verbose) then
+ call state_structure_info(domid)
+endif
-write(*,*) " model size : ", model_size
+! since we are calling add_domain directly instead of through
+! static_assim_model_mod we need to get the total number of
+! variables from the state_strucutre_mod instead of using
+! get_model_size()
+model_size = get_sum_variables(1, 4, domid)
-ens_size = 3
-num_extras = 12
+write(*,*) " model size : ", model_size
-num_copies = ens_size + num_extras
+num_copies = num_ens + num_extras
! initalize routines needed for read_state and write_state
call init_ensemble_manager(ens_handle, num_copies, model_size)
call set_num_extra_copies(ens_handle, num_extras)
call filter_set_initial_time(0,0,time1,read_time_from_file)
-call initialize_copy_numbers(ens_size)
-call initialize_adaptive_inflate(ens_handle, prior_inflate_handle, post_inflate_handle)
-call initialize_diagnostics(PriorStateUnit_handle, PosteriorStateUnit_handle)
-file_info_input = initialize_filenames(ens_handle, overwrite_state_input=.false.)
-file_info_output = initialize_filenames(ens_handle, overwrite_state_input=.false.)
+file_info_input = initialize_filenames(test_file)
curr_ens_time = set_time(0, 0)
! read in restarts
call read_state(ens_handle, file_info_input, read_time_from_file, time1)
-! If needed, store copies(mean, sd, inf_mean, inf_sd) that would have
-! gone in Prior_Diag.nc and write them at the end.
-call store_prior(ens_handle)
-
-!call filter_state_space_diagnostics(file_info_input, curr_ens_time, PriorStateUnit_handle, ens_handle, &
-! model_size, num_output_state_members, &
-! output_state_mean_index, output_state_spread_index, output_inflation,&
-! ENS_MEAN_COPY, ENS_SD_COPY, &
-! prior_inflate_handle, PRIOR_INF_COPY, PRIOR_INF_SD_COPY)
-
-! write out all files possible including restarts, mean, sd, and prior/posterior inflation files
-call write_state(ens_handle, file_info_output, prior_inflate_handle, post_inflate_handle)
-
write(*,*)' '
write(*,*)'======================================================================'
write(*,*)' Unit Test for CF-Conventions'
@@ -140,13 +112,15 @@ program test_cf_conventions
var_xtype = get_xtype(domid,3)
call assert_equal(var_xtype, NF90_DOUBLE, 'variable3:get_xtype')
-var_xtype = get_xtype(domid,3)
+var_xtype = get_xtype(domid,4)
call assert_equal(var_xtype, NF90_DOUBLE, 'variable4:get_xtype')
! test units
write(*,*)'Testing get_units'
+!> todo FIXME Need a unique prefix so don't confuse with get_unit
+
var_units = get_units(domid,1)
call assert_equal(var_units, 'units A', 'variable1:get_units')
@@ -171,8 +145,8 @@ program test_cf_conventions
var_att_name = get_long_name(domid,3)
call assert_equal(var_att_name, 'variable C', 'variable3:get_long_name')
-! var_att_name = get_long_name(domid,4)
-! call assert_equal(var_att_name, 'D', 'variable4:get_long_name')
+var_att_name = get_long_name(domid,4)
+call assert_equal(var_att_name, blank_string, 'variable4:get_long_name')
write(*,*)'Testing get_short_name'
@@ -221,23 +195,25 @@ program test_cf_conventions
! call get_FillValue(domid,4,missR8)
! call assert_equal(missR8, -88888.88888_r8, 'variable4:get_FillValue')
-write(*,*)'Testing offset and scale factor'
+! write(*,*)'Testing offset and scale factor'
! this is only for r8 at the moment
! since it is not being used within DART
+! NOTE: This test is supposed to break.
+! Commenting it out for testing all programs.
-var_offset = get_add_offset(domid,3)
-call assert_equal(var_offset, 2.0_r8, 'variable3:get_var_offset')
-
-var_offset = get_add_offset(domid,4)
-call assert_equal(var_offset, MISSING_R8 , 'variable4:get_var_offset')
-
-
-var_scale_factor = get_scale_factor(domid,3)
-call assert_equal(var_scale_factor, 0.2_r8 , 'variable3:get_scale_factor')
-
-var_scale_factor = get_scale_factor(domid,4)
-call assert_equal(var_scale_factor, MISSING_R8 , 'variable3:get_scale_factor')
+! var_offset = get_add_offset(domid,3)
+! call assert_equal(var_offset, 2.0_r8, 'variable3:get_var_offset')
+!
+! var_offset = get_add_offset(domid,4)
+! call assert_equal(var_offset, missR8 , 'variable4:get_var_offset')
+!
+!
+! var_scale_factor = get_scale_factor(domid,3)
+! call assert_equal(var_scale_factor, 0.2_r8 , 'variable3:get_scale_factor')
+!
+! var_scale_factor = get_scale_factor(domid,4)
+! call assert_equal(var_scale_factor, missR8 , 'variable3:get_scale_factor')
write(*,*)' '
write(*,*)'======================================================================'
@@ -245,19 +221,8 @@ program test_cf_conventions
write(*,*)'======================================================================'
write(*,*)' '
-!>@todo FIXME : do we want to go through and do a unit test for the files that are being output?
-!> I think that this may be more of a time hole than it is worth. I have checked
-!> the file attributes by hand for both creating files from scratch and appending
-!> clamping data to files that have global attributes for clamping.
-! call exit(0)
-!
- call io_filenames_finalize(file_info_input)
- call io_filenames_finalize(file_info_output)
-! file_info = initialize_filenames(ens_handle, overwrite_state_input=.true.)
-!
-! ! write out all files possible including restarts, mean, sd, and prior/posterior inflation files
-! call write_state(ens_handle, file_info, prior_inflate_handle, post_inflate_handle)
-
+call io_filenames_finalize(file_info_input)
+
! finalize test_cf_conventions
call error_handler(E_MSG,'test_cf_conventions','Finished successfully.',source,revision,revdate)
call finalize_mpi_utilities()
@@ -271,171 +236,52 @@ program test_cf_conventions
subroutine initialize_module
- call initialize_mpi_utilities('test_cf_conventions')
- call register_module(source, revision, revdate)
- call static_init_assim_model()
- module_initialized = .true.
+call initialize_mpi_utilities('test_cf_conventions')
+call register_module(source, revision, revdate)
+!call static_init_assim_model()
+call state_vector_io_init()
end subroutine initialize_module
!----------------------------------------------------------------------
-function initialize_filenames(ensemble_handle, overwrite_state_input) result(file_handle)
-
-type(ensemble_type), intent(inout) :: ensemble_handle
-logical, intent(in) :: overwrite_state_input
+function initialize_filenames(filename) result(file_handle)
+character(len=*), intent(in) :: filename(:)
type(file_info_type) :: file_handle
-logical :: single_restart_file_in = .false.
-logical :: single_restart_file_out = .false.
-logical :: use_restart_list = .false.
-logical :: output_restart = .true.
-logical :: output_restart_mean = .true.
-logical :: add_domain_extension = .false.
-! logical :: perturb_from_single_instance = .false.
+integer :: num_domains = 1
+integer :: imem
-character(len=512) :: restart_list_file(10) = 'null'
-character(len=129) :: inf_in_file_name(2) = 'inf_in'
-character(len=129) :: inf_out_file_name(2) = 'inf_out'
+character(len=256), allocatable :: file_array(:,:)
+character(len=512) :: my_base, my_desc
-character(len=129) :: restart_in_file_name = "cf_test"
-character(len=129) :: restart_out_file_name = "cf_test_out"
+allocate(file_array(num_ens, num_domains))
+file_array = RESHAPE(filename, (/num_ens, num_domains/))
-logical :: direct_netcdf_read = .true.
-logical :: direct_netcdf_write = .true.
+call io_filenames_init(file_handle, &
+ ncopies = 1, &
+ cycling = .false., &
+ single_file = .false., &
+ restart_files = file_array)
-file_handle = io_filenames_init(ensemble_handle, single_restart_file_in, &
- restart_list_file, 'root_name', .true.)
+do imem = 1, num_ens
+ write(my_base,'(A,I2)') 'inens_', imem
+ write(my_desc,'(A,I2)') 'input ens', imem
+ call set_file_metadata(file_handle, &
+ cnum = imem, &
+ fnames = file_array(imem,:), &
+ basename = my_base, &
+ desc = my_desc)
-end function initialize_filenames
+ call set_io_copy_flag(file_handle, &
+ cnum = imem, &
+ io_flag = READ_COPY)
+enddo
-!----------------------------------------------------------------------
-
-subroutine initialize_adaptive_inflate(ensemble_handle, prior_inflate, post_inflate)
-type(ensemble_type), intent(inout) :: ensemble_handle
-type(adaptive_inflate_type), intent(inout) :: prior_inflate, post_inflate
-
-! Inflation namelist entries follow, first entry for prior, second for posterior
-! inf_flavor is 0:none, 1:obs space, 2: varying state space, 3: fixed state_space
-integer :: inf_flavor(2) = 2
-logical :: inf_initial_from_restart(2) = .false.
-logical :: inf_sd_initial_from_restart(2) = .false.
-logical :: inf_output_restart(2) = .true.
-logical :: inf_deterministic(2) = .true.
-
-character(len=129) :: inf_in_file_name(2) = 'inf_in', &
- inf_out_file_name(2) = 'inf_out', &
- inf_diag_file_name(2) = 'inf_diag'
-
-real(r8) :: inf_initial(2) = 1.0_r8
-real(r8) :: inf_sd_initial(2) = 0.0_r8
-real(r8) :: inf_lower_bound(2) = 1.0_r8
-real(r8) :: inf_upper_bound(2) = 1000000.0_r8
-real(r8) :: inf_sd_lower_bound(2) = 0.0_r8
-
-logical :: allow_missing = .false.
-
-inf_out_file_name(1) = 'inf_out1'
-inf_out_file_name(2) = 'inf_out2'
-
-! Initialize the adaptive inflation module
-call adaptive_inflate_init(prior_inflate, inf_flavor(1), inf_initial_from_restart(1), &
- inf_sd_initial_from_restart(1), inf_output_restart(1), inf_deterministic(1), &
- inf_initial(1), &
- inf_sd_initial(1), inf_lower_bound(1), inf_upper_bound(1), inf_sd_lower_bound(1), &
- ensemble_handle, PRIOR_INF_COPY, PRIOR_INF_SD_COPY, allow_missing, 'Prior')
-
-call adaptive_inflate_init(post_inflate, inf_flavor(2), inf_initial_from_restart(2), &
- inf_sd_initial_from_restart(2), inf_output_restart(2), inf_deterministic(2), &
- inf_initial(2), &
- inf_sd_initial(2), inf_lower_bound(2), inf_upper_bound(2), inf_sd_lower_bound(2), &
- ensemble_handle, POST_INF_COPY, POST_INF_SD_COPY, allow_missing, 'Posterior')
-
-!call adaptive_inflate_end(prior_inflate, ensemble_handle, PRIOR_INF_COPY, PRIOR_INF_SD_COPY)
-!call adaptive_inflate_end(post_inflate, ensemble_handle, POST_INF_COPY, POST_INF_SD_COPY)
-
-end subroutine initialize_adaptive_inflate
-
-!----------------------------------------------------------------------
-
-subroutine initialize_copy_numbers(ens_size)
-integer, intent(in) :: ens_size
-
-ENS_MEAN_COPY = ens_size + 1
-ENS_SD_COPY = ens_size + 2
-PRIOR_INF_COPY = ens_size + 3
-PRIOR_INF_SD_COPY = ens_size + 4
-POST_INF_COPY = ens_size + 5
-POST_INF_SD_COPY = ens_size + 6
-SPARE_PRIOR_MEAN = ens_size + 7
-SPARE_PRIOR_SPREAD = ens_size + 8
-SPARE_PRIOR_INF_MEAN = ens_size + 9
-SPARE_PRIOR_INF_SPREAD = ens_size + 10
-SPARE_POST_INF_MEAN = ens_size + 11
-SPARE_POST_INF_SPREAD = ens_size + 12
-
-end subroutine initialize_copy_numbers
+end function initialize_filenames
!----------------------------------------------------------------------
-subroutine initialize_diagnostics(PriorStateUnit, PosteriorStateUnit )
-type(netcdf_file_type), intent(inout) :: PriorStateUnit, PosteriorStateUnit
-
-integer :: i, ensemble_offset, num_state_copies
-character(len=metadatalength) :: state_meta(num_output_state_members + 4)
-
-! Section for state variables + other generated data stored with them.
-
-! Ensemble mean goes first
-num_state_copies = num_output_state_members + 2
-output_state_mean_index = 1
-state_meta(output_state_mean_index) = 'ensemble mean'
-
-! Ensemble spread goes second
-output_state_spread_index = 2
-state_meta(output_state_spread_index) = 'ensemble spread'
-! Compute starting point for ensemble member output
-ensemble_offset = 2
-
-! Set up the metadata for the output state diagnostic files
-do i = 1, ens_size
- write(state_meta(i + ensemble_offset), '(a15, 1x, i6)') 'ensemble member', i
-end do
-
-! Next two slots are for inflation mean and sd metadata
-! To avoid writing out inflation values to the Prior and Posterior netcdf files,
-! set output_inflation to false in the filter section of input.nml
-if(output_inflation) then
- num_state_copies = num_state_copies + 2
- state_meta(num_state_copies-1) = 'inflation mean'
- state_meta(num_state_copies) = 'inflation sd'
-endif
-
-! Set up diagnostic output for model state
-! All task call init and finalize diag_output. The choice can then be made
-! in direct_netcdf_mod to use a collective call (e.g. pnetcdf) or not.
-PriorStateUnit = init_diag_output('preassim', &
- 'prior ensemble state', num_state_copies, state_meta)
-PosteriorStateUnit = init_diag_output('analysis', &
- 'posterior ensemble state', num_state_copies, state_meta)
-
-end subroutine initialize_diagnostics
-
-!------------------------------------------------------------------
-!> Copy the current mean, sd, inf_mean, inf_sd to spare copies
-!> Assuming that if the spare copy is there you should fill it
-subroutine store_prior(ens_handle)
-
-type(ensemble_type), intent(inout) :: ens_handle
-
-ens_handle%copies(SPARE_PRIOR_MEAN, :) = ens_handle%copies(ENS_MEAN_COPY, :)
-ens_handle%copies(SPARE_PRIOR_SPREAD, :) = ens_handle%copies(ENS_SD_COPY, :)
-ens_handle%copies(SPARE_PRIOR_INF_MEAN, :) = ens_handle%copies(PRIOR_INF_COPY, :)
-ens_handle%copies(SPARE_PRIOR_INF_SPREAD, :) = ens_handle%copies(PRIOR_INF_SD_COPY, :)
-
-end subroutine store_prior
-
-
end program
!
diff --git a/developer_tests/io/test_diag_structure.f90 b/developer_tests/io/test_diag_structure.f90
index c670b31133..2a97df45e7 100644
--- a/developer_tests/io/test_diag_structure.f90
+++ b/developer_tests/io/test_diag_structure.f90
@@ -21,6 +21,7 @@
program test_diag_structure
use types_mod, only : i8
+use utilities_mod, only : initialize_utilities, finalize_utilities
use state_structure_mod, only : create_diagnostic_structure, end_diagnostic_structure, &
add_domain, get_num_variables, get_num_dims, &
get_num_domains, get_dim_name, get_variable_name, &
@@ -41,6 +42,9 @@ program test_diag_structure
model_size = 44
+! init library
+call initialize_utilities()
+
! Add domain
domain_id = add_domain(model_size)
@@ -138,6 +142,7 @@ program test_diag_structure
! This should die
!print*, get_num_dims(diag_id, 1)
+call finalize_utilities()
!-----------------------------------------------------------------------------
diff --git a/developer_tests/io/test_read_write_restarts.f90 b/developer_tests/io/test_read_write_restarts.f90
index d90c1df0e3..be40ad7708 100644
--- a/developer_tests/io/test_read_write_restarts.f90
+++ b/developer_tests/io/test_read_write_restarts.f90
@@ -6,20 +6,20 @@
program test_read_write_restarts
-use types_mod, only : r8, i8
-use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
- open_file, close_file, nc_check, get_next_filename, &
- find_namelist_in_file, check_namelist_read, &
- do_nml_file, do_nml_term, nmlfileunit, &
- initialize_utilities, finalize_utilities
-use mpi_utilities_mod, only : initialize_mpi_utilities, finalize_mpi_utilities, &
- task_sync, my_task_id
-use assim_model_mod, only : static_init_assim_model, get_model_size
-use state_vector_io_mod, only : read_state, write_state
+use types_mod, only : r8, i8, vtablenamelength
+use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
+ find_namelist_in_file, check_namelist_read, &
+ do_nml_file, do_nml_term, nmlfileunit, to_upper
+use mpi_utilities_mod, only : initialize_mpi_utilities, &
+ finalize_mpi_utilities
+use obs_kind_mod, only : get_index_for_quantity
+use state_vector_io_mod, only : read_state, write_state
+use state_structure_mod, only : add_domain, get_sum_variables
use ensemble_manager_mod, only : init_ensemble_manager, ensemble_type
-use io_filenames_mod, only : io_filenames_init, file_info_type
-use time_manager_mod, only : time_type
-use filter_mod, only : filter_set_initial_time
+use io_filenames_mod, only : io_filenames_init, file_info_type, READ_COPY, &
+ set_file_metadata, set_io_copy_flag, WRITE_COPY
+use time_manager_mod, only : time_type
+use filter_mod, only : filter_set_initial_time
implicit none
@@ -29,48 +29,56 @@ program test_read_write_restarts
character(len=32 ), parameter :: revision = "$Revision$"
character(len=128), parameter :: revdate = "$Date$"
-logical, save :: module_initialized = .false.
+integer :: num_ens = 1
+integer :: num_domains = 1
+integer :: imem, domid
+
+type(file_info_type) :: file_input_handle
+type(file_info_type) :: file_output_handle
+
+character(len=256), allocatable :: file_array_input(:,:)
+character(len=256), allocatable :: file_array_output(:,:)
+character(len=512) :: my_base, my_desc, string1
integer :: iunit, io
type(ensemble_type) :: ens_handle
-type(file_info_type) :: file_info
type(time_type) :: time1
-logical :: single_restart_file_in = .false.
-logical :: single_restart_file_out = .false.
-logical :: use_restart_list = .false.
-logical :: output_restart = .true.
-logical :: output_restart_mean = .false.
-logical :: add_domain_extension = .true.
-logical :: overwrite_state_input = .false.
+logical :: single_file_in = .false.
logical :: read_time_from_file
-logical :: perturb_from_single_instance = .false.
-
-character(len=512) :: restart_list_file(10) = 'null'
-character(len=129) :: inf_in_file_name(2) = 'not_initialized'
-character(len=129) :: inf_out_file_name(2) = 'not_initialized'
integer(i8) :: model_size
integer :: ens_size = 3
-character(len=129) :: restart_in_file_name
-character(len=129) :: restart_out_file_name
-logical :: direct_netcdf_read = .false.
-logical :: direct_netcdf_write = .false.
+! Number of fields in the state vector
+integer :: nfields
+
+! DART state vector contents are specified in the input.nml:&model_nml namelist.
+integer, parameter :: max_state_variables = 10
+integer, parameter :: num_state_table_columns = 3
+character(len=vtablenamelength) :: variable_table( max_state_variables, num_state_table_columns )
+integer :: state_kinds_list( max_state_variables )
+character(len=vtablenamelength) :: model_variables(max_state_variables * num_state_table_columns ) = ' '
+
+! identifiers for variable_table
+integer, parameter :: VAR_NAME_INDEX = 1
+integer, parameter :: VAR_QTY_INDEX = 2
+integer, parameter :: VAR_UPDATE_INDEX = 3
+
+! namelist variables
+character(len=256) :: input_file(1) = "cf_test.nc"
+character(len=256) :: output_file(1) = "cf_test_out.nc"
+logical :: verbose = .false.
! namelist items we are going to create/overwrite
-namelist /test_read_write_restarts_nml/ restart_in_file_name, restart_out_file_name, &
-direct_netcdf_read, direct_netcdf_write, restart_list_file, use_restart_list
+namelist /test_read_write_restarts_nml/ input_file, model_variables, verbose
! main code here
! initialize the dart libs
call initialize_module()
-call error_handler(E_ERR,'test_read_write_restarts ',&
- 'Has not been tested yet with new naming conventions.',source,revision,revdate)
-
! Read back the namelist entry
call find_namelist_in_file("input.nml", "test_read_write_restarts_nml", iunit)
read(iunit, nml = test_read_write_restarts_nml, iostat = io)
@@ -80,23 +88,39 @@ program test_read_write_restarts
if (do_nml_file()) write(nmlfileunit, nml=test_read_write_restarts_nml)
if (do_nml_term()) write( * , nml=test_read_write_restarts_nml)
-model_size = get_model_size()
+! verify that the model_variables namelist was filled in correctly.
+! returns variable_table which has variable names, and kind strings.
+call verify_state_variables(model_variables, nfields, variable_table, state_kinds_list)
+
+domid = add_domain(input_file(1), &
+ num_vars = nfields, &
+ var_names = variable_table(1:nfields, VAR_NAME_INDEX), &
+ kind_list = state_kinds_list)
+
+! since we are calling add_domain directly instead of through
+! static_assim_model_mod we need to get the total number of
+! variables from the state_strucutre_mod instead of using
+! get_model_size()
+model_size = get_sum_variables(1, nfields, domid)
call init_ensemble_manager(ens_handle, ens_size, model_size)
call filter_set_initial_time(-1,-1,time1,read_time_from_file)
-file_info = io_filenames_init(ens_handle, single_restart_file_in, single_restart_file_out, &
- restart_in_file_name, restart_out_file_name, output_restart, direct_netcdf_read, &
- direct_netcdf_write, output_restart_mean, add_domain_extension, use_restart_list, &
- restart_list_file, overwrite_state_input, inf_in_file_name, inf_out_file_name)
+! set up the filename handle for reading
+file_input_handle = initialize_filenames(input_file, READ_COPY)
+
+call read_state(ens_handle, file_input_handle, read_time_from_file, time1)
-call read_state(ens_handle, file_info, read_time_from_file, time1)
+! set up the filename handle for writing
+file_output_handle = initialize_filenames(output_file, WRITE_COPY)
-call write_state(ens_handle, file_info)
+call write_state(ens_handle, file_output_handle)
! finalize test_read_write_restarts
-call error_handler(E_MSG,'test_read_write_restarts','Finished successfully.',source,revision,revdate)
+call error_handler(E_MSG,'test_read_write_restarts','Finished successfully.',&
+ source,revision,revdate)
+
call finalize_mpi_utilities()
! end of main code
@@ -110,11 +134,105 @@ subroutine initialize_module
call initialize_mpi_utilities('test_read_write_restarts')
call register_module(source, revision, revdate)
- call static_init_assim_model()
- module_initialized = .true.
end subroutine initialize_module
+!------------------------------------------------------------------
+!> Verify that the namelist was filled in correctly, and check
+!> that there are valid entries for the dart_kind.
+!> Returns a table with columns:
+!>
+!> netcdf_variable_name ; dart_kind_string
+
+subroutine verify_state_variables( state_variables, ngood, table, kind_list)
+
+character(len=*), intent(inout) :: state_variables(:)
+integer, intent(out) :: ngood
+character(len=*), intent(out) :: table(:,:)
+integer, intent(out) :: kind_list(:) ! kind number
+
+integer :: nrows, i
+character(len=256) :: varname
+character(len=32) :: kindstr
+
+nrows = size(table,1)
+
+ngood = 0
+
+if ( state_variables(1) == ' ' ) then ! no model_variables namelist provided
+ string1 = 'model_nml:model_variables not specified'
+ call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate)
+endif
+
+MyLoop : do i = 1, nrows
+
+ varname = trim(state_variables(2*i -1))
+ kindstr = trim(state_variables(2*i ))
+
+ table(i,1) = trim(varname)
+ table(i,2) = trim(kindstr)
+
+ if ( table(i,1) == ' ' .and. table(i,2) == ' ') exit MyLoop ! Found end of list.
+
+ if ( table(i,1) == ' ' .and. table(i,2) == ' ') then
+ string1 = 'model_nml:model_variables not fully specified'
+ call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate)
+ endif
+
+ ! Make sure DART kind is valid
+
+ kind_list(i) = get_index_for_quantity(kindstr)
+ if( kind_list(i) < 0 ) then
+ write(string1,'(''there is no obs_kind <'',a,''> in obs_kind_mod.f90'')') trim(kindstr)
+ call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate)
+ endif
+
+ ! Record the contents of the DART state vector
+
+ if (verbose) then
+ write(string1,'(A,I2,6A)') 'variable ',i,' is ',trim(varname), ', ', trim(kindstr)
+ call error_handler(E_MSG,'verify_state_variables',string1,source,revision,revdate)
+ endif
+
+ ngood = ngood + 1
+enddo MyLoop
+
+end subroutine verify_state_variables
+
+!----------------------------------------------------------------------
+
+function initialize_filenames(filename, IO_STRING) result (file_handle)
+character(len=*), intent(in) :: filename(:)
+integer, intent(in) :: IO_STRING
+type(file_info_type) :: file_handle
+
+character(len=256), allocatable :: file_array(:,:)
+
+allocate(file_array(num_ens, num_domains))
+file_array = RESHAPE(filename, (/num_ens, num_domains/))
+
+call io_filenames_init(file_handle, &
+ ncopies = 1, &
+ cycling = .false., &
+ single_file = single_file_in, &
+ restart_files = file_array)
+
+do imem = 1, num_ens
+ write(my_base,'(A,I2)') 'outens_', imem
+ write(my_desc,'(A,I2)') 'output ens', imem
+ call set_file_metadata(file_handle, &
+ cnum = imem, &
+ fnames = file_array(imem,:), &
+ basename = my_base, &
+ desc = my_desc)
+
+ call set_io_copy_flag(file_handle, &
+ cnum = imem, &
+ io_flag = IO_STRING)
+enddo
+
+end function
+
!----------------------------------------------------------------------
end program
diff --git a/developer_tests/io/test_read_write_time.f90 b/developer_tests/io/test_read_write_time.f90
new file mode 100644
index 0000000000..2cf07865cb
--- /dev/null
+++ b/developer_tests/io/test_read_write_time.f90
@@ -0,0 +1,120 @@
+! 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: test_read_write_time.f90 13006 2019-03-06 23:28:13Z thoar@ucar.edu $
+
+!>@todo FIXME - add more tests ... wrong calendars, etc.
+
+program test_read_write_time
+
+use types_mod, only : r8, i8
+use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
+ find_namelist_in_file, check_namelist_read, &
+ do_nml_file, do_nml_term, nmlfileunit, to_upper, &
+ initialize_utilities, finalize_utilities
+
+use netcdf_utilities_mod, only : nc_open_file_readwrite, nc_close_file
+use dart_time_io_mod, only : read_model_time, write_model_time
+use time_manager_mod, only : time_type, set_calendar_type, get_calendar_type, &
+ set_time, print_time, operator(+)
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=*), parameter :: source = &
+ "$URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/developer_tests/io/test_read_write_time.f90 $"
+character(len=*), parameter :: revision = "$Revision: 13006 $"
+character(len=*), parameter :: revdate = "$Date: 2019-03-06 16:28:13 -0700 (Wed, 06 Mar 2019) $"
+
+character(len=512) :: msgstring
+
+integer :: iunit, io, ncid, i
+integer, parameter :: MAXFILES = 100
+
+type(time_type) :: mytime
+
+! namelist variables
+character(len=256) :: input_file(MAXFILES) = ""
+logical :: verbose = .false.
+
+! namelist items we are going to create/overwrite
+namelist /test_read_write_time_nml/ input_file, verbose
+
+
+! main code here
+
+! initialize the dart libs
+call initialize_module()
+
+! Read back the namelist entry
+call find_namelist_in_file("input.nml", "test_read_write_time_nml", iunit)
+read(iunit, nml = test_read_write_time_nml, iostat = io)
+call check_namelist_read(iunit, io, "test_read_write_time_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=test_read_write_time_nml)
+if (do_nml_term()) write( * , nml=test_read_write_time_nml)
+
+call error_handler(E_MSG, "", "")
+
+! intent is to open a list of netcdf files with various permutations
+! of time variable, dimension, size, etc and see if read/write model time
+! routines (the default ones) work or error out correctly
+
+do i = 1, MAXFILES
+ if (input_file(i) == "") exit
+
+ ! to test:
+ ! function read_model_time(filename)
+ ! subroutine write_model_time(ncid, dart_time)
+
+ mytime = read_model_time(input_file(i))
+
+ call print_time(mytime,'read_model_time first')
+
+ mytime = mytime + set_time(0, 1)
+
+ ncid = nc_open_file_readwrite(input_file(i))
+ call write_model_time(ncid, mytime)
+ call nc_close_file(ncid)
+
+ mytime = read_model_time(input_file(i))
+ call print_time(mytime,'read_model_time second')
+
+enddo
+
+
+call finalize_module()
+
+! end of main code
+
+
+contains
+
+!----------------------------------------------------------------------
+
+subroutine initialize_module
+
+call initialize_utilities('test_read_write_time')
+call register_module(source, revision, revdate)
+
+end subroutine initialize_module
+
+!----------------------------------------------------------------------
+
+subroutine finalize_module
+
+call finalize_utilities('test_read_write_time')
+
+end subroutine finalize_module
+
+!----------------------------------------------------------------------
+
+end program
+
+!
+! $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/developer_tests/io/test_read_write_time.f90 $
+! $Id: test_read_write_time.f90 13006 2019-03-06 23:28:13Z thoar@ucar.edu $
+! $Revision: 13006 $
+! $Date: 2019-03-06 16:28:13 -0700 (Wed, 06 Mar 2019) $
diff --git a/developer_tests/io/work/cf_test.cdl b/developer_tests/io/work/cf_test.cdl
index b1a06d3a5d..c9b3c71114 100644
--- a/developer_tests/io/work/cf_test.cdl
+++ b/developer_tests/io/work/cf_test.cdl
@@ -6,32 +6,34 @@ time = UNLIMITED ; //(1 currently)
variables:
int A(level);
-A:units = "units A";
-A:long_name = "variable A" ;
-A:short_name = "short A" ;
-A:missing_value = -77 ;
-A:_FillValue = -77 ;
+ A:units = "units A";
+ A:long_name = "variable A" ;
+ A:short_name = "short A" ;
+ A:missing_value = -77 ;
+ A:_FillValue = -77 ;
float B(level);
-B:units = "units B" ;
-B:long_name = "variable B" ;
-B:short_name = "short B" ;
-B:missing_value = -777.77 ;
-B:_FillValue = -777.77 ;
+ B:units = "units B" ;
+ B:long_name = "variable B" ;
+ B:short_name = "short B" ;
+ B:missing_value = -777.77 ;
+ B:_FillValue = -777.77 ;
double C(level);
-C:units = "units C" ;
-C:long_name = "variable C" ;
-C:short_name = "short C" ;
-C:missing_value = -88888.88888 ;
-C:_FillValue = -88888.88888 ;
-C:scale_factor = 0.2 ;
-C:add_offset = 2.0 ;
+ C:units = "units C" ;
+ C:long_name = "variable C" ;
+ C:short_name = "short C" ;
+ C:missing_value = -88888.88888 ;
+ C:_FillValue = -88888.88888 ;
double D(level);
+short E(level);
+ E:scale_factor = 0.2 ;
+ E:add_offset = 2.0 ;
+
float time(time);
-time:units = "hours" ;
+ time:units = "hours" ;
//global attributes:
@@ -42,5 +44,6 @@ A = 1, 2, 3, 4, 5 ;
B = 1.1, 2.2, 3.3, 4.4, 5.5 ;
C = -10.1, 20.2, 30.3, 40.4, 50.5 ;
D = -100.1, 200.2, 300.3, 400.4, 500.5 ;
+E = 1, 2, 3, 4, 5 ;
time = 1 ;
}
diff --git a/developer_tests/io/work/input.nml b/developer_tests/io/work/input.nml
index 5e7c2723a8..f13f5cdc40 100644
--- a/developer_tests/io/work/input.nml
+++ b/developer_tests/io/work/input.nml
@@ -49,23 +49,19 @@
&state_vector_io_nml
/
-&state_space_diag_nml
- stages_to_write = 'input','preassim','postassim','output'
- num_output_state_members = 100
- output_restarts = .true.
- output_mean = .true.
- output_sd = .true.
- output_inflation = .true.
-/
-
&test_state_structure_nml
debug = .true.
- /
+/
&test_read_write_restarts_nml
- restart_in_file_name = 'filter_ics'
- restart_out_file_name = 'filter_restart'
- direct_netcdf_read = .false.
- direct_netcdf_write = .false.
- /
+ input_file = 'cf_test.nc'
+ model_variables = 'A', 'QTY_STATE_VARIABLE',
+ 'B', 'QTY_U_WIND_COMPONENT',
+ 'C', 'QTY_V_WIND_COMPONENT',
+ 'D', 'QTY_SURFACE_PRESSURE'
+/
+
+&test_read_write_time_nml
+ input_file = 'time1.nc', 'time2.nc', 'time3.nc', 'time4.nc'
+/
diff --git a/developer_tests/io/work/mkmf_test_read_write_time b/developer_tests/io/work/mkmf_test_read_write_time
new file mode 100755
index 0000000000..ef5d7f34dc
--- /dev/null
+++ b/developer_tests/io/work/mkmf_test_read_write_time
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../build_templates/mkmf -p test_read_write_time -t ../../../build_templates/mkmf.template \
+ -a "../../.." path_names_test_read_write_time
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/developer_tests/io/work/path_names_test_cf_conventions b/developer_tests/io/work/path_names_test_cf_conventions
index 13b9f9d9e6..66ae4c193f 100644
--- a/developer_tests/io/work/path_names_test_cf_conventions
+++ b/developer_tests/io/work/path_names_test_cf_conventions
@@ -9,6 +9,7 @@ assimilation_code/modules/assimilation/filter_mod.f90
assimilation_code/modules/assimilation/obs_model_mod.f90
assimilation_code/modules/assimilation/quality_control_mod.f90
assimilation_code/modules/assimilation/reg_factor_mod.f90
+assimilation_code/modules/assimilation/sampling_error_correction_mod.f90
assimilation_code/modules/assimilation/smoother_mod.f90
assimilation_code/modules/io/dart_time_io_mod.f90
assimilation_code/modules/io/direct_netcdf_mod.f90
@@ -26,13 +27,14 @@ assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
assimilation_code/modules/utilities/null_win_mod.f90
assimilation_code/modules/utilities/obs_impact_mod.f90
assimilation_code/modules/utilities/options_mod.f90
+assimilation_code/modules/utilities/parse_args_mod.f90
assimilation_code/modules/utilities/random_seq_mod.f90
assimilation_code/modules/utilities/sort_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
developer_tests/io/test_cf_conventions.f90
-io/test/model_mod.f90
+models/template/model_mod.f90
models/utilities/default_model_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/developer_tests/io/work/path_names_test_diag_structure b/developer_tests/io/work/path_names_test_diag_structure
index 0282408040..d330d8f500 100644
--- a/developer_tests/io/work/path_names_test_diag_structure
+++ b/developer_tests/io/work/path_names_test_diag_structure
@@ -1,6 +1,7 @@
assimilation_code/modules/io/state_structure_mod.f90
assimilation_code/modules/observations/obs_kind_mod.f90
assimilation_code/modules/utilities/assert_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
assimilation_code/modules/utilities/sort_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
diff --git a/developer_tests/io/work/path_names_test_read_write_restarts b/developer_tests/io/work/path_names_test_read_write_restarts
index a6b20090a1..6ef7ba80af 100644
--- a/developer_tests/io/work/path_names_test_read_write_restarts
+++ b/developer_tests/io/work/path_names_test_read_write_restarts
@@ -9,6 +9,7 @@ assimilation_code/modules/assimilation/filter_mod.f90
assimilation_code/modules/assimilation/obs_model_mod.f90
assimilation_code/modules/assimilation/quality_control_mod.f90
assimilation_code/modules/assimilation/reg_factor_mod.f90
+assimilation_code/modules/assimilation/sampling_error_correction_mod.f90
assimilation_code/modules/assimilation/smoother_mod.f90
assimilation_code/modules/io/dart_time_io_mod.f90
assimilation_code/modules/io/direct_netcdf_mod.f90
@@ -25,13 +26,14 @@ assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
assimilation_code/modules/utilities/null_win_mod.f90
assimilation_code/modules/utilities/obs_impact_mod.f90
assimilation_code/modules/utilities/options_mod.f90
+assimilation_code/modules/utilities/parse_args_mod.f90
assimilation_code/modules/utilities/random_seq_mod.f90
assimilation_code/modules/utilities/sort_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
developer_tests/io/test_read_write_restarts.f90
-io/test/model_mod.f90
+models/template/model_mod.f90
models/utilities/default_model_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/ROMS/work/path_names_test_grid b/developer_tests/io/work/path_names_test_read_write_time
similarity index 93%
rename from models/ROMS/work/path_names_test_grid
rename to developer_tests/io/work/path_names_test_read_write_time
index d5a1c50ff7..e0403417c6 100644
--- a/models/ROMS/work/path_names_test_grid
+++ b/developer_tests/io/work/path_names_test_read_write_time
@@ -32,9 +32,9 @@ assimilation_code/modules/utilities/sort_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
-models/ROMS/model_mod.f90
-models/ROMS/test_grid.f90
-models/ROMS/test_roms_interpolate.f90
+developer_tests/io/test_read_write_time.f90
+models/template/model_mod.f90
models/utilities/default_model_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
+observations/obs_converters/utilities/obs_utilities_mod.f90
diff --git a/developer_tests/io/work/path_names_test_state_structure b/developer_tests/io/work/path_names_test_state_structure
index 17efc14d84..384671eaa4 100644
--- a/developer_tests/io/work/path_names_test_state_structure
+++ b/developer_tests/io/work/path_names_test_state_structure
@@ -1,6 +1,7 @@
assimilation_code/modules/io/state_structure_mod.f90
assimilation_code/modules/observations/obs_kind_mod.f90
assimilation_code/modules/utilities/assert_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
assimilation_code/modules/utilities/sort_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
diff --git a/developer_tests/io/work/quickbuild.csh b/developer_tests/io/work/quickbuild.csh
index e30e1fe090..644de7090b 100755
--- a/developer_tests/io/work/quickbuild.csh
+++ b/developer_tests/io/work/quickbuild.csh
@@ -9,111 +9,185 @@
# This script compiles all executables in this directory.
#----------------------------------------------------------------------
-# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
-# so this MUST be run first.
+# compile all programs in the current directory that have a mkmf_xxx file.
+#
+# usage: [ -mpi | -nompi ]
+#
+#
+# environment variable options:
+# before running this script, do:
+# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
+# and these files are required by most debuggers.
+#
+# to pass any flags to the 'make' program, set DART_MFLAGS in your environment.
+# e.g. to build faster by running 4 (or your choice) compiles at once:
+# "setenv DART_MFLAGS '-j 4' " (csh) or "export DART_MFLAGS='-j 4' " (bash)
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
-\rm -f ../../obs_def/obs_def_mod.f90
-\rm -f ../../obs_kind/obs_kind_mod.f90
+# this model name:
+set BUILDING = "io test"
+
+# programs which have the option of building with MPI:
+set MPI_TARGETS = "test_cf_conventions test_read_write_restarts"
+
+# set default (override with -mpi or -nompi):
+# 0 = build without MPI, 1 = build with MPI
+set with_mpi = 0
-set MODEL = "io test"
-@ n = 1
+# ---------------
+# shouldn't have to modify this script below here.
-echo
-echo
-echo "---------------------------------------------------------------"
-echo "${MODEL} build number ${n} is preprocess"
+if ( $#argv >= 1 ) then
+ if ( "$1" == "-mpi" ) then
+ set with_mpi = 1
+ else if ( "$1" == "-nompi" ) then
+ set with_mpi = 0
+ else
+ echo usage: $0 '[ -mpi | -nompi ]'
+ exit 0
+ endif
+endif
+
+set preprocess_done = 0
+set tdebug = 0
+set cdebug = 0
+set mflags = ''
+
+# environment vars this script looks for
+if ( $?CODE_DEBUG ) then
+ set cdebug = $CODE_DEBUG
+endif
+if ( $?DART_TEST ) then
+ set tdebug = $DART_TEST
+endif
+if ( $?DART_MFLAGS ) then
+ set mflags = "$DART_MFLAGS"
+endif
-csh mkmf_preprocess
-make || exit $n
-./preprocess || exit 99
+\rm -f *.o *.mod
+
+#----------------------------------------------------------------------
+# Build any NetCDF files from .cdl files
+#----------------------------------------------------------------------
+
+@ n = 0
+
+@ has_cdl = `ls *.cdl | wc -l` >& /dev/null
+
+if ( $has_cdl > 0 ) then
+ foreach DATAFILE ( *.cdl )
+
+ set OUTNAME = `basename $DATAFILE .cdl`.nc
+
+ if ( ! -f $OUTNAME ) then
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
+ ncgen -o $OUTNAME $DATAFILE || exit $n
+ endif
+
+ end
+endif
+
#----------------------------------------------------------------------
# Build all the single-threaded targets
#----------------------------------------------------------------------
-foreach TARGET ( mkmf_* )
-
- set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
-
- switch ( $TARGET )
- case mkmf_preprocess:
- breaksw
- default:
- @ n = $n + 1
- echo
- echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
- \rm -f ${PROG}
- csh $TARGET || exit $n
- make || exit $n
- breaksw
- endsw
+@ n = 0
+
+foreach TARGET ( mkmf_preprocess mkmf_* )
+
+ set PROG = `echo $TARGET | sed -e 's/mkmf_//'`
+
+ if ( $PROG == "preprocess" && $preprocess_done ) goto skip
+
+ if ( $with_mpi ) then
+ foreach i ( $MPI_TARGETS )
+ if ( $PROG == $i ) goto skip
+ end
+ endif
+
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "$BUILDING build number $n is $PROG"
+ \rm -f $PROG
+ csh $TARGET || exit $n
+ make $mflags || exit $n
+
+ if ( $tdebug ) then
+ echo 'removing all files between builds'
+ \rm -f *.o *.mod
+ endif
+
+ # preprocess creates module files that are required by
+ # the rest of the executables, so it must be run in addition
+ # to being built.
+ if ( $PROG == "preprocess" ) then
+ ./preprocess || exit $n
+ set preprocess_done = 1
+ endif
+
+skip:
end
-\rm -f *.o *.mod
+if ( $cdebug ) then
+ echo 'preserving .o and .mod files for debugging'
+else
+ \rm -f *.o *.mod Makefile .cppdefs
+endif
+
\rm -f input.nml*_default
-if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
+
+if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
-else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
- echo "Script is exiting without building the MPI version of the DART programs."
- exit 0
else
- echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Script is exiting after building the serial versions of the DART programs."
exit 0
endif
-#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
-# call this script with the -nompi argument, or if you are never going to
-# build with MPI, add an exit before the entire section above.
-#----------------------------------------------------------------------
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
-\rm -f filter wakeup_filter
+foreach PROG ( $MPI_TARGETS )
-@ n = $n + 1
-echo
-echo "---------------------------------------------------"
-echo "build number $n is mkmf_filter"
-csh mkmf_filter -mpi
-make
+ set TARGET = `echo $PROG | sed -e 's/^/mkmf_/'`
-if ($status != 0) then
- echo
- echo "If this died in mpi_utilities_mod, see code comment"
- echo "in mpi_utilities_mod.f90 starting with 'BUILD TIP' "
+ @ n = $n + 1
echo
- exit $n
-endif
+ echo "---------------------------------------------------"
+ echo "$BUILDING with MPI build number $n is $PROG"
+ \rm -f $PROG
+ csh $TARGET -mpi || exit $n
+ make $mflags || exit $n
+
+ if ( $tdebug ) then
+ echo 'removing all files between builds'
+ \rm -f *.o *.mod
+ endif
-@ n = $n + 1
-echo
-echo "---------------------------------------------------"
-echo "build number $n is mkmf_wakeup_filter"
-csh mkmf_wakeup_filter -mpi
-make || exit $n
+end
-\rm -f *.o *.mod
+if ( $cdebug ) then
+ echo 'preserving .o and .mod files for debugging'
+else
+ \rm -f *.o *.mod Makefile .cppdefs
+endif
\rm -f input.nml*_default
-echo
-echo 'time to run filter here:'
-echo ' for lsf run "bsub < runme_filter"'
-echo ' for pbs run "qsub runme_filter"'
-echo ' for lam-mpi run "lamboot" once, then "runme_filter"'
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/developer_tests/io/work/time1.cdl b/developer_tests/io/work/time1.cdl
new file mode 100644
index 0000000000..24bdfc9808
--- /dev/null
+++ b/developer_tests/io/work/time1.cdl
@@ -0,0 +1,24 @@
+netcdf time1 {
+
+dimensions:
+level = 3;
+lat = 4;
+lon = 5;
+
+variables:
+
+int A(level);
+A:units = "meters";
+
+float time;
+time:units = "days";
+
+//global attributes:
+
+:title = "time1";
+
+data:
+A = 1, 2, 3 ;
+time = 1.5 ;
+
+}
diff --git a/developer_tests/io/work/time2.cdl b/developer_tests/io/work/time2.cdl
new file mode 100644
index 0000000000..4b481073ca
--- /dev/null
+++ b/developer_tests/io/work/time2.cdl
@@ -0,0 +1,25 @@
+netcdf time2 {
+
+dimensions:
+level = 3;
+lat = 4;
+lon = 5;
+time = 1;
+
+variables:
+
+int A(level);
+A:units = "meters";
+
+float time(time);
+time:units = "days" ;
+
+//global attributes:
+
+:title = "time2" ;
+
+data:
+A = 1, 2, 3 ;
+time = 2.5 ;
+
+}
diff --git a/developer_tests/io/work/time3.cdl b/developer_tests/io/work/time3.cdl
new file mode 100644
index 0000000000..7d74b33fd2
--- /dev/null
+++ b/developer_tests/io/work/time3.cdl
@@ -0,0 +1,25 @@
+netcdf time3 {
+
+dimensions:
+level = 3;
+lat = 4;
+lon = 5;
+time = UNLIMITED;
+
+variables:
+
+int A(level);
+A:units = "meters";
+
+float time(time);
+time:units = "days";
+
+//global attributes:
+
+:title = "time3";
+
+data:
+A = 1, 2, 3 ;
+time = 1.5 ;
+
+}
diff --git a/developer_tests/io/work/time4.cdl b/developer_tests/io/work/time4.cdl
new file mode 100644
index 0000000000..33a45c23e8
--- /dev/null
+++ b/developer_tests/io/work/time4.cdl
@@ -0,0 +1,29 @@
+netcdf time2 {
+
+dimensions:
+level = 3;
+lat = 4;
+lon = 5;
+time = 1;
+copy = UNLIMITED;
+
+variables:
+
+int A(level);
+A:units = "meters";
+
+float time(time);
+time:units = "days" ;
+
+int copy(copy);
+
+//global attributes:
+
+:title = "time2" ;
+
+data:
+A = 1, 2, 3 ;
+time = 2.5 ;
+copy = 1,2,3;
+
+}
diff --git a/developer_tests/location/location_test.f90 b/developer_tests/location/location_test.f90
index 489eaf56d2..1b61ce7d37 100644
--- a/developer_tests/location/location_test.f90
+++ b/developer_tests/location/location_test.f90
@@ -23,7 +23,6 @@ program location_test
type(location_type) :: loc0(6), loc1, loc2, loc3, loc4, locA(7), locB(5)
integer :: iunit, iunit1, iunit2, i
-real(r8) :: loc2_val, lon, lat
character(len=102) :: testbuf
call initialize_utilities('location_test')
diff --git a/developer_tests/location/run_tests.csh b/developer_tests/location/run_tests.csh
new file mode 100755
index 0000000000..c788b9647d
--- /dev/null
+++ b/developer_tests/location/run_tests.csh
@@ -0,0 +1,97 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+# this script builds and runs the location test code for each of the
+# possible location modules.
+
+set LOGDIR = `pwd'/testing_logs
+mkdir -p $LOGDIR
+\rm -f $LOGDIR/*
+echo putting build and run logs in $LOGDIR
+
+echo
+echo
+echo "=================================================================="
+echo "Starting location module tests at "`date`
+echo "=================================================================="
+echo
+echo
+
+
+set LOCLIST = 'annulus channel column oned threed \
+ threed_cartesian threed_sphere \
+ twod twod_annulus twod_sphere'
+
+
+foreach i ( $LOCLIST )
+
+ echo
+ echo
+ echo "=================================================================="
+ echo "Starting tests of location module $i at "`date`
+ echo "=================================================================="
+ echo
+ echo
+
+ set FAILURE = 0
+
+ cd $i/test
+
+ ./mkmf_location_test
+ ( make > $LOGDIR/buildlog.$i.out ) || set FAILURE = 1
+
+ echo
+ echo
+ if ( $FAILURE ) then
+ echo "=================================================================="
+ echo "ERROR - unsuccessful build of location module $i at "`date`
+ echo "=================================================================="
+ echo
+ echo
+ else
+
+ ls -l location_test
+ ( ./location_test < test.in > $LOGDIR/runlog.$i.out ) || set FAILURE = 1
+
+ echo
+ echo
+ if ( $FAILURE ) then
+ echo "=================================================================="
+ echo "ERROR - unsuccessful run of location module $i tests at "`date`
+ echo "=================================================================="
+ else
+ echo "=================================================================="
+ echo "Tests of location module $i complete at "`date`
+ echo "=================================================================="
+ endif
+ echo
+ echo
+
+ \rm -f *.o *.mod input.nml*_default dart_log.* \
+ Makefile location_test_file* location_test
+
+ endif
+
+ cd ../..
+end
+
+echo
+echo
+echo "=================================================================="
+echo "End of location module tests at "`date`
+echo "=================================================================="
+echo
+echo
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/developer_tests/location/testall.csh b/developer_tests/location/testall.csh
deleted file mode 100755
index dfe75a4d8d..0000000000
--- a/developer_tests/location/testall.csh
+++ /dev/null
@@ -1,76 +0,0 @@
-#!/bin/csh
-#
-# 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
-#
-# DART $Id$
-
-# this script builds and runs the location test code for each of the
-# possible location modules.
-
-set LOCLIST = 'annulus channel column oned threed threed_cartesian threed_sphere twod twod_annulus twod_sphere'
-
-
-# clean up from before
-foreach i ( $LOCLIST )
- # do not cd so as to not accidently remove files in the
- # wrong place if the cd fails.
- rm -f $i/test/*.o \
- $i/test/*.mod \
- $i/test/input.nml*_default \
- $i/test/dart_log.* \
- $i/test/Makefile \
- $i/test/location_test_file* \
- $i/test/location_test
-end
-
-
-# and now build afresh and run tests
-foreach i ( $LOCLIST )
-
- echo
- echo
- echo "=================================================================="
- echo "=================================================================="
- echo "Starting tests of location module $i at "`date`
- echo "=================================================================="
- echo "=================================================================="
- echo
- echo
-
- set FAILURE = 0
-
- cd $i/test
-
- ./mkmf_location_test
- make || set FAILURE = 1
- ls -l location_test
- ./location_test < test.in || set FAILURE = 1
-
- cd ../..
-
- echo
- echo
- echo "=================================================================="
- echo "=================================================================="
- if ( $FAILURE ) then
- echo
- echo "ERROR - unsuccessful build of location module $i at "`date`
- echo
- else
- echo "Tests of location module $i complete at "`date`
- endif
- echo "=================================================================="
- echo "=================================================================="
- echo
- echo
-end
-
-exit 0
-
-#
-# $URL$
-# $Revision$
-# $Date$
-
diff --git a/developer_tests/mpi_utilities/tests/ftest_sendrecv.f90 b/developer_tests/mpi_utilities/tests/ftest_sendrecv.f90
index daab1926a0..813192db0b 100644
--- a/developer_tests/mpi_utilities/tests/ftest_sendrecv.f90
+++ b/developer_tests/mpi_utilities/tests/ftest_sendrecv.f90
@@ -1,5 +1,5 @@
-! 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
+! 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$
diff --git a/developer_tests/obs_sequence/obs_rwtest.f90 b/developer_tests/obs_sequence/obs_rwtest.f90
index 5935730190..df1e6e6332 100644
--- a/developer_tests/obs_sequence/obs_rwtest.f90
+++ b/developer_tests/obs_sequence/obs_rwtest.f90
@@ -1,5 +1,5 @@
-! 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
+! 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$
@@ -43,10 +43,10 @@ program obs_rwtest
implicit none
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
type(obs_sequence_type) :: seq_in
logical :: is_this_last
diff --git a/developer_tests/obs_sequence/work/input.nml b/developer_tests/obs_sequence/work/input.nml
index 3e2d9f4788..036af3f2d0 100644
--- a/developer_tests/obs_sequence/work/input.nml
+++ b/developer_tests/obs_sequence/work/input.nml
@@ -4,7 +4,7 @@
output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90',
input_obs_kind_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90',
output_obs_kind_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90',
- input_files = '../../../observations/forward_operators/obs_def_1d_state_mod.f90',
+ input_files = '../../../observations/forward_operators/obs_def_1d_state_mod.f90'
/
&assim_model_nml
@@ -18,28 +18,35 @@
&obs_sequence_nml
write_binary_obs_sequence = .false.
- read_binary_file_format = 'native'
+ read_binary_file_format = 'big_endian'
/
! alternatives for binary read:
-! read_binary_file_format = 'native'
-! read_binary_file_format = 'little_endian'
-! read_binary_file_format = 'big_endian'
+! read_binary_file_format = 'native'
+! read_binary_file_format = 'little_endian'
+! read_binary_file_format = 'big_endian'
&obs_rwtest_nml
- prompt_for_filenames = .true.
+ prompt_for_filenames = .false.
filename_in = '../data/obs_seq.binary.BE'
filename_out = 'obs_seq.xx'
print_only = .false.
calendar = 'no_calendar'
/
+&obs_sequence_tool_nml
+ filename_seq = '../data/obs_seq.ascii'
+ filename_out = 'obs_seq.xx'
+ obs_types = 'RAW_STATE_VARIABLE'
+ keep_types = .true.,
+ gregorian_cal = .false.
+/
&utilities_nml
TERMLEVEL = 1,
- logfilename = 'dart_log.out',
- nmlfilename = 'dart_log.nml',
- module_details = .false.,
- print_debug = .false.,
+ logfilename = 'dart_log.out'
+ nmlfilename = 'dart_log.nml'
+ module_details = .false.
+ print_debug = .false.
write_nml = 'file'
/
diff --git a/developer_tests/obs_sequence/work/quickbuild.csh b/developer_tests/obs_sequence/work/quickbuild.csh
index 36bb1a30e9..61a68e8b8c 100755
--- a/developer_tests/obs_sequence/work/quickbuild.csh
+++ b/developer_tests/obs_sequence/work/quickbuild.csh
@@ -10,12 +10,12 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +48,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,8 +56,8 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
-echo "Success: All DART programs compiled."
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
+echo "Success: All DART programs compiled."
exit 0
#
diff --git a/developer_tests/random_seq/test_exp.f90 b/developer_tests/random_seq/test_exp.f90
index 4de694f6be..869500cedc 100644
--- a/developer_tests/random_seq/test_exp.f90
+++ b/developer_tests/random_seq/test_exp.f90
@@ -91,7 +91,7 @@ program test_exp
write_this_one = (write_me .and. n <= write_limit)
if (write_this_one) then
- write(temp, "(A,F8.3,A,I10)"), "exp_", rate, "_", n
+ write(temp, "(A,F8.3,A,I10)") "exp_", rate, "_", n
call squeeze_out_blanks(temp, fname)
f = open_file(fname)
endif
diff --git a/developer_tests/random_seq/test_gamma.f90 b/developer_tests/random_seq/test_gamma.f90
index 2c4fd339aa..27a3544624 100644
--- a/developer_tests/random_seq/test_gamma.f90
+++ b/developer_tests/random_seq/test_gamma.f90
@@ -95,7 +95,7 @@ program test_gamma
write_this_one = (write_me .and. n <= write_limit)
if (write_this_one) then
- write(temp, "(A,F8.3,A,F8.3,A,I10)"), "gamma_", k, "_", h, "_", n
+ write(temp, "(A,F8.3,A,F8.3,A,I10)") "gamma_", k, "_", h, "_", n
call squeeze_out_blanks(temp, fname)
f = open_file(fname)
endif
diff --git a/developer_tests/random_seq/test_gaussian.f90 b/developer_tests/random_seq/test_gaussian.f90
index 3a7f0d08a1..84458bfb96 100644
--- a/developer_tests/random_seq/test_gaussian.f90
+++ b/developer_tests/random_seq/test_gaussian.f90
@@ -88,7 +88,7 @@ program test_gaussian
write_this_one = (write_me .and. n <= write_limit)
if (write_this_one) then
- write(temp, "(A,F8.3,A,F8.3,A,I10)"), "gauss_", mean, "_", sd, "_", n
+ write(temp, "(A,F8.3,A,F8.3,A,I10)") "gauss_", mean, "_", sd, "_", n
call squeeze_out_blanks(temp, fname)
f = open_file(fname)
endif
diff --git a/developer_tests/random_seq/test_inv_gamma.f90 b/developer_tests/random_seq/test_inv_gamma.f90
index d79fa07c37..d2f0c10504 100644
--- a/developer_tests/random_seq/test_inv_gamma.f90
+++ b/developer_tests/random_seq/test_inv_gamma.f90
@@ -95,7 +95,7 @@ program test_inv_gamma
write_this_one = (write_me .and. n <= write_limit)
if (write_this_one) then
- write(temp, "(A,F8.3,A,F8.3,A,I10)"), "invgamma_", a, "_", b, "_", n
+ write(temp, "(A,F8.3,A,F8.3,A,I10)") "invgamma_", a, "_", b, "_", n
call squeeze_out_blanks(temp, fname)
f = open_file(fname)
endif
diff --git a/developer_tests/random_seq/test_random.f90 b/developer_tests/random_seq/test_random.f90
index aadb2b8306..36abe4914b 100644
--- a/developer_tests/random_seq/test_random.f90
+++ b/developer_tests/random_seq/test_random.f90
@@ -74,7 +74,7 @@ program test_random
write_this_one = (write_me .and. n <= write_limit)
if (write_this_one) then
- write(temp, "(A,I10)"), "random_", n
+ write(temp, "(A,I10)") "random_", n
call squeeze_out_blanks(temp, fname)
f = open_file(fname)
endif
diff --git a/developer_tests/random_seq/test/input.nml b/developer_tests/random_seq/work/input.nml
similarity index 100%
rename from developer_tests/random_seq/test/input.nml
rename to developer_tests/random_seq/work/input.nml
diff --git a/developer_tests/random_seq/test/mkmf_test_corr b/developer_tests/random_seq/work/mkmf_test_corr
similarity index 100%
rename from developer_tests/random_seq/test/mkmf_test_corr
rename to developer_tests/random_seq/work/mkmf_test_corr
diff --git a/developer_tests/random_seq/test/mkmf_test_diff b/developer_tests/random_seq/work/mkmf_test_diff
similarity index 100%
rename from developer_tests/random_seq/test/mkmf_test_diff
rename to developer_tests/random_seq/work/mkmf_test_diff
diff --git a/developer_tests/random_seq/test/mkmf_test_exp b/developer_tests/random_seq/work/mkmf_test_exp
similarity index 100%
rename from developer_tests/random_seq/test/mkmf_test_exp
rename to developer_tests/random_seq/work/mkmf_test_exp
diff --git a/developer_tests/random_seq/test/mkmf_test_gamma b/developer_tests/random_seq/work/mkmf_test_gamma
similarity index 100%
rename from developer_tests/random_seq/test/mkmf_test_gamma
rename to developer_tests/random_seq/work/mkmf_test_gamma
diff --git a/developer_tests/random_seq/test/mkmf_test_gaussian b/developer_tests/random_seq/work/mkmf_test_gaussian
similarity index 100%
rename from developer_tests/random_seq/test/mkmf_test_gaussian
rename to developer_tests/random_seq/work/mkmf_test_gaussian
diff --git a/developer_tests/random_seq/test/mkmf_test_hist b/developer_tests/random_seq/work/mkmf_test_hist
similarity index 100%
rename from developer_tests/random_seq/test/mkmf_test_hist
rename to developer_tests/random_seq/work/mkmf_test_hist
diff --git a/developer_tests/random_seq/test/mkmf_test_inv_gamma b/developer_tests/random_seq/work/mkmf_test_inv_gamma
similarity index 100%
rename from developer_tests/random_seq/test/mkmf_test_inv_gamma
rename to developer_tests/random_seq/work/mkmf_test_inv_gamma
diff --git a/developer_tests/random_seq/test/mkmf_test_random b/developer_tests/random_seq/work/mkmf_test_random
similarity index 100%
rename from developer_tests/random_seq/test/mkmf_test_random
rename to developer_tests/random_seq/work/mkmf_test_random
diff --git a/developer_tests/random_seq/test/mkmf_test_reseed b/developer_tests/random_seq/work/mkmf_test_reseed
similarity index 100%
rename from developer_tests/random_seq/test/mkmf_test_reseed
rename to developer_tests/random_seq/work/mkmf_test_reseed
diff --git a/developer_tests/random_seq/test/path_names_test_corr b/developer_tests/random_seq/work/path_names_test_corr
similarity index 100%
rename from developer_tests/random_seq/test/path_names_test_corr
rename to developer_tests/random_seq/work/path_names_test_corr
diff --git a/developer_tests/random_seq/test/path_names_test_diff b/developer_tests/random_seq/work/path_names_test_diff
similarity index 100%
rename from developer_tests/random_seq/test/path_names_test_diff
rename to developer_tests/random_seq/work/path_names_test_diff
diff --git a/developer_tests/random_seq/test/path_names_test_exp b/developer_tests/random_seq/work/path_names_test_exp
similarity index 100%
rename from developer_tests/random_seq/test/path_names_test_exp
rename to developer_tests/random_seq/work/path_names_test_exp
diff --git a/developer_tests/random_seq/test/path_names_test_gamma b/developer_tests/random_seq/work/path_names_test_gamma
similarity index 100%
rename from developer_tests/random_seq/test/path_names_test_gamma
rename to developer_tests/random_seq/work/path_names_test_gamma
diff --git a/developer_tests/random_seq/test/path_names_test_gaussian b/developer_tests/random_seq/work/path_names_test_gaussian
similarity index 100%
rename from developer_tests/random_seq/test/path_names_test_gaussian
rename to developer_tests/random_seq/work/path_names_test_gaussian
diff --git a/developer_tests/random_seq/test/path_names_test_hist b/developer_tests/random_seq/work/path_names_test_hist
similarity index 100%
rename from developer_tests/random_seq/test/path_names_test_hist
rename to developer_tests/random_seq/work/path_names_test_hist
diff --git a/developer_tests/random_seq/test/path_names_test_inv_gamma b/developer_tests/random_seq/work/path_names_test_inv_gamma
similarity index 100%
rename from developer_tests/random_seq/test/path_names_test_inv_gamma
rename to developer_tests/random_seq/work/path_names_test_inv_gamma
diff --git a/developer_tests/random_seq/test/path_names_test_random b/developer_tests/random_seq/work/path_names_test_random
similarity index 100%
rename from developer_tests/random_seq/test/path_names_test_random
rename to developer_tests/random_seq/work/path_names_test_random
diff --git a/developer_tests/random_seq/test/path_names_test_reseed b/developer_tests/random_seq/work/path_names_test_reseed
similarity index 100%
rename from developer_tests/random_seq/test/path_names_test_reseed
rename to developer_tests/random_seq/work/path_names_test_reseed
diff --git a/developer_tests/random_seq/test/quickbuild.csh b/developer_tests/random_seq/work/quickbuild.csh
similarity index 83%
rename from developer_tests/random_seq/test/quickbuild.csh
rename to developer_tests/random_seq/work/quickbuild.csh
index e77d96c8d1..ef31058e06 100755
--- a/developer_tests/random_seq/test/quickbuild.csh
+++ b/developer_tests/random_seq/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -17,7 +17,7 @@ set ITEM = "Random Number Tests"
# ---------------
# shouldn't have to modify this script below here.
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
@ n = 0
@@ -28,16 +28,16 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$ITEM build number $n is $PROG"
+ echo "$ITEM build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
end
-echo "Success: All programs compiled."
+echo "Success: All programs compiled."
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml.*_default Makefile .cppdefs
exit 0
diff --git a/developer_tests/random_seq/test/rand.png b/developer_tests/random_seq/work/rand.png
similarity index 100%
rename from developer_tests/random_seq/test/rand.png
rename to developer_tests/random_seq/work/rand.png
diff --git a/developer_tests/random_seq/test/runall.sh b/developer_tests/random_seq/work/runall.sh
similarity index 100%
rename from developer_tests/random_seq/test/runall.sh
rename to developer_tests/random_seq/work/runall.sh
diff --git a/developer_tests/random_seq/test/see_exp_results.m b/developer_tests/random_seq/work/see_exp_results.m
similarity index 100%
rename from developer_tests/random_seq/test/see_exp_results.m
rename to developer_tests/random_seq/work/see_exp_results.m
diff --git a/developer_tests/random_seq/test/see_gamma_results.m b/developer_tests/random_seq/work/see_gamma_results.m
similarity index 100%
rename from developer_tests/random_seq/test/see_gamma_results.m
rename to developer_tests/random_seq/work/see_gamma_results.m
diff --git a/developer_tests/random_seq/test/see_inv_gamma_results.m b/developer_tests/random_seq/work/see_inv_gamma_results.m
similarity index 100%
rename from developer_tests/random_seq/test/see_inv_gamma_results.m
rename to developer_tests/random_seq/work/see_inv_gamma_results.m
diff --git a/developer_tests/random_seq/test/see_rand_results.m b/developer_tests/random_seq/work/see_rand_results.m
similarity index 100%
rename from developer_tests/random_seq/test/see_rand_results.m
rename to developer_tests/random_seq/work/see_rand_results.m
diff --git a/developer_tests/random_seq/test/see_seed_results.m b/developer_tests/random_seq/work/see_seed_results.m
similarity index 100%
rename from developer_tests/random_seq/test/see_seed_results.m
rename to developer_tests/random_seq/work/see_seed_results.m
diff --git a/developer_tests/run_tests.csh b/developer_tests/run_tests.csh
new file mode 100755
index 0000000000..1c2552a915
--- /dev/null
+++ b/developer_tests/run_tests.csh
@@ -0,0 +1,203 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+#
+# build and test all the models given in the list.
+#
+# usage: [ -mpi | -nompi ] [ -mpicmd name_of_mpi_launch_command ]
+#
+#----------------------------------------------------------------------
+
+set usingmpi=no
+set MPICMD=""
+
+if ( $#argv > 0 ) then
+ if ( "$argv[1]" == "-mpi" ) then
+ set usingmpi=yes
+ else if ( "$argv[1]" == "-nompi" ) then
+ set usingmpi=no
+ else
+ echo "Unrecognized argument to $0: $argv[1]"
+ echo "Usage: $0 [ -mpi | -nompi ] [ -mpicmd name_of_mpi_launch_command ]"
+ echo " default is to run tests without MPI"
+ exit -1
+ endif
+ shift
+endif
+
+if ( $#argv > 1 ) then
+ if ( "$argv[1]" == "-mpicmd" ) then
+ set MPICMD = "$argv[2]"
+ else
+ echo "Unrecognized argument to $0: $argv[1]"
+ echo "Usage: $0 [ -mpi | -nompi ] [ -mpicmd name_of_mpi_launch_command ]"
+ echo " default is to run tests without MPI"
+ exit -1
+ endif
+ shift
+endif
+
+# set the environment variable MPI to anything in order to enable the
+# MPI builds and tests. set the argument to the build scripts so it
+# knows which ones to build.
+if ( "$usingmpi" == "yes" ) then
+ echo "Building with MPI support."
+ set QUICKBUILD_ARG='-mpi'
+ if ( ! $?MPICMD) then
+ set MPICMD='mpirun -n 2'
+ endif
+else if ( "$usingmpi" == "no" ) then
+ echo "Building WITHOUT MPI support."
+ set QUICKBUILD_ARG='-nompi'
+ set MPICMD=""
+else
+ echo "Internal error: unrecognized value of usingmpi; should not happen"
+ exit -1
+endif
+
+# prevent shell warning messages about no files found when trying
+# to remove files using wildcards.
+set nonomatch
+
+set LOGDIR=`pwd`/testing_logs
+
+if ( ! $?REMOVE) then
+ setenv REMOVE 'rm -f'
+endif
+
+#----------------------------------------------------------------------
+
+if ( ! $?host) then
+ setenv host `uname -n`
+endif
+
+echo "Running DART developer tests on $host"
+
+#----------------------------------------------------------------------
+
+set TOPDIR = `pwd`
+
+# collect any directory that has a quickbuild.csh script
+
+set HAS_TESTS = `ls */work/quickbuild.csh`
+
+#----------------------------------------------------------------------
+# Compile and run all executables
+#----------------------------------------------------------------------
+
+${REMOVE} -r $LOGDIR
+mkdir -p $LOGDIR
+
+echo see $LOGDIR
+echo for build and run logs
+
+@ testnum = 0
+
+foreach TESTFILE ( $HAS_TESTS )
+
+ set TESTDIR = `dirname $TESTFILE`
+ set LOGNAME = `echo $TESTDIR | sed -e 's;/[^/]*$;;' -e 's;/;_;g'`
+
+ echo
+ echo
+ echo "=================================================================="
+ echo "Compiling tests in $TESTDIR starting at "`date`
+ echo "=================================================================="
+ echo
+ echo
+
+ cd ${TESTDIR}
+ set FAILURE = 0
+
+ ( ./quickbuild.csh ${QUICKBUILD_ARG} > ${LOGDIR}/buildlog.${LOGNAME}.out ) || set FAILURE = 1
+
+ @ testnum = $testnum + 1
+
+ echo
+ echo
+ if ( $FAILURE ) then
+ echo "=================================================================="
+ echo "ERROR - unsuccessful build in $TESTDIR at "`date`
+ echo "=================================================================="
+ cd $TOPDIR
+ continue
+ else
+ echo "=================================================================="
+ echo "Running tests in $TESTDIR starting at "`date`
+ echo "=================================================================="
+ echo
+ echo
+
+ foreach TARGET ( mkmf_* )
+
+
+ set FAILURE = 0
+ set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
+
+ echo Starting $PROG
+ ( ${MPICMD} ./$PROG > ${LOGDIR}/runlog.${LOGNAME}.${PROG}.out ) || set FAILURE = 1
+ if ( $FAILURE ) then
+ echo "ERROR - unsuccessful run of $PROG"
+ else
+ ${REMOVE} $PROG
+ echo "Successful run of $PROG"
+ endif
+
+ end
+
+ ${REMOVE} Makefile input.nml.*_default .cppdefs *.o *.mod
+
+ cd $TOPDIR
+
+ endif
+
+ echo
+ echo
+ echo "=================================================================="
+ echo "Done running tests in $TESTDIR at "`date`
+ echo "=================================================================="
+ echo
+ echo
+
+end
+
+#----------------------------------------------------------------------
+# Compile and run all location tests
+#----------------------------------------------------------------------
+
+# special for locations
+cd $TOPDIR/location
+
+echo "=================================================================="
+echo "Running location tests starting at "`date`
+echo "=================================================================="
+
+set FAILURE = 0
+
+( ./run_tests.csh > ${LOGDIR}/location_tests.out ) || set FAILURE = 1
+
+echo
+echo
+echo "=================================================================="
+echo "Done running location tests at "`date`
+echo "=================================================================="
+echo
+echo
+
+cd $TOPDIR
+
+
+echo
+echo $testnum developer tests run.
+echo
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/developer_tests/test_dart.csh b/developer_tests/test_dart.csh
index 395a6472a8..fcca0633af 100755
--- a/developer_tests/test_dart.csh
+++ b/developer_tests/test_dart.csh
@@ -5,101 +5,146 @@
# http://www.image.ucar.edu/DAReS/DART/DART_download
#
# DART $Id$
+#
+# test_dart.csh can be run from the command line or a batch system.
+# This compiles many of the programs (but not all) and
+# runs a limited number of tests.
+#
+#==========================================================================
+# SLURM directives sbatch test_dart.csh
+#
+# sinfo information about the whole slurm system
+# squeue information about running jobs
+# sbatch submitting a job
+# scancel killing a job
+#
+#SBATCH --ignore-pbs
+#SBATCH --job-name dart_test
+#SBATCH -t 2:00:00
+#SBATCH -A P86850054
+#SBATCH -p dav
+#SBATCH -o dart_test.log
+#SBATCH --mail-type=END
+#SBATCH --mail-type=FAIL
+#
+# for mpi tests:
+#SBATCH --ntasks=4
+#SBATCH --ntasks-per-node=4
+# for serial tests:
+#SB#### --ntasks=1
+#SB#### --ntasks-per-node=1
+#
+#==========================================================================
+# PBS directives qsub test_dart.csh
+#
+# qstat information about the running job
+# qdel killing a job
+# qsub submitting a job
+#
+#PBS -N dart_test
+#PBS -l walltime=02:00:00
+#PBS -A P86850054
+#PBS -j oe
+#PBS -m ae
+#
+# for mpi tests:
+#PBS -q regular
+#PBS -l select=1:ncpus=36:mpiprocs=36
+# for serial tests:
+#P## -q share
+#P## -l select=1:ncpus=1
+#==========================================================================
set clobber
-setenv MPIFLAG '-nompi'
+setenv MPIFLAG '-mpi'
if ( $#argv > 0 ) then
if ( "$argv[1]" == "-mpi" ) then
setenv MPIFLAG '-mpi'
else if ("$argv[1]" == "-nompi") then
setenv MPIFLAG '-nompi'
- else if ("$argv[1]" == "-default") then
- setenv MPIFLAG '-default'
else
echo "Unrecognized argument to $0: $argv[1]"
- echo "Usage: $0 [ -mpi | -nompi | -default ]"
- echo " default is to run tests without using MPI."
+ echo "Usage: $0 [ -mpi | -nompi ]"
+ echo " default is to run tests using MPI."
exit -1
endif
endif
-# cd to the start of the DART directory
-cd ..
-
-if ( ! -d models ) then
- echo "models does not exist. $0 must be run from the developer_tests"
- echo "directory -- please try again."
- exit 2
+# set any batch system specific items here
+if ($?SLURM_JOB_ID) then
+ # e.g. casper
+ setenv MPICMD "srun"
+else if ($?PBS_NODEFILE) then
+ # e.g. cheyenne
+ setenv MPICMD "mpiexec_mpt"
else
- set DARTHOME = `pwd`
+ # other (no queue system, e.g. openmpi on laptop)
+ setenv MPICMD "mpirun -n 2"
endif
-echo "The top-level DART directory (DARTHOME) is $DARTHOME"
+# if your system supports different options or needs to
+# use a different location for these commands, set them here.
+# they will be inherited by the other test scripts.
+setenv REMOVE 'rm -f'
+setenv RMDIR 'rmdir'
+setenv COPY 'cp -p'
+setenv MOVE 'mv -f'
+
+# require we start running this from the developer_tests dir
+if ( ! -d ../models ) then
+ echo "../models directory does not exist. $0 must be run from"
+ echo "the developer_tests directory."
+ exit 2
+endif
-#----------------------------------------------------------------------
-# See if some necessary environment variables are set.
-# We'd like to have a short hostname but uname can be configured very
-# differently from host to host.
-#----------------------------------------------------------------------
+# cd to the top level DART directory and
+# record where we are running this script
+cd ..
+set DARTHOME = `pwd`
if ( ! $?host) then
setenv host `uname -n`
endif
+echo "Running $0 on $host"
+echo "The top-level DART directory is $DARTHOME"
+
#----------------------------------------------------------------------
-# Not all unix systems support the same subset of flags; try to figure
-# out what system we are running on and adjust accordingly.
#----------------------------------------------------------------------
-set OSTYPE = `uname -s`
-switch ( ${OSTYPE} )
- case IRIX64:
- setenv REMOVE 'rm -rf'
- setenv COPY 'cp -p'
- setenv MOVE 'mv -f'
- breaksw
- case AIX:
- setenv REMOVE 'rm -rf'
- setenv COPY 'cp -p'
- setenv MOVE 'mv -f'
- breaksw
- default:
- setenv REMOVE 'rm -rf'
- setenv COPY 'cp -vp'
- setenv MOVE 'mv -fv'
- breaksw
-endsw
+# setup complete
+#----------------------------------------------------------------------
+#----------------------------------------------------------------------
#----------------------------------------------------------------------
-echo "Running DART test on $host"
+echo
+echo
+echo "=================================================================="
+echo "DART tests begin at "`date`
+echo "=================================================================="
+echo
+echo
-#----------------------------------------------------------------------
-# Compile 'filter' for a wide range of models.
#----------------------------------------------------------------------
echo
echo
echo "=================================================================="
-echo "=================================================================="
echo "Building and testing supported models starting at "`date`
echo "=================================================================="
-echo "=================================================================="
echo
echo
cd ${DARTHOME}/models
-if ( 1 == 1 ) then
- ./buildall.csh $MPIFLAG
-endif
+
+./run_tests.csh $MPIFLAG -mpicmd "$MPICMD"
echo
echo
echo "=================================================================="
-echo "=================================================================="
-echo "Model testing complete at "`date`
-echo "=================================================================="
+echo "Supported model tests complete at "`date`
echo "=================================================================="
echo
echo
@@ -109,9 +154,7 @@ echo
echo
echo
echo "=================================================================="
-echo "=================================================================="
-echo "Testing observation converters starting at "`date`
-echo "=================================================================="
+echo "Building and testing observation converters starting at "`date`
echo "=================================================================="
echo
echo
@@ -121,16 +164,13 @@ echo "not have all the necessary supporting libraries. So errors here"
echo "are not fatal."
cd ${DARTHOME}/observations/obs_converters
-if ( 1 == 1 ) then
- ./buildall.csh
-endif
+
+./run_tests.csh
echo
echo
echo "=================================================================="
-echo "=================================================================="
-echo "Observation converter testing complete at "`date`
-echo "=================================================================="
+echo "Observation converter tests complete at "`date`
echo "=================================================================="
echo
echo
@@ -140,24 +180,19 @@ echo
echo
echo
echo "=================================================================="
-echo "=================================================================="
-echo "Building and testing supported programs starting at "`date`
-echo "=================================================================="
+echo "Building and testing support programs starting at "`date`
echo "=================================================================="
echo
echo
cd ${DARTHOME}/assimilation_code/programs
-if ( 1 == 1 ) then
- ./buildall.csh $MPIFLAG
-endif
+
+./run_tests.csh $MPIFLAG -mpicmd "$MPICMD"
echo
echo
echo "=================================================================="
-echo "=================================================================="
-echo "Program testing complete at "`date`
-echo "=================================================================="
+echo "Support program tests complete at "`date`
echo "=================================================================="
echo
echo
@@ -167,51 +202,34 @@ echo
echo
echo
echo "=================================================================="
-echo "=================================================================="
-echo "Testing location modules starting at "`date`
-echo "=================================================================="
+echo "Building and running developer tests starting at "`date`
echo "=================================================================="
echo
echo
-cd ${DARTHOME}/developer_tests/location
-if ( 1 == 1 ) then
- ./testall.csh
-endif
+cd ${DARTHOME}/developer_tests
+
+./run_tests.csh $MPIFLAG -mpicmd "$MPICMD"
echo
echo
echo "=================================================================="
+echo "Developer tests complete at "`date`
echo "=================================================================="
-echo "Location module testing complete at "`date`
-echo "=================================================================="
-echo "=================================================================="
-echo
echo
-
-echo "SKIPPING Testing single-threaded lorenz_96 (L96) at "`date`
-#echo "Testing single-threaded lorenz_96 (L96) at "`date`
-echo "=================================================================="
echo
-exit 0
-
-echo "=================================================================="
-
-if ! ( $?MPI ) then
-
- echo "MPI tests not enabled ... stopping."
-
-else
- echo "No MPI tests yet ... stopping."
+#----------------------------------------------------------------------
- #echo "=================================================================="
- #echo "testing MPI complete at "`date`
- #echo "=================================================================="
- #echo
-endif
+echo
+echo
+echo "=================================================================="
+echo "DART tests complete at "`date`
+echo "=================================================================="
+echo
+echo
exit 0
diff --git a/developer_tests/utilities/error_handler_test.f90 b/developer_tests/utilities/error_handler_test.f90
index 64f1f6a7ae..49aa4bd6c5 100644
--- a/developer_tests/utilities/error_handler_test.f90
+++ b/developer_tests/utilities/error_handler_test.f90
@@ -35,8 +35,11 @@ program error_handler_test
! main code here
+!----------------------------------------------------------------------
+
! initialize the dart libs
-call initialize_module()
+call initialize_mpi_utilities('error_handler_test')
+call register_module(source, revision, revdate)
! Read the namelist entry
call find_namelist_in_file("input.nml", "error_handler_test_nml", iunit)
@@ -66,18 +69,6 @@ program error_handler_test
! end of main code
-contains
-
-!----------------------------------------------------------------------
-
-subroutine initialize_module
-
- call initialize_mpi_utilities('error_handler_test')
- call register_module(source, revision, revdate)
- module_initialized = .true.
-
-end subroutine initialize_module
-
!----------------------------------------------------------------------
end program
diff --git a/developer_tests/utilities/file_utils_test.f90 b/developer_tests/utilities/file_utils_test.f90
new file mode 100644
index 0000000000..efe35723da
--- /dev/null
+++ b/developer_tests/utilities/file_utils_test.f90
@@ -0,0 +1,81 @@
+! 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: file_utils_test.f90 11289 2017-03-10 21:56:06Z hendric@ucar.edu $
+
+program file_utils_test
+
+use types_mod, only : r8
+use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, E_ALLMSG, &
+ find_namelist_in_file, check_namelist_read, &
+ do_nml_file, do_nml_term, nmlfileunit
+use mpi_utilities_mod, only : initialize_mpi_utilities, finalize_mpi_utilities, &
+ task_sync, my_task_id
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=256), parameter :: source = &
+ "$URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/developer_tests/utilities/file_utils_test.f90 $"
+character(len=32 ), parameter :: revision = "$Revision: 11289 $"
+character(len=128), parameter :: revdate = "$Date: 2017-03-10 14:56:06 -0700 (Fri, 10 Mar 2017) $"
+
+logical, save :: module_initialized = .false.
+
+character(len=128) :: msgstring
+integer :: iunit, io
+character(len=8) :: task_id
+integer :: test1
+logical :: test2
+real(r8) :: test3
+
+! namelist items we are going to create/overwrite
+namelist /file_utils_test_nml/ test1, test2, test3
+
+! main code here
+
+
+!----------------------------------------------------------------------
+! mkdir test; cd test; then:
+! touch dart_log.out; chmod 0 dart_log.out
+! chmod 0 input.nml
+! rm input.nml (no nml file)
+! rm input.nml; touch input.nml (0 length nml file)
+! rm input.nml; echo &bob > input.nml (no trailing / )
+! rm input.nml; echo &utilities_nml > input.nml (no trailing / )
+! rm input.nml; echo &file_utils_test_nml > input.nml
+! echo / > input.nml (no &utilities_nml )
+! and run this test
+!----------------------------------------------------------------------
+
+! initialize the dart libs
+call initialize_mpi_utilities('file_utils_test')
+call register_module(source, revision, revdate)
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "file_utils_test_nml", iunit)
+read(iunit, nml = file_utils_test_nml, iostat = io)
+call check_namelist_read(iunit, io, "file_utils_test_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=file_utils_test_nml)
+if (do_nml_term()) write( * , nml=file_utils_test_nml)
+
+write(task_id, '(i5)' ) my_task_id()
+
+! finalize file_utils_test
+call error_handler(E_MSG,'file_utils_test','Finished successfully.',source,revision,revdate)
+call finalize_mpi_utilities()
+
+! end of main code
+
+!----------------------------------------------------------------------
+
+end program
+
+!
+! $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/developer_tests/utilities/file_utils_test.f90 $
+! $Id: file_utils_test.f90 11289 2017-03-10 21:56:06Z hendric@ucar.edu $
+! $Revision: 11289 $
+! $Date: 2017-03-10 14:56:06 -0700 (Fri, 10 Mar 2017) $
diff --git a/developer_tests/utilities/find_enclosing_indices_test.f90 b/developer_tests/utilities/find_enclosing_indices_test.f90
new file mode 100644
index 0000000000..17bc9b86f3
--- /dev/null
+++ b/developer_tests/utilities/find_enclosing_indices_test.f90
@@ -0,0 +1,293 @@
+! 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: model_mod.f90 12563 2018-04-26 21:34:00Z nancy@ucar.edu $
+
+! test of the find_enclosing_indices() routine in the utilities module.
+
+program find_enclosing_indicies_test
+
+use types_mod, only : r8
+use utilities_mod, only : error_handler, find_enclosing_indices, E_MSG, E_ERR
+use sort_mod, only : sort, index_sort
+use random_seq_mod, only: random_seq_type, init_random_seq, random_gaussian
+
+integer, parameter :: MYSIZE = 25
+integer, parameter :: NSAMPLES = 4
+type(random_seq_type) :: seq
+
+real(r8), parameter :: BASEVAL = 25.0_r8
+real(r8), parameter :: STDDEV = 5.0_r8
+
+real(r8) :: array1(MYSIZE), array2(MYSIZE)
+real(r8) :: sorted1(MYSIZE), sorted2(MYSIZE)
+integer :: indirect1(MYSIZE), indirect2(MYSIZE)
+
+integer :: i, lower_i, upper_i, istat, j
+real(r8) :: fract, thisval, thesevals(MYSIZE), tmp
+character(len=512) :: string1
+
+character(len=*), parameter :: routine = 'find_enclosing_indicies_test'
+
+! fill the array with random values and do an initial sanity check
+! with none of the special options enabled.
+
+call init_random_seq(seq)
+
+do i=1, MYSIZE
+ array1(i) = random_gaussian(seq, BASEVAL, STDDEV)
+enddo
+
+do i=1, NSAMPLES
+ thesevals(i) = random_gaussian(seq, BASEVAL, STDDEV * 0.9_r8)
+enddo
+
+sorted1 = sort(array1)
+call index_sort(array1, indirect1, MYSIZE)
+
+! inverted order arrays
+do i=1, MYSIZE
+ array2(i) = array1(MYSIZE - i + 1)
+enddo
+
+do i=1, MYSIZE
+ sorted2(i) = sorted1(MYSIZE - i + 1)
+enddo
+
+do i=1, MYSIZE
+ indirect2(i) = indirect1(MYSIZE - i + 1)
+enddo
+
+
+
+! print generated case data
+
+do i=1, MYSIZE
+ write(*, '(A32,2(I4,F8.3))') "original, sorted data, indirect, ", i, sorted1(i), indirect1(i), array1(i)
+enddo
+write(*,*)""
+
+do i=1, MYSIZE
+ write(*, '(A32,I4,2F8.3)') "inverted, sorted data, ", i, array2(i), sorted2(i)
+enddo
+write(*,*)""
+
+do i=1, NSAMPLES
+ write(*, '(A32,I4,F8.3)') "sampled data, item ", i, thesevals(i)
+enddo
+write(*,*)""
+write(*,*)""
+
+
+! real start of tests
+
+write(*,*)"direct tests"
+
+! test edge cases
+thisval = sorted1(1)
+write(string1, *) "lowest value"
+call find_enclosing_indices(MYSIZE, sorted1, thisval, lower_i, upper_i, fract, istat)
+call print_results(thisval, sorted1, lower_i, upper_i, fract, istat, string1)
+
+thisval = sorted1(MYSIZE)
+write(string1, *) "highest value"
+call find_enclosing_indices(MYSIZE, sorted1, thisval, lower_i, upper_i, fract, istat)
+call print_results(thisval, sorted1, lower_i, upper_i, fract, istat, string1)
+
+! test outsize range
+thisval = sorted1(1) - 1.0_r8
+write(string1, *) "below lowest value"
+call find_enclosing_indices(MYSIZE, sorted1, thisval, lower_i, upper_i, fract, istat)
+call print_results(thisval, sorted1, lower_i, upper_i, fract, istat, string1)
+
+thisval = sorted1(MYSIZE) + 1.0_r8
+write(string1, *) "above highest value"
+call find_enclosing_indices(MYSIZE, sorted1, thisval, lower_i, upper_i, fract, istat)
+call print_results(thisval, sorted1, lower_i, upper_i, fract, istat, string1)
+
+! basic case
+do i=1, NSAMPLES
+ write(string1, '(A6,I4)') "item", i
+ call find_enclosing_indices(MYSIZE, sorted1, thesevals(i), lower_i, upper_i, fract, istat)
+ call print_results(thesevals(i), sorted1, lower_i, upper_i, fract, istat, string1)
+enddo
+
+write(*,*)""
+write(*,*)"indirect tests"
+
+! test indirect addressing
+
+! test edge cases
+thisval = sorted1(1)
+write(string1, *) "lowest value"
+call find_enclosing_indices(MYSIZE, array1, thisval, lower_i, upper_i, fract, istat, &
+ indirect_indices = indirect1)
+call print_results(thisval, array1, lower_i, upper_i, fract, istat, string1)
+
+thisval = sorted1(MYSIZE)
+write(string1, *) "highest value"
+call find_enclosing_indices(MYSIZE, array1, thisval, lower_i, upper_i, fract, istat, &
+ indirect_indices = indirect1)
+call print_results(thisval, array1, lower_i, upper_i, fract, istat, string1)
+
+! test outsize range
+thisval = sorted1(1) - 1.0_r8
+write(string1, *) "below lowest value"
+call find_enclosing_indices(MYSIZE, array1, thisval, lower_i, upper_i, fract, istat, &
+ indirect_indices = indirect1)
+call print_results(thisval, array1, lower_i, upper_i, fract, istat, string1)
+
+thisval = sorted1(MYSIZE) + 1.0_r8
+write(string1, *) "above highest value"
+call find_enclosing_indices(MYSIZE, array1, thisval, lower_i, upper_i, fract, istat, &
+ indirect_indices = indirect1)
+call print_results(thisval, array1, lower_i, upper_i, fract, istat, string1)
+
+! basic case
+do i=1, NSAMPLES
+ write(string1, '(A6,I4)') "item", i
+ call find_enclosing_indices(MYSIZE, array1, thesevals(i), lower_i, upper_i, fract, istat, &
+ indirect_indices = indirect1)
+ call print_results(thesevals(i), array1, lower_i, upper_i, fract, istat, string1)
+enddo
+
+write(*,*)""
+write(*,*)"inverted tests"
+
+! test inverted arrays
+
+! test edge cases
+thisval = sorted1(1)
+write(string1, *) "lowest value"
+call find_enclosing_indices(MYSIZE, sorted2, thisval, lower_i, upper_i, fract, istat, &
+ inverted = .true.)
+call print_results(thisval, sorted2, lower_i, upper_i, fract, istat, string1)
+
+thisval = sorted1(MYSIZE)
+write(string1, *) "highest value"
+call find_enclosing_indices(MYSIZE, sorted2, thisval, lower_i, upper_i, fract, istat, &
+ inverted = .true.)
+call print_results(thisval, sorted2, lower_i, upper_i, fract, istat, string1)
+
+! test outsize range
+thisval = sorted1(1) - 1.0_r8
+write(string1, *) "below lowest value"
+call find_enclosing_indices(MYSIZE, sorted2, thisval, lower_i, upper_i, fract, istat, &
+ inverted = .true.)
+call print_results(thisval, sorted2, lower_i, upper_i, fract, istat, string1)
+
+thisval = sorted1(MYSIZE) + 1.0_r8
+write(string1, *) "above highest value"
+call find_enclosing_indices(MYSIZE, sorted2, thisval, lower_i, upper_i, fract, istat, &
+ inverted = .true.)
+call print_results(thisval, sorted2, lower_i, upper_i, fract, istat, string1)
+
+! basic case
+do i=1, NSAMPLES
+ write(string1, '(A6,I4)') "item", i
+ call find_enclosing_indices(MYSIZE, sorted2, thesevals(i), lower_i, upper_i, fract, istat, inverted=.true.)
+ call print_results(thesevals(i), sorted2, lower_i, upper_i, fract, istat, string1)
+enddo
+
+write(*,*)""
+write(*,*)"inverted indirect tests"
+
+! inverted, indirect arrays - should all fail.
+
+! test edge cases
+thisval = sorted1(1)
+write(string1, *) "inv lowest value"
+call find_enclosing_indices(MYSIZE, array2, thisval, lower_i, upper_i, fract, istat, inverted=.true., &
+ indirect_indices = indirect1)
+call print_results(thisval, array2, lower_i, upper_i, fract, istat, string1)
+
+thisval = sorted1(MYSIZE)
+write(string1, *) "inv highest value"
+call find_enclosing_indices(MYSIZE, array2, thisval, lower_i, upper_i, fract, istat, inverted=.true., &
+ indirect_indices = indirect1)
+call print_results(thisval, array2, lower_i, upper_i, fract, istat, string1)
+
+! test outsize range
+thisval = sorted1(1) - 1.0_r8
+write(string1, *) "inv below lowest value"
+call find_enclosing_indices(MYSIZE, array2, thisval, lower_i, upper_i, fract, istat, inverted=.true., &
+ indirect_indices = indirect1)
+call print_results(thisval, array2, lower_i, upper_i, fract, istat, string1)
+
+thisval = sorted1(MYSIZE) + 1.0_r8
+write(string1, *) "inv above highest value"
+call find_enclosing_indices(MYSIZE, array2, thisval, lower_i, upper_i, fract, istat, inverted=.true., &
+ indirect_indices = indirect1)
+call print_results(thisval, array2, lower_i, upper_i, fract, istat, string1)
+
+! 1 test indirect addressing
+
+write(string1, '(A6,I4)') "item", 1
+call find_enclosing_indices(MYSIZE, array2, thesevals(1), lower_i, upper_i, fract, istat, &
+ indirect_indices = indirect2, inverted=.true.)
+call print_results(thesevals(1), array2, lower_i, upper_i, fract, istat, string1)
+
+write(*,*)""
+write(*,*)"invalid input tests"
+
+! single array item
+write(string1, '(A6,I4)') "single item array"
+call find_enclosing_indices(1, sorted1(1:1), thesevals(1), lower_i, upper_i, fract, istat)
+call print_results(thesevals(1), sorted1, lower_i, upper_i, fract, istat, string1)
+
+! inverted and indirect
+write(string1, '(A6,I4)') "inverted and indirect"
+call find_enclosing_indices(1, sorted1(1:1), thesevals(1), lower_i, upper_i, fract, istat, &
+ inverted=.true., indirect_indices = indirect1)
+call print_results(thesevals(1), sorted1, lower_i, upper_i, fract, istat, string1)
+
+! inverted (badly sorted) input array
+write(string1, '(A6,I4)') "non-monotonic array"
+call find_enclosing_indices(MYSIZE, array1, array1(MYSIZE/2), lower_i, upper_i, fract, istat)
+call print_results(array1(MYSIZE/2), array1, lower_i, upper_i, fract, istat, string1)
+
+! almost sorted input array
+write(string1, '(A6,I4)') "mostly sorted array"
+j = MYSIZE/3
+tmp = sorted1(j)
+sorted1(j) = sorted1(j*2)
+sorted1(j*2) = tmp
+call find_enclosing_indices(MYSIZE, sorted1, array1(MYSIZE/2), lower_i, upper_i, fract, istat)
+call print_results(array1(MYSIZE/2), sorted1, lower_i, upper_i, fract, istat, string1)
+
+write(*,*) 'end of test'
+
+contains
+
+subroutine print_results(thisval, thisarray, lower_i, upper_i, fract, istat, label)
+ real(r8), intent(in) :: thisval
+ real(r8), intent(in) :: thisarray(:)
+ integer, intent(in) :: lower_i, upper_i
+ real(r8), intent(in) :: fract
+ integer, intent(in) :: istat
+ character(len=*), intent(in) :: label
+
+real(r8) :: computed_val1, computed_val2
+
+write(*,'(A32,F8.3,A10,I4)') trim(label), thisval, ' status = ', istat
+
+if (istat /= 0) then
+ write(*,*) ''
+ return
+endif
+
+computed_val1 = thisarray(lower_i) + (thisarray(upper_i) - thisarray(lower_i))*fract
+computed_val2 = thisarray(lower_i) + (thisarray(upper_i) - thisarray(lower_i))*(1.0 - fract)
+write(*, '(A32,2I4,F8.3)') " lower, upper, fract = ", lower_i, upper_i, fract
+write(*, '(A32,4F8.3)') " low, cval1, up = ", thisarray(lower_i), computed_val1, thisarray(upper_i)
+!write(*, '(A32,4F8.3)') " low, cval1, cval2, up = ", thisarray(lower_i), computed_val1, computed_val2, thisarray(upper_i)
+
+if (computed_val1 /= thisval) write(*, *) "warning! mismatched values: ", thisval, computed_val1
+
+write(*,*) ''
+
+end subroutine print_results
+
+end program find_enclosing_indicies_test
+
diff --git a/developer_tests/utilities/find_first_occurrence_test.f90 b/developer_tests/utilities/find_first_occurrence_test.f90
new file mode 100644
index 0000000000..9e6ae6e1f8
--- /dev/null
+++ b/developer_tests/utilities/find_first_occurrence_test.f90
@@ -0,0 +1,324 @@
+! 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: model_mod.f90 12563 2018-04-26 21:34:00Z nancy@ucar.edu $
+
+! test of the find_first_occurrence() routine in the utilities module.
+
+program find_first_occurrence_test
+
+use types_mod, only : r8
+use utilities_mod, only : error_handler, find_first_occurrence, E_MSG, E_ERR
+use sort_mod, only : sort, index_sort
+use random_seq_mod, only: random_seq_type, init_random_seq, random_gaussian
+
+! make both of these values larger for a real test.
+! maybe 50 or 100 for array, 10 or 20 for the samples?
+integer, parameter :: MYSIZE = 12
+integer, parameter :: NSAMPLES = 2
+
+real(r8), parameter :: BASEVAL = 25.0_r8
+real(r8), parameter :: STDDEV = 5.0_r8
+type(random_seq_type) :: seq
+
+real(r8) :: array1(MYSIZE), array2(MYSIZE)
+real(r8) :: sorted1(MYSIZE), sorted2(MYSIZE)
+integer :: indirect1(MYSIZE)
+
+integer :: seed = 10
+integer :: i, this_i, ind_this, istat, j
+real(r8) :: thisval, thesevals(MYSIZE), tmp
+character(len=512) :: string1
+
+character(len=*), parameter :: routine = 'find_first_occurrence_test'
+
+! calling sequence for routine being tested:
+!
+!subroutine find_first_occurrence(nitems, data_array, value_to_find, &
+! the_index, my_status, inverted, &
+! indirect_indicies, the_indirect_index)
+!
+! should return the largest index number that is less or
+! equal to the test value. last two arguments are optional.
+
+! calling sequence for closely related routine:
+!
+!subroutine find_enclosing_indices(nitems, data_array, value_to_find, &
+! smaller_index, larger_index, fraction_across, my_status, &
+! inverted, log_scale, indirect_indices)
+!
+! should return the smaller index, larger index, and fraction across.
+! last three arguments are optional.
+
+
+
+! fill the array with random values and do an initial sanity check
+! with none of the special options enabled.
+
+call init_random_seq(seq, seed)
+
+do i=1, MYSIZE
+ array1(i) = random_gaussian(seq, BASEVAL, STDDEV)
+enddo
+
+! comment this in to add replicated values to the input array
+!array1(4) = array1(5)
+
+do i=1, NSAMPLES
+ thesevals(i) = random_gaussian(seq, BASEVAL, STDDEV*0.9_r8)
+enddo
+
+sorted1 = sort(array1)
+call index_sort(array1, indirect1, MYSIZE)
+
+! inverted order arrays - cannot do both inverted and indirect!
+do i=1, MYSIZE
+ array2(i) = array1(MYSIZE - i + 1)
+enddo
+
+do i=1, MYSIZE
+ sorted2(i) = sorted1(MYSIZE - i + 1)
+enddo
+
+
+! print generated case data
+
+do i=1, MYSIZE
+ write(*, '(A50,2(I4,F8.3))') "item, sort, indirect, val: ", i, sorted1(i), indirect1(i), array1(i)
+enddo
+write(*,*)""
+
+do i=1, MYSIZE
+ write(*, '(A50,1(I4,F8.3))') "item, inverted val: ", i, sorted2(i)
+enddo
+write(*,*)""
+
+do i=1, NSAMPLES
+ write(*, '(A50,I4,F8.3)') "test value, data: ", i, thesevals(i)
+enddo
+write(*,*)""
+write(*,*)""
+
+
+! real start of tests
+
+write(*,*)"direct tests"
+
+! test edge cases
+thisval = sorted1(1)
+write(string1, *) "lowest value"
+call find_first_occurrence(MYSIZE, sorted1, thisval, this_i, istat)
+call print_results(thisval, sorted1, this_i, istat, string1)
+
+thisval = sorted1(MYSIZE)
+write(string1, *) "highest value"
+call find_first_occurrence(MYSIZE, sorted1, thisval, this_i, istat)
+call print_results(thisval, sorted1, this_i, istat, string1)
+
+! test outside range
+thisval = sorted1(1) - 1.0_r8
+write(string1, *) "below lowest value"
+call find_first_occurrence(MYSIZE, sorted1, thisval, this_i, istat)
+call print_results(thisval, sorted1, this_i, istat, string1)
+
+thisval = sorted1(MYSIZE) + 1.0_r8
+write(string1, *) "above highest value"
+call find_first_occurrence(MYSIZE, sorted1, thisval, this_i, istat)
+call print_results(thisval, sorted1, this_i, istat, string1)
+
+! tests for equals
+do i=1, MYSIZE
+ thisval = sorted1(i)
+ write(string1, '(A22,I4,F8.3)') "equal, val: ", i, thisval
+ call find_first_occurrence(MYSIZE, sorted1, thisval, this_i, istat)
+ call print_results(thisval, sorted1, this_i, istat, string1)
+enddo
+
+! tests for non-equals
+do i=1, NSAMPLES
+ write(string1, '(A22,I4,F8.3)') "noneq, val: ", i, thesevals(i)
+ call find_first_occurrence(MYSIZE, sorted1, thesevals(i), this_i, istat)
+ call print_results(thesevals(i), sorted1, this_i, istat, string1)
+enddo
+
+write(*,*)""
+write(*,*)"indirect tests"
+
+! test indirect addressing
+
+! test edge cases
+thisval = sorted1(1)
+write(string1, *) "lowest value"
+call find_first_occurrence(MYSIZE, array1, thisval, this_i, istat, &
+ indirect_indices = indirect1, the_indirect_index = ind_this)
+call print_results(thisval, array1, this_i, istat, string1, indirect1, indirect_this = ind_this)
+
+thisval = sorted1(MYSIZE)
+write(string1, *) "highest value"
+call find_first_occurrence(MYSIZE, array1, thisval, this_i, istat, &
+ indirect_indices = indirect1, the_indirect_index = ind_this)
+call print_results(thisval, array1, this_i, istat, string1, indirect1, indirect_this = ind_this)
+
+! test outside range
+thisval = sorted1(1) - 1.0_r8
+write(string1, *) "below lowest value"
+call find_first_occurrence(MYSIZE, array1, thisval, this_i, istat, &
+ indirect_indices = indirect1, the_indirect_index = ind_this)
+call print_results(thisval, array1, this_i, istat, string1, indirect1, indirect_this = ind_this)
+
+thisval = sorted1(MYSIZE) + 1.0_r8
+write(string1, *) "above highest value"
+call find_first_occurrence(MYSIZE, array1, thisval, this_i, istat, &
+ indirect_indices = indirect1, the_indirect_index = ind_this)
+call print_results(thisval, array1, this_i, istat, string1, indirect1, indirect_this = ind_this)
+
+! tests for equals
+do i=1, MYSIZE
+ thisval = sorted1(i)
+ write(string1, '(A22,I4,F8.3)') "equal, val: ", i, thisval
+ call find_first_occurrence(MYSIZE, array1, thisval, this_i, istat, &
+ indirect_indices = indirect1, the_indirect_index = ind_this)
+ call print_results(thisval, array1, this_i, istat, string1, indirect1, indirect_this = ind_this)
+enddo
+
+! tests for non-equals
+do i=1, NSAMPLES
+ write(string1, '(A22,I4,F8.3)') "noneq, val: ", i, thesevals(i)
+ call find_first_occurrence(MYSIZE, array1, thesevals(i), this_i, istat, &
+ indirect_indices = indirect1, the_indirect_index = ind_this)
+ call print_results(thesevals(i), array1, this_i, istat, string1, indirect1, indirect_this = ind_this)
+enddo
+
+write(*,*)""
+write(*,*)"inverted tests"
+
+! test inverted arrays
+
+! test edge cases
+thisval = sorted1(1)
+write(string1, *) "lowest value"
+call find_first_occurrence(MYSIZE, sorted2, thisval, this_i, istat, &
+ inverted = .true.)
+call print_results(thisval, sorted2, this_i, istat, string1, inverted=.true.)
+
+thisval = sorted1(MYSIZE)
+write(string1, *) "highest value"
+call find_first_occurrence(MYSIZE, sorted2, thisval, this_i, istat, &
+ inverted = .true.)
+call print_results(thisval, sorted2, this_i, istat, string1, inverted=.true.)
+
+! test outside range
+thisval = sorted1(1) - 1.0_r8
+write(string1, *) "below lowest value"
+call find_first_occurrence(MYSIZE, sorted2, thisval, this_i, istat, &
+ inverted = .true.)
+call print_results(thisval, sorted2, this_i, istat, string1, inverted=.true.)
+
+thisval = sorted1(MYSIZE) + 1.0_r8
+write(string1, *) "above highest value"
+call find_first_occurrence(MYSIZE, sorted2, thisval, this_i, istat, &
+ inverted = .true.)
+call print_results(thisval, sorted2, this_i, istat, string1, inverted=.true.)
+
+! tests for equals
+do i=1, MYSIZE
+ thisval = sorted1(i)
+ write(string1, '(A22,I4,F8.3)') "equal, val: ", i, thisval
+ call find_first_occurrence(MYSIZE, sorted2, thisval, this_i, istat, &
+ inverted = .true.)
+ call print_results(thisval, sorted2, this_i, istat, string1, inverted=.true.)
+enddo
+
+! tests for non-equals
+do i=1, NSAMPLES
+ write(string1, '(A22,I4,F8.3)') "noneq, val: ", i, thesevals(i)
+ call find_first_occurrence(MYSIZE, sorted2, thesevals(i), this_i, istat, inverted=.true.)
+ call print_results(thesevals(i), sorted2, this_i, istat, string1, inverted=.true.)
+enddo
+
+write(*,*)""
+write(*,*)"invalid input tests"
+
+! empty array
+write(string1, '(A6,I4)') "single item array"
+call find_first_occurrence(0, sorted1(1:1), thesevals(1), this_i, istat)
+call print_results(thesevals(1), sorted1, this_i, istat, string1)
+
+! indirect and inverted
+write(string1, '(A6,I4)') "indirect and inverted"
+call find_first_occurrence(MYSIZE, sorted1, thesevals(1), this_i, istat, &
+ inverted=.true., indirect_indices=indirect1)
+call print_results(thesevals(1), sorted1, this_i, istat, string1)
+
+! indirect_this without indirect array
+write(string1, '(A6,I4)') "indirect this w/o array"
+call find_first_occurrence(MYSIZE, array1, thisval, this_i, istat, &
+ the_indirect_index = ind_this)
+call print_results(thisval, array1, this_i, istat, string1, indirect1, indirect_this = ind_this)
+call print_results(thesevals(1), array1, this_i, istat, string1)
+
+! inverted (badly sorted) input array
+write(string1, '(A6,I4)') "non-monotonic array"
+call find_first_occurrence(MYSIZE, array1, array1(MYSIZE/2), this_i, istat)
+call print_results(array1(MYSIZE/2), array1, this_i, istat, string1)
+
+! almost sorted input array
+write(string1, '(A6,I4)') "mostly sorted array"
+j = MYSIZE/3
+tmp = sorted1(j)
+sorted1(j) = sorted1(j*2)
+sorted1(j*2) = tmp
+call find_first_occurrence(MYSIZE, sorted1, sorted1(MYSIZE/2), this_i, istat)
+call print_results(sorted1(MYSIZE/2), sorted1, this_i, istat, string1)
+
+
+write(*,*) 'end of test'
+
+contains
+
+subroutine print_results(thisval, thisarray, this_i, istat, label, indirect_a, inverted, indirect_this)
+ real(r8), intent(in) :: thisval
+ real(r8), intent(in) :: thisarray(:)
+ integer, intent(in) :: this_i
+ integer, intent(in) :: istat
+ character(len=*), intent(in) :: label
+ integer, intent(in), optional :: indirect_a(:)
+ logical, intent(in), optional :: inverted
+ integer, intent(in), optional :: indirect_this
+
+integer :: this, next
+
+if (istat /= 0) then
+ write(*, '(A56,2I8)') trim(label) // ' index, status = ', this_i, istat
+ return
+endif
+
+write(*,'(A56,F8.3,I4,2F8.3)') trim(label) // ' val, indx, arrval = ', &
+ thisval, this_i, thisarray(this_i)
+
+! indirect_a has to be present if indirect_this is specified.
+if (present(indirect_this)) then
+ if (.not. present(indirect_a)) then
+ print *, 'bad call to print_results: indirect_this specified but not indirect_a'
+ stop
+ endif
+ this = indirect_a(indirect_this)
+ next = indirect_a(min(indirect_this + 1, size(thisarray)))
+else if (present(inverted)) then
+ this = this_i
+ next = max(this_i - 1, 1)
+else
+ this = this_i
+ next = min(this_i + 1, size(thisarray))
+endif
+
+if (thisval < thisarray(this) .or. thisval > thisarray(next)) then
+ write(*,'(A,3F8.3)') 'unexpected error - val not between the two values, ', &
+ thisval, thisarray(this), thisarray(next)
+endif
+
+end subroutine print_results
+
+end program find_first_occurrence_test
+
diff --git a/developer_tests/utilities/nml_test.f90 b/developer_tests/utilities/nml_test.f90
index 39321e58b8..ad0ea63db0 100644
--- a/developer_tests/utilities/nml_test.f90
+++ b/developer_tests/utilities/nml_test.f90
@@ -8,7 +8,7 @@ program nml_test
use types_mod, only : r8
use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
- open_file, close_file, nc_check, get_next_filename, &
+ open_file, close_file, &
find_namelist_in_file, check_namelist_read, &
do_nml_file, do_nml_term, nmlfileunit, &
initialize_utilities, finalize_utilities
diff --git a/developer_tests/utilities/work/crosstest b/developer_tests/utilities/work/crosstest
index fa0c785760..6140889c54 100644
--- a/developer_tests/utilities/work/crosstest
+++ b/developer_tests/utilities/work/crosstest
@@ -12,7 +12,7 @@ GROUP sam
END GROUP
GROUP fred # comment on keywordline
- ALLKINDS EXCEPT QTY_TEMPERATURE QTY_SPECIFIC_HUMIDITY
+ ALLQTYS EXCEPT QTY_TEMPERATURE QTY_SPECIFIC_HUMIDITY
END GROUP
#
@@ -49,7 +49,7 @@ IMPACT
QTY_TEMPERATURE fred 0.9
george QTY_SPECIFIC_HUMIDITY 0.8
# AIRCRAFT_TEMPERATURE george 0.3 # cannot have groups with types on right
- RADIOSONDE_TEMPERATURE QTY_DEWPOINT 0.2
+# RADIOSONDE_TEMPERATURE QTY_DEWPOINT 0.2 # cannot reset to diff value
LAND_SFC_ALTIMETER QTY_TEMPERATURE 0.2
# LAND_SFC_ALTIMETER QTY_TEMPERATURE -0.2 # dup setting
# LAND_SFC_ALTIMETER QTY_PRESSURE -0.2 # requires namelist change to accept
diff --git a/developer_tests/utilities/work/input.nml b/developer_tests/utilities/work/input.nml
index ae1c5a3d05..bec15f8e0b 100644
--- a/developer_tests/utilities/work/input.nml
+++ b/developer_tests/utilities/work/input.nml
@@ -46,3 +46,6 @@
&obs_kind_nml
/
+&file_utils_test_nml
+ /
+
diff --git a/developer_tests/utilities/work/mkmf_file_utils_test b/developer_tests/utilities/work/mkmf_file_utils_test
new file mode 100755
index 0000000000..37f45e1ac0
--- /dev/null
+++ b/developer_tests/utilities/work/mkmf_file_utils_test
@@ -0,0 +1,66 @@
+#!/bin/csh
+#
+# 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: mkmf_file_utils_test 11289 2017-03-10 21:56:06Z hendric@ucar.edu $
+
+#
+# usage: mkmf_file_utils_test [ -mpi | -nompi ]
+#
+# without any args, builds file_utils_test without mpi libraries, and it will run
+# as a normal executable. if -mpi is given, it will be compiled with the mpi
+# libraries and can run with multiple cooperating processes.
+
+if ( $#argv > 0 ) then
+ if ("$argv[1]" == "-mpi") then
+ setenv usingmpi 1
+ else if ("$argv[1]" == "-nompi") then
+ setenv usingmpi 0
+ else
+ echo "Unrecognized argument to mkmf_file_utils_test: $argv[1]"
+ echo "Usage: mkmf_file_utils_test [ -mpi | -nompi ]"
+ echo " default is to generate a Makefile without MPI support."
+ exit -1
+ endif
+else
+ setenv usingmpi 0
+endif
+
+
+# make a backup copy of the path_names file, and then use
+# sed to make sure it includes either the non-mpi subroutines,
+# or the subroutines which really call mpi.
+cp -f path_names_file_utils_test path_names_file_utils_test.back
+
+if ( $usingmpi ) then
+
+ echo "Making Makefile with MPI"
+ touch using_mpi_for_file_utils_test
+ sed -e 's;/null_mpi_util;/mpi_util;' path_names_file_utils_test.back >! path_names_file_utils_test
+
+ setenv wrapper_arg -w
+
+else
+
+ echo "Making Makefile without MPI"
+ rm -f using_mpi_for_file_utils_test
+ sed -e 's;/mpi_util;/null_mpi_util;' path_names_file_utils_test.back >! path_names_file_utils_test
+ setenv wrapper_arg ""
+
+endif
+
+# remove temp file and now really call mkmf to generate makefile
+rm -f path_names_file_utils_test.back
+
+../../../build_templates/mkmf -p file_utils_test -t ../../../build_templates/mkmf.template \
+ -a "../../.." ${wrapper_arg} path_names_file_utils_test
+
+exit $status
+
+#
+# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/developer_tests/utilities/work/mkmf_file_utils_test $
+# $Revision: 11289 $
+# $Date: 2017-03-10 14:56:06 -0700 (Fri, 10 Mar 2017) $
+
diff --git a/developer_tests/utilities/work/mkmf_find_enclosing_indices_test b/developer_tests/utilities/work/mkmf_find_enclosing_indices_test
new file mode 100755
index 0000000000..9df470e5dd
--- /dev/null
+++ b/developer_tests/utilities/work/mkmf_find_enclosing_indices_test
@@ -0,0 +1,16 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id: mkmf_find_enclosing_indices_test 11289 2017-03-10 21:56:06Z hendric@ucar.edu $
+
+../../../build_templates/mkmf -p find_enclosing_indices_test -t ../../../build_templates/mkmf.template \
+ -a "../../.." path_names_find_enclosing_indices_test
+
+#
+# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/developer_tests/utilities/work/mkmf_find_enclosing_indicies_test $
+# $Revision: 11289 $
+# $Date: 2017-03-10 14:56:06 -0700 (Fri, 10 Mar 2017) $
+
diff --git a/developer_tests/utilities/work/mkmf_find_first_occurrence_test b/developer_tests/utilities/work/mkmf_find_first_occurrence_test
new file mode 100755
index 0000000000..c495f73a1a
--- /dev/null
+++ b/developer_tests/utilities/work/mkmf_find_first_occurrence_test
@@ -0,0 +1,16 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id: mkmf_find_first_occurrence_test 11289 2017-03-10 21:56:06Z hendric@ucar.edu $
+
+../../../build_templates/mkmf -p find_first_occurrence_test -t ../../../build_templates/mkmf.template \
+ -a "../../.." path_names_find_first_occurrence_test
+
+#
+# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/developer_tests/utilities/work/mkmf_find_first_occurrence_test $
+# $Revision: 11289 $
+# $Date: 2017-03-10 14:56:06 -0700 (Fri, 10 Mar 2017) $
+
diff --git a/developer_tests/utilities/work/path_names_file_utils_test b/developer_tests/utilities/work/path_names_file_utils_test
new file mode 100644
index 0000000000..336f3a0d6f
--- /dev/null
+++ b/developer_tests/utilities/work/path_names_file_utils_test
@@ -0,0 +1,5 @@
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+developer_tests/utilities/file_utils_test.f90
diff --git a/developer_tests/utilities/work/path_names_find_enclosing_indices_test b/developer_tests/utilities/work/path_names_find_enclosing_indices_test
new file mode 100644
index 0000000000..aee04a7f7b
--- /dev/null
+++ b/developer_tests/utilities/work/path_names_find_enclosing_indices_test
@@ -0,0 +1,7 @@
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+developer_tests/utilities/find_enclosing_indices_test.f90
diff --git a/developer_tests/utilities/work/path_names_find_first_occurrence_test b/developer_tests/utilities/work/path_names_find_first_occurrence_test
new file mode 100644
index 0000000000..49b1245bfb
--- /dev/null
+++ b/developer_tests/utilities/work/path_names_find_first_occurrence_test
@@ -0,0 +1,7 @@
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+developer_tests/utilities/find_first_occurrence_test.f90
diff --git a/developer_tests/utilities/work/quickbuild.csh b/developer_tests/utilities/work/quickbuild.csh
index 4badaa8fb4..6109b1fc7f 100755
--- a/developer_tests/utilities/work/quickbuild.csh
+++ b/developer_tests/utilities/work/quickbuild.csh
@@ -10,8 +10,8 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
@@ -48,7 +48,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,30 +56,30 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
\rm -f input.nml*_default
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
exit 0
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach TARGET ( mkmf_* )
@@ -91,7 +91,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -101,7 +101,7 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
\rm -f input.nml*_default
exit 0
diff --git a/developer_tests/utilities/work/test_utils.sh b/developer_tests/utilities/work/test_utils.sh
new file mode 100755
index 0000000000..d691ed772d
--- /dev/null
+++ b/developer_tests/utilities/work/test_utils.sh
@@ -0,0 +1,84 @@
+#!/bin/sh
+
+let test=1
+
+while true; do
+
+ rm -fr testdir
+ mkdir testdir
+ cd testdir
+ ln -s ../file_utils_test .
+
+ case $test in
+ 1 ) ;;
+
+ 2 ) touch dart_log.out
+ chmod 0 dart_log.out
+ ;;
+
+ 3 ) touch input.nml
+ ;;
+
+ 4 ) cp ../input.nml .
+ chmod 0 input.nml
+ ;;
+
+ 5 ) echo \&bob > input.nml
+ ;;
+
+ 6 ) echo \&utilities_nml > input.nml
+ ;;
+
+ 7 ) echo \&utilities_nml > input.nml
+ echo / >> input.nml
+ ;;
+
+ 8 ) echo \&utilities_nml > input.nml
+ echo / >> input.nml
+ echo \&file_utils_test_nml >> input.nml
+ echo / >> input.nml
+ ;;
+
+ 9 ) echo \&utilities_nml > input.nml
+ echo \&file_utils_test_nml >> input.nml
+ echo / >> input.nml
+ ;;
+
+ 10 ) echo \&utilities_nml > input.nml
+ echo / >> input.nml
+ echo \&file_utils_test_nml >> input.nml
+ ;;
+
+ * ) exit
+ ;;
+ esac
+
+cat input.nml
+ echo test $test
+ ./file_utils_test
+
+ let test=test+1
+
+ cd ..
+
+done
+
+# only when this is working, clean up
+#rmdir -fr testdir
+
+echo done
+exit 0
+
+
+#----------------------------------------------------------------------
+# mkdir test; cd test; then:
+# touch dart_log.out; chmod 0 dart_log.out
+# chmod 0 input.nml
+# rm input.nml (no nml file)
+# rm input.nml; touch input.nml (0 length nml file)
+# rm input.nml; echo &bob > input.nml (no trailing / )
+# rm input.nml; echo &utilities_nml > input.nml (no trailing / )
+# rm input.nml; echo &file_utils_test_nml > input.nml
+# echo / > input.nml (no &utilities_nml )
+# and run this test
+#----------------------------------------------------------------------
diff --git a/diagnostics/matlab/plot_bias_xxx_profile.m b/diagnostics/matlab/plot_bias_xxx_profile.m
index 42f5032119..73ac4fbca8 100644
--- a/diagnostics/matlab/plot_bias_xxx_profile.m
+++ b/diagnostics/matlab/plot_bias_xxx_profile.m
@@ -3,8 +3,8 @@
% Part of the observation-space diagnostics routines.
%
% 'obs_diag' produces a netcdf file containing the diagnostics.
-% obs_diag condenses the obs_seq.final information into summaries for a few specified
-% regions - on a level-by-level basis.
+% 'obs_diag' condenses the obs_seq.final information into summaries for a few
+% specified regions - on a level-by-level basis.
%
% The number of observations possible reflects only those observations
% that have incoming QC values of interest. Any observation with a DART
@@ -19,7 +19,7 @@
% For TRUSTED observations, this is different than the number used to calculate
% bias, rmse, spread, etc.
%
-% USAGE: plotdat = plot_bias_xxx_profile(fname, copy);
+% USAGE: plotdat = plot_bias_xxx_profile(fname, copy [,varargin]);
%
% fname : netcdf file produced by 'obs_diag'
%
@@ -27,10 +27,23 @@
% Possible values are available in the netcdf 'CopyMetaData' variable.
% (ncdump -v CopyMetaData obs_diag_output.nc)
%
-% obsname : Optional. If present, The strings of each observation type to plot.
+% varargin: optional parameter-value pairs. Supported parameters are described below.
+%
+% obsname : The strings of each observation type to plot.
% Each observation type will be plotted in a separate graphic.
% Default is to plot all available observation types.
%
+%
+% range : 'range' of the value being plotted. Default is to
+% automatically determine range based on the data values.
+%
+% verbose : true/false to control amount of run-time output
+%
+% MarkerSize : integer controlling the size of the symbols
+%
+% pause : true/false to conrol pausing after each figure is created.
+% true will require hitting any key to continue to next plot
+%
% OUTPUT: 'plotdat' is a structure containing what was plotted.
% A .pdf of each graphic is created. Each .pdf has a name that
% reflects the variable, quantity, and region being plotted.
@@ -58,29 +71,46 @@
% Decode,Parse,Check the input
%---------------------------------------------------------------------
-default_obsname = 'none';
+default_obsname = 'none';
+default_verbosity = true;
+default_markersize = 12;
+default_pause = false;
+default_range = [NaN NaN];
p = inputParser;
addRequired(p,'fname',@ischar);
addRequired(p,'copy',@ischar);
if (exist('inputParser/addParameter','file') == 2)
- addParameter(p,'obsname',default_obsname,@ischar);
+ addParameter(p,'obsname', default_obsname, @ischar);
+ addParameter(p,'verbose', default_verbosity, @islogical);
+ addParameter(p,'MarkerSize', default_markersize, @isnumeric);
+ addParameter(p,'pause', default_pause, @islogical);
+ addParameter(p,'range', default_range, @isnumeric);
else
- addParamValue(p,'obsname',default_obsname,@ischar);
+ addParamValue(p,'obsname', default_obsname, @ischar); %#ok
+ addParamValue(p,'verbose', default_verbosity, @islogical); %#ok
+ addParamValue(p,'MarkerSize',default_markersize, @isnumeric); %#ok
+ addParamValue(p,'pause', default_pause, @islogical); %#ok
+ addParamValue(p,'range', default_range, @isnumeric); %#ok
end
-
p.parse(fname, copy, varargin{:});
-% if you want to echo the input
-% disp(['fname : ', p.Results.fname])
-% disp(['copy : ', p.Results.copy])
-% disp(['obsname : ', p.Results.obsname])
-
if ~isempty(fieldnames(p.Unmatched))
disp('Extra inputs:')
disp(p.Unmatched)
end
+if (numel(p.Results.range) ~= 2)
+ error('range must be an array of length two ... [bottom top]')
+end
+
+if strcmp(p.Results.obsname,'none')
+ nvars = 0;
+else
+ obsname = p.Results.obsname;
+ nvars = 1;
+end
+
if (exist(fname,'file') ~= 2)
error('file/fname <%s> does not exist',fname)
end
@@ -89,80 +119,30 @@
% Harvest plotting info/metadata from netcdf file.
%---------------------------------------------------------------------
-plotdat.fname = fname;
-plotdat.copystring = copy;
-
-plotdat.binseparation = nc_read_att(fname, '/', 'bin_separation');
-plotdat.binwidth = nc_read_att(fname, '/', 'bin_width');
-time_to_skip = nc_read_att(fname, '/', 'time_to_skip');
-plotdat.lonlim1 = nc_read_att(fname, '/', 'lonlim1');
-plotdat.lonlim2 = nc_read_att(fname, '/', 'lonlim2');
-plotdat.latlim1 = nc_read_att(fname, '/', 'latlim1');
-plotdat.latlim2 = nc_read_att(fname, '/', 'latlim2');
-plotdat.biasconv = nc_read_att(fname, '/', 'bias_convention');
-
-plotdat.mlevel = local_ncread(fname, 'mlevel');
-plotdat.plevel = local_ncread(fname, 'plevel');
-plotdat.plevel_edges = local_ncread(fname, 'plevel_edges');
-plotdat.hlevel = local_ncread(fname, 'hlevel');
-plotdat.hlevel_edges = local_ncread(fname, 'hlevel_edges');
-plotdat.bincenters = ncread(fname, 'time');
-plotdat.binedges = ncread(fname, 'time_bounds');
-plotdat.region_names = strtrim(ncread(fname, 'region_names')');
-[plotdat.nregions,~] = nc_dim_info(fname,'region');
-
-% Coordinate between time types and dates
-
-timeunits = nc_read_att(fname,'time','units');
-timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
-timeorigin = datenum(timebase(1),timebase(2),timebase(3));
-timefloats = zeros(size(time_to_skip)); % stupid int32 type conversion
-timefloats(:) = time_to_skip(:);
-skip_seconds = timefloats(4)*3600 + timefloats(5)*60 + timefloats(6);
-iskip = timefloats(3) + skip_seconds/86400.0;
-
-% Set up a structure to use for plotting
-
-plotdat.bincenters = plotdat.bincenters + timeorigin;
-plotdat.binedges = plotdat.binedges + timeorigin;
-plotdat.Nbins = length(plotdat.bincenters);
-plotdat.toff = plotdat.binedges(1) + iskip;
-plotdat.timespan = sprintf('%s through %s', datestr(plotdat.toff), ...
- datestr(max(plotdat.binedges(:))));
-plotdat.xlabel = sprintf('bias (%s) and %s',plotdat.biasconv,copy);
-
-[plotdat.allvarnames, plotdat.allvardims] = get_varsNdims(fname);
-[plotdat.varnames, plotdat.vardims] = FindVerticalVars(plotdat);
-
-plotdat.nvars = length(plotdat.varnames);
-plotdat.copyindex = get_copy_index(fname,copy);
-plotdat.biasindex = get_copy_index(fname,'bias');
-plotdat.Npossindex = get_copy_index(fname,'Nposs');
-plotdat.Nusedindex = get_copy_index(fname,'Nused');
-plotdat.NQC4index = get_copy_index(fname,'N_DARTqc_4');
-plotdat.NQC5index = get_copy_index(fname,'N_DARTqc_5');
-plotdat.NQC6index = get_copy_index(fname,'N_DARTqc_6');
-plotdat.NQC7index = get_copy_index(fname,'N_DARTqc_7');
-plotdat.NQC8index = get_copy_index(fname,'N_DARTqc_8');
-
-figuredata = setfigure();
-
-%%---------------------------------------------------------------------
-% Loop around (copy-level-region) observation types
-%----------------------------------------------------------------------
+plotdat = read_obsdiag_staticdata(fname,copy);
+plotdat.xlabel = sprintf('bias (%s) and %s',plotdat.biasconv,copy);
% Either use all the variables or just the one optionally specified.
-
-if strcmp(p.Results.obsname,'none')
- varlist = 1:plotdat.nvars;
+if (nvars == 0)
+ [plotdat.allvarnames, plotdat.allvardims] = get_varsNdims(fname);
+ [plotdat.varnames, plotdat.vardims] = FindVerticalVars(plotdat);
+ plotdat.nvars = length(plotdat.varnames);
else
- varlist = find (strcmpi(p.Results.obsname,plotdat.varnames));
- if isempty(varlist)
- error('%s is not in the list of observations',p.Results.obsname)
- end
+ plotdat.varnames{1} = obsname;
+ plotdat.nvars = nvars;
end
-for ivar = varlist
+global figuredata verbose
+
+figuredata = set_obsdiag_figure('tall');
+figuredata.MarkerSize = p.Results.MarkerSize;
+verbose = p.Results.verbose;
+
+%%---------------------------------------------------------------------
+% Loop around (copy-level-region) observation types
+%----------------------------------------------------------------------
+
+for ivar = 1:plotdat.nvars
% create the variable names of interest.
@@ -191,195 +171,223 @@
continue
end
- [level_org, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname, plotdat.guessvar);
- plotdat.level_org = level_org;
+ [levels, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname, plotdat.guessvar);
+ plotdat.levels = levels;
plotdat.level_units = level_units;
plotdat.nlevels = nlevels;
plotdat.level_edges = level_edges;
plotdat.Yrange = Yrange;
- % Matlab likes strictly ASCENDING order for things to be plotted,
- % then you can impose the direction. The data is stored in the original
- % order, so the sort indices are saved to reorder the data.
+ % Matlab likes strictly ASCENDING order for the axes and ticks,
+ % then you can impose the direction.
- if (plotdat.level_org(1) > plotdat.level_org(plotdat.nlevels))
+ if (plotdat.levels(1) > plotdat.levels(plotdat.nlevels))
plotdat.YDir = 'reverse';
else
plotdat.YDir = 'normal';
end
- % Add error-checking for output from older versions of obs_diag.
+ [levels, ~] = sort(plotdat.levels);
+ plotdat.YTick = unique(levels);
- [levels, indices] = sort(plotdat.level_org);
- plotdat.level = unique(levels);
- if (length(plotdat.level) ~= length(levels))
+ % Add error-checking for output from older versions of obs_diag.
+ if (length(plotdat.YTick) ~= length(plotdat.levels))
error('There is a duplicated value in the array specifying the levels - must change your input.nml and rerun obs_diag')
end
- plotdat.indices = indices;
level_edges = sort(plotdat.level_edges);
plotdat.level_edges = level_edges;
- % The rest of this script was written for the third-party netcdf
- % support. Matlab's native ncread transposes the variables, so I have to
- % permute them back to the expected storage order.
+ % guess(nregions,nlevels,ncopies)
guess = ncread(fname, plotdat.guessvar);
- analy = ncread(fname, plotdat.analyvar);
- rank = length(size(guess));
- guess = permute(guess,rank:-1:1);
- analy = permute(analy,rank:-1:1);
-
- % singleton dimensions are auto-squeezed - which is unfortunate.
- % We want these things to be 3D. [copy-level-region]
-
- if ( plotdat.nlevels == 1 )
- bob(:,1,:) = guess;
- ted(:,1,:) = analy;
- guess = bob; clear bob
- analy = ted; clear ted
+ analy = local_ncread(fname, plotdat.analyvar);
+ if (isempty(analy))
+ analy = guess; % make the variable the same shape as guess
+ analy(:) = NaN; % and fill it with nothing
+ plotdat.has_analysis = false;
+ plotdat.post_string = '';
+ else
+ plotdat.has_analysis = true;
+ plotdat.post_string = '; \diamondsuit=posteriorOK';
end
% check to see if there is anything to plot
% The number possible is decreased by the number of observations
% rejected by namelist control.
- fprintf('\n')
- fprintf('%10d %s observations had DART QC of 4 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC4index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 5 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC5index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 6 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC6index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 7 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC7index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 8 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC8index, :,:))),plotdat.myvarname)
-
- nposs = sum(guess(plotdat.Npossindex,:,:)) - ...
- sum(guess(plotdat.NQC5index ,:,:)) - ...
- sum(guess(plotdat.NQC6index ,:,:));
-
- if ( sum(nposs(:)) < 1 )
- fprintf('No obs for %s... skipping\n', plotdat.varnames{ivar})
+ priorQCs = get_qc_values(fname, plotdat.guessvar, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
+
+ plotdat.ges_Neval = priorQCs.num_evaluated;
+ plotdat.ges_Nposs = priorQCs.nposs;
+ plotdat.ges_Nused = priorQCs.nused;
+ plotdat.ges_bias = guess(:,:,plotdat.biasindex);
+ plotdat.ges_copy = guess(:,:,plotdat.copyindex);
+
+ if ( sum(plotdat.ges_Nposs(:)) < 1 )
+ fprintf('no obs for %s... skipping\n', plotdat.varnames{ivar})
continue
end
- plotdat.ges_copy = guess(plotdat.copyindex, :, :);
- plotdat.anl_copy = analy(plotdat.copyindex, :, :);
- plotdat.ges_bias = guess(plotdat.biasindex, :, :);
- plotdat.anl_bias = analy(plotdat.biasindex, :, :);
- plotdat.ges_Nqc4 = guess(plotdat.NQC4index, :, :);
- plotdat.anl_Nqc4 = analy(plotdat.NQC4index, :, :);
- plotdat.ges_Nqc5 = guess(plotdat.NQC5index, :, :);
- plotdat.anl_Nqc5 = analy(plotdat.NQC5index, :, :);
- plotdat.ges_Nqc6 = guess(plotdat.NQC6index, :, :);
- plotdat.anl_Nqc6 = analy(plotdat.NQC6index, :, :);
- plotdat.ges_Nqc7 = guess(plotdat.NQC7index, :, :);
- plotdat.anl_Nqc7 = analy(plotdat.NQC7index, :, :);
- plotdat.ges_Nqc8 = guess(plotdat.NQC8index, :, :);
- plotdat.anl_Nqc8 = analy(plotdat.NQC8index, :, :);
-
- plotdat.ges_Nused = guess(plotdat.Nusedindex, :, :);
- plotdat.anl_Nused = guess(plotdat.Nusedindex, :, :);
- plotdat.ges_Nposs = guess(plotdat.Npossindex, :, :) - ...
- plotdat.ges_Nqc5 - plotdat.ges_Nqc6;
- plotdat.anl_Nposs = analy(plotdat.Npossindex, :, :) - ...
- plotdat.anl_Nqc5 - plotdat.anl_Nqc6;
+ if (plotdat.has_analysis)
+ posteQCs = get_qc_values(fname, plotdat.analyvar, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
+ plotdat.anl_Nused = posteQCs.nused;
+ plotdat.anl_bias = analy(:,:,plotdat.biasindex);
+ plotdat.anl_copy = analy(:,:,plotdat.copyindex);
+ else
+ plotdat.anl_Nused = zeros(size(plotdat.ges_Nused));
+ plotdat.anl_bias = plotdat.ges_bias; % needed for determining limits
+ plotdat.anl_copy = plotdat.ges_copy; % needed for determining limits
+ end
+
+ % call report_qc_values.m
+
plotdat.Xrange = FindRange(plotdat);
% plot by region - each in its own figure.
for iregion = 1:plotdat.nregions
- figure(iregion); clf(iregion); orient(figuredata.orientation); wysiwyg
+ figure(iregion);
+ clf(iregion);
+ orient(figuredata.orientation);
plotdat.region = iregion;
plotdat.myregion = deblank(plotdat.region_names(iregion,:));
- myplot(plotdat, figuredata);
+
+ myplot(plotdat);
+
BottomAnnotation(fname)
psfname = sprintf('%s_bias_%s_profile_region%d', ...
plotdat.varnames{ivar}, plotdat.copystring, iregion);
- print(gcf,'-dpdf',psfname);
+
+ if verLessThan('matlab','R2016a')
+ print(gcf, '-dpdf', psfname);
+ else
+ print(gcf, '-dpdf', '-bestfit', psfname);
+ end
+
+ % block to go slow and look at each one ...
+ if (p.Results.pause)
+ disp('Pausing, hit any key to continue ...')
+ pause
+ end
+
end
-
end
-
%=====================================================================
% 'Helper' functions
%=====================================================================
-function myplot(plotdat,figdata)
+function myplot(plotdat)
-%% Interlace the [ges,anl] to make a sawtooth plot.
-% By this point, the middle two dimensions are singletons.
-% The data must be sorted to match the order of the levels.
-cg = plotdat.ges_copy(:,:,plotdat.region); CG = cg(plotdat.indices);
-ca = plotdat.anl_copy(:,:,plotdat.region); CA = ca(plotdat.indices);
+global figuredata
-mg = plotdat.ges_bias(:,:,plotdat.region); MG = mg(plotdat.indices);
-ma = plotdat.anl_bias(:,:,plotdat.region); MA = ma(plotdat.indices);
+ges_copy = plotdat.ges_copy(plotdat.region,:);
+anl_copy = plotdat.anl_copy(plotdat.region,:);
+ges_bias = plotdat.ges_bias(plotdat.region,:);
+anl_bias = plotdat.anl_bias(plotdat.region,:);
-g = plotdat.ges_Nposs(:,:,plotdat.region); G = g(plotdat.indices);
-a = plotdat.anl_Nposs(:,:,plotdat.region); A = a(plotdat.indices);
+ges_Neval = plotdat.ges_Neval(plotdat.region,:);
+ges_Nposs = plotdat.ges_Nposs(plotdat.region,:);
+ges_Nused = plotdat.ges_Nused(plotdat.region,:);
+anl_Nused = plotdat.anl_Nused(plotdat.region,:);
+anl_Ngood = sum(anl_Nused);
-nobs_poss = G;
-nposs_delta = G - A;
+mean_pr_bias = mean(ges_bias(isfinite(ges_bias)));
+mean_pr_copy = mean(ges_copy(isfinite(ges_copy)));
+str_pr_bias = sprintf('%s pr=%.5g','bias',mean_pr_bias);
+str_pr_copy = sprintf('%s pr=%.5g',plotdat.copystring,mean_pr_copy);
-g = plotdat.ges_Nused(:,:,plotdat.region); G = g(plotdat.indices);
-a = plotdat.anl_Nused(:,:,plotdat.region); A = a(plotdat.indices);
-nobs_used = G;
-nused_delta = G - A;
+% If the posterior is available, plot them too.
-% Determine some quantities for the legend
-nobs = sum(nobs_used);
-if ( nobs > 1 )
- bias_guess = mean(MG(isfinite(MG)));
- bias_analy = mean(MA(isfinite(MA)));
- other_guess = mean(CG(isfinite(CG)));
- other_analy = mean(CA(isfinite(CA)));
-else
- bias_guess = NaN;
- bias_analy = NaN;
- other_guess = NaN;
- other_analy = NaN;
+if anl_Ngood > 0
+ mean_po_bias = mean(anl_bias(isfinite(anl_bias)));
+ mean_po_copy = mean(anl_copy(isfinite(anl_copy)));
+ str_po_bias = sprintf('%s po=%.5g','bias',mean_po_bias);
+ str_po_copy = sprintf('%s po=%.5g',plotdat.copystring,mean_po_copy);
end
-str_bias_pr = sprintf('%s pr=%.5g','bias',bias_guess);
-str_bias_po = sprintf('%s po=%.5g','bias',bias_analy);
-str_other_pr = sprintf('%s pr=%.5g',plotdat.copystring,other_guess);
-str_other_po = sprintf('%s po=%.5g',plotdat.copystring,other_analy);
-
% Plot the bias and 'xxx' on the same (bottom) axis.
% The observation count will use the axis on the top.
% Ultimately, we want to suppress the 'auto' feature of the
% axis labelling, so we manually set some values that normally
% don't need to be set.
-ax1 = subplot('position',figdata.position);
+ax1 = subplot('position',figuredata.position);
+orient(figuredata.orientation)
% add type of vertical coordinate info for adjusting axes to accomodate legend
Stripes(plotdat.Xrange, plotdat.level_edges, plotdat.level_units);
-set(ax1, 'YDir', plotdat.YDir, 'YTick', plotdat.level, 'Layer', 'top')
-set(ax1,'YAxisLocation','left','FontSize',figdata.fontsize)
+set(ax1, 'YDir', plotdat.YDir, 'YTick', plotdat.YTick, 'Layer', 'top')
+set(ax1,'YAxisLocation','left','FontSize',figuredata.fontsize)
% draw the result of the experiment
-hold on;
-h1 = plot(MG,plotdat.level,'k+-',MA,plotdat.level,'k+--', ...
- CG,plotdat.level,'ro-',CA,plotdat.level,'ro--');
-set(h1,'LineWidth',figdata.linewidth);
-hold off;
+h1 = line(ges_bias,plotdat.levels);
+h2 = line(ges_copy,plotdat.levels);
+
+set(h1,'Color', figuredata.rmse_color, ...
+ 'Marker', figuredata.marker1, ...
+ 'LineStyle', figuredata.solid, ...
+ 'LineWidth', figuredata.linewidth, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'MarkerFaceColor',figuredata.rmse_color)
+
+set(h2,'Color', figuredata.copy_color, ...
+ 'Marker', figuredata.marker2, ...
+ 'LineStyle', figuredata.solid, ...
+ 'LineWidth', figuredata.linewidth, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'MarkerFaceColor',figuredata.copy_color)
+
+if anl_Ngood > 0
+ h3 = line(anl_bias,plotdat.levels);
+ h4 = line(anl_copy,plotdat.levels);
+
+ set(h3,'Color', figuredata.rmse_color, ...
+ 'Marker', figuredata.marker1, ...
+ 'LineStyle', figuredata.dashed, ...
+ 'LineWidth', figuredata.linewidth, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'MarkerFaceColor',figuredata.rmse_color)
+
+ set(h4,'Color', figuredata.copy_color, ...
+ 'Marker', figuredata.marker2, ...
+ 'LineStyle', figuredata.dashed, ...
+ 'LineWidth', figuredata.linewidth, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'MarkerFaceColor',figuredata.copy_color)
+
+ h = legend([h1,h3,h2,h4], str_pr_bias, str_po_bias, ...
+ str_pr_copy, str_po_copy);
+else
+
+ h = legend([h1,h2], str_pr_bias, str_pr_copy);
+end
-zeroline = line([0 0],plotdat.Yrange,'Color',[0 100 0]/255,'Parent',ax1);
-set(zeroline,'LineWidth',2.5,'LineStyle','-')
+set(h,'Interpreter','none','Box','off','Location','NorthWest')
-h = legend(h1, str_bias_pr, str_bias_po, str_other_pr, str_other_po, 'Location', 'NorthWest');
-set(h,'Interpreter','none','Box','off')
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+else
+ h.AutoUpdate = 'off';
+end
+
+% Want a zeroline for bias plots.
+zeroline = line([0 0],plotdat.Yrange,'Color',[200 200 200]/255,'Parent',ax1);
+set(zeroline,'LineWidth',2.5,'LineStyle','-')
% If the observation is trusted, reference that somehow
+
switch lower(plotdat.trusted)
case 'true'
axlims = axis;
@@ -400,16 +408,32 @@ function myplot(plotdat,figdata)
'XAxisLocation','top', ...
'YAxisLocation','right', ...
'Color','none', ...
- 'XColor','b', ...
+ 'XColor',figuredata.obs_color, ...
'YColor',get(ax1,'YColor'), ...
'YLim',get(ax1,'YLim'), ...
'YDir',get(ax1,'YDir'), ...
'FontSize',get(ax1,'FontSize'));
-h2 = line(nobs_poss,plotdat.level,'Color','b','Parent',ax2);
-h3 = line(nobs_used,plotdat.level,'Color','b','Parent',ax2);
-set(h2,'LineStyle','none','Marker','o');
-set(h3,'LineStyle','none','Marker','*');
+ax2h1 = line(ges_Nposs, plotdat.levels, 'Parent', ax2);
+ax2h2 = line(ges_Nused, plotdat.levels, 'Parent', ax2);
+
+set(ax2h1, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.obs_marker, ...
+ 'MarkerSize', figuredata.MarkerSize);
+
+set(ax2h2, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.ges_marker, ...
+ 'MarkerSize', figuredata.MarkerSize);
+
+if anl_Ngood > 0
+ ax2h3 = line(anl_Nused, plotdat.levels, 'Parent',ax2);
+ set(ax2h3, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.anl_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+end
% use same Y ticks - but no labels.
set(ax2,'YTick',get(ax1,'YTick'), 'YTicklabel',[]);
@@ -418,14 +442,24 @@ function myplot(plotdat,figdata)
xscale = matchingXticks(ax1,ax2);
set(get(ax1,'Ylabel'),'String',plotdat.level_units, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
set(get(ax1,'Xlabel'),'String',{plotdat.xlabel, plotdat.timespan}, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
-set(get(ax2,'Xlabel'),'String', ...
- ['# of obs (o=possible, \ast=assimilated) x' int2str(uint32(xscale))],'FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
+
+% determine if the observation was flagged as 'evaluate' or 'assimilate'
+
+if sum(ges_Neval) > 0
+ string1 = sprintf('# of obs (o=possible; %s %s) x %d', ...
+ '\ast=evaluated', plotdat.post_string, uint32(xscale));
+else
+ string1 = sprintf('# of obs (o=possible; %s %s) x %d', ...
+ '\ast=assimilated', plotdat.post_string, uint32(xscale));
+end
+
+set(get(ax2,'Xlabel'), 'String', string1, 'FontSize', figuredata.fontsize)
title({plotdat.myregion, plotdat.myvarname}, ...
- 'Interpreter', 'none', 'FontSize', figdata.fontsize, 'FontWeight', 'bold')
+ 'Interpreter', 'none', 'FontSize', figuredata.fontsize, 'FontWeight', 'bold')
%=====================================================================
@@ -458,6 +492,8 @@ function BottomAnnotation(main)
% In this context, if the variable has a 'time' dimension
% it cannot be a variable of interest.
+global verbose
+
if ( ~(isfield(x,'allvarnames') && isfield(x,'allvardims')))
error('Doh! no ''allvarnames'' and ''allvardims'' components')
end
@@ -468,7 +504,7 @@ function BottomAnnotation(main)
for i = 1:length(x.allvarnames)
dimnames = lower(x.allvardims{i});
- if (isempty(strfind(dimnames,'time')))
+ if (isempty(strfind(dimnames,'time'))) %#ok
platform = ReturnBase(x.allvarnames{i});
if (~ isempty(platform))
j = j + 1;
@@ -483,7 +519,7 @@ function BottomAnnotation(main)
ydims = struct([]);
for k = 1:length(i)
- fprintf('%2d is %s\n',k,basenames{i(k)})
+ if (verbose), fprintf('%3d is %s\n',k,basenames{i(k)}); end
y{k} = basenames{i(k)};
ydims{k} = basedims{i(k)};
end
@@ -492,7 +528,7 @@ function BottomAnnotation(main)
%=====================================================================
-function [level_org, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname,varname)
+function [levels, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname,varname)
%% Find the vertical dimension and harvest some info
varinfo = ncinfo(fname,varname);
@@ -507,7 +543,7 @@ function BottomAnnotation(main)
error('There is no level information for %s in %s',varname,fname)
end
-level_org = ncread( fname,varinfo.Dimensions(leveldim).Name);
+levels = ncread( fname,varinfo.Dimensions(leveldim).Name);
level_units = ncreadatt(fname,varinfo.Dimensions(leveldim).Name,'units');
nlevels = varinfo.Size(leveldim);
edgename = sprintf('%s_edges',varinfo.Dimensions(leveldim).Name);
@@ -638,7 +674,7 @@ function BottomAnnotation(main)
hold on;
for i = 1:2:(length(edges)-1)
yc = [ edges(i) edges(i) edges(i+1) edges(i+1) edges(i) ];
- hf = fill(xc,yc,[0.8 0.8 0.8],'EdgeColor','none');
+ fill(xc,yc,[0.8 0.8 0.8],'EdgeColor','none');
end
hold off;
@@ -649,33 +685,12 @@ function BottomAnnotation(main)
%=====================================================================
-function figdata = setfigure()
-%%
-% figure out a page layout
-% extra space at the bottom for the date/file annotation
-% extra space at the top because the titles have multiple lines
-
-orientation = 'tall';
-fontsize = 16;
-position = [0.15 0.12 0.7 0.75];
-linewidth = 2.0;
-
-figdata = struct('expcolors', {{'k','r','b','m','g','c','y'}}, ...
- 'expsymbols', {{'o','s','d','p','h','s','*'}}, ...
- 'prpolines', {{'-','--'}}, 'position', position, ...
- 'fontsize',fontsize, 'orientation',orientation, ...
- 'linewidth',linewidth);
-
-
-%=====================================================================
-
-
function value = local_ncread(fname,varname)
%% If the variable exists in the file, return the contents of the variable.
% if the variable does not exist, return empty value instead of error-ing
% out.
-[variable_present, varid] = nc_var_exists(fname,varname);
+[variable_present, ~] = nc_var_exists(fname,varname);
if (variable_present)
value = ncread(fname, varname);
else
diff --git a/diagnostics/matlab/plot_evolution.m b/diagnostics/matlab/plot_evolution.m
index 9679b766c1..3248678698 100644
--- a/diagnostics/matlab/plot_evolution.m
+++ b/diagnostics/matlab/plot_evolution.m
@@ -3,8 +3,8 @@
% Part of the observation-space diagnostics routines.
%
% 'obs_diag' produces a netcdf file containing the diagnostics.
-% obs_diag condenses the obs_seq.final information into summaries for a few specified
-% regions - on a level-by-level basis.
+% 'obs_diag' condenses the obs_seq.final information into summaries for a few
+% specified regions - on a level-by-level basis.
%
% The number of observations possible reflects only those observations
% that have incoming QC values of interest. Any observation with a DART
@@ -19,23 +19,36 @@
% For TRUSTED observations, this is different than the number used to calculate
% bias, rmse, spread, etc.
%
-% USAGE: plotdat = plot_evolution(fname, copy);
+% USAGE: plotdat = plot_evolution(fname, copy [,varargin]);
%
% fname : netcdf file produced by 'obs_diag'
%
% copy : string defining the metric of interest. 'rmse', 'spread', etc.
% Possible values are available in the netcdf 'CopyMetaData' variable.
-% (ncdump -v CopyMetaData obs_diag_output.nc)%
+% (ncdump -v CopyMetaData obs_diag_output.nc)
%
-% obsname : Optional. If present, The strings of each observation type to plot.
+% varargin: optional parameter-value pairs. Supported parameters are described below.
+%
+% obsname : The strings of each observation type to plot.
% Each observation type will be plotted in a separate graphic.
% Default is to plot all available observation types.
%
-% level : Optional. 'level' index. Default is to plot all levels.
+% level : 'level' index. Default is to plot all levels.
%
-% range : Optional. 'range' of the value being plotted. Default is to
+% range : 'range' of the value being plotted. Default is to
% automatically determine range based on the data values.
%
+% verbose : true/false to control amount of run-time output
+%
+% MarkerSize : integer controlling the size of the symbols
+%
+% DateForm : Free-form character string controlling representation of the time axis.
+% See 'help datetick' for discussion and valid values.
+% Example ones are 'mm/dd' and 'dd HH:MM'.
+%
+% pause : true/false to conrol pausing after each figure is created.
+% true will require hitting any key to continue to next plot
+%
% OUTPUT: 'plotdat' is a structure containing what was last plotted.
% A postscript file containing a page for each level - each region.
% The other file is a simple text file containing summary information
@@ -43,6 +56,7 @@
% Both of these filenames contain the observation type,
% copy and region as part of the name.
%
+%
% EXAMPLE 1 - plot the evolution of the bias for all observation types, all levels
%
% fname = 'obs_diag_output.nc';
@@ -62,8 +76,8 @@
% EXAMPLE 3 - plot the evolution of the rmse for just the radiosonde temperature obs
% for the 4th level and force the vertical axis of the 'rmse' to be 0,10
%
-% plotdat = plot_evolution(fname, copy, 'obsname', 'RADIOSONDE_TEMPERATURE', ...
-% 'level', 4, 'range', [0 10]);
+% plotdat = plot_evolution(fname, 'rmse', 'obsname', 'RADIOSONDE_TEMPERATURE', ...
+% 'level', 4, 'range', [0 10], 'pause', false);
%% DART software - Copyright UCAR. This open source software is provided
% by UCAR, "as is", without charge, subject to all terms of use at
@@ -71,31 +85,36 @@
%
% DART $Id$
-default_level = -1;
-default_obsname = 'none';
-default_range = [NaN NaN];
+default_obsname = 'none';
+default_verbosity = true;
+default_markersize = 12;
+default_pause = false;
+default_range = [NaN NaN];
+default_level = -1;
+default_dateform = 'default';
p = inputParser;
addRequired(p,'fname',@ischar);
addRequired(p,'copy',@ischar);
if (exist('inputParser/addParameter','file') == 2)
- addParameter(p,'obsname',default_obsname,@ischar);
- addParameter(p,'range',default_range,@isnumeric);
- addParameter(p,'level',default_level,@isnumeric);
+ addParameter(p,'obsname', default_obsname, @ischar);
+ addParameter(p,'verbose', default_verbosity, @islogical);
+ addParameter(p,'MarkerSize', default_markersize, @isnumeric);
+ addParameter(p,'pause', default_pause, @islogical);
+ addParameter(p,'range', default_range, @isnumeric);
+ addParameter(p,'level', default_level, @isnumeric);
+ addParameter(p,'DateForm', default_dateform, @ischar);
else
- addParamValue(p,'obsname',default_obsname,@ischar);
- addParamValue(p,'range',default_range,@isnumeric);
- addParamValue(p,'level',default_level,@isnumeric);
+ addParamValue(p,'obsname', default_obsname, @ischar); %#ok
+ addParamValue(p,'verbose', default_verbosity, @islogical); %#ok
+ addParamValue(p,'MarkerSize',default_markersize, @isnumeric); %#ok
+ addParamValue(p,'pause', default_pause, @islogical); %#ok
+ addParamValue(p,'range', default_range, @isnumeric); %#ok
+ addParamValue(p,'level', default_level, @isnumeric); %#ok
+ addParamValue(p,'DateForm', default_dateform, @ischar); %#ok
end
p.parse(fname, copy, varargin{:});
-% if you want to echo the input
-% fprintf('fname : %s\n', p.Results.fname)
-% fprintf('copy : %s\n', p.Results.copy)
-% fprintf('obsname : %s\n', p.Results.obsname)
-% fprintf('level : %d\n', p.Results.level)
-% fprintf('range : %f %f \n', p.Results.range)
-
if ~isempty(fieldnames(p.Unmatched))
disp('Extra inputs:')
disp(p.Unmatched)
@@ -120,50 +139,7 @@
% Harvest plotting info/metadata from netcdf file.
%---------------------------------------------------------------------
-plotdat.fname = fname;
-plotdat.copystring = copy;
-plotdat.bincenters = ncread(fname,'time');
-plotdat.binedges = ncread(fname,'time_bounds');
-plotdat.mlevel = local_ncread(fname,'mlevel');
-plotdat.plevel = local_ncread(fname,'plevel');
-plotdat.plevel_edges = local_ncread(fname,'plevel_edges');
-plotdat.hlevel = local_ncread(fname,'hlevel');
-plotdat.hlevel_edges = local_ncread(fname,'hlevel_edges');
-[plotdat.ncopies, ~] = nc_dim_info(fname,'copy');
-[plotdat.nregions, ~] = nc_dim_info(fname,'region');
-plotdat.region_names = strtrim(ncread(fname,'region_names')');
-
-dimensionality = nc_read_att(fname, '/', 'LocationRank');
-plotdat.binseparation = nc_read_att(fname, '/', 'bin_separation');
-plotdat.binwidth = nc_read_att(fname, '/', 'bin_width');
-time_to_skip = nc_read_att(fname, '/', 'time_to_skip');
-plotdat.lonlim1 = nc_read_att(fname, '/', 'lonlim1');
-plotdat.lonlim2 = nc_read_att(fname, '/', 'lonlim2');
-plotdat.latlim1 = nc_read_att(fname, '/', 'latlim1');
-plotdat.latlim2 = nc_read_att(fname, '/', 'latlim2');
-plotdat.biasconv = nc_read_att(fname, '/', 'bias_convention');
-
-% Coordinate between time types and dates
-
-%calendar = nc_read_att(fname,'time','calendar');
-timeunits = nc_read_att(fname,'time','units');
-timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
-timeorigin = datenum(timebase(1),timebase(2),timebase(3));
-if ( isempty(time_to_skip) == 1)
- iskip = 0;
-elseif ( numel(time_to_skip) == 6)
- skip_seconds = time_to_skip(4)*3600 + time_to_skip(5)*60 + time_to_skip(6);
- iskip = time_to_skip(3) + skip_seconds/86400;
-else
- error('time_to_skip variable has unusual length. Should be either 0 or 6.')
-end
-
-% set up a structure with all static plotting components
-
-plotdat.bincenters = plotdat.bincenters + timeorigin;
-plotdat.binedges = plotdat.binedges + timeorigin;
-plotdat.Nbins = length(plotdat.bincenters);
-plotdat.toff = plotdat.bincenters(1) + iskip;
+plotdat = read_obsdiag_staticdata(fname,copy);
if (nvars == 0)
[plotdat.allvarnames, plotdat.allvardims] = get_varsNdims(fname);
@@ -174,20 +150,17 @@
plotdat.nvars = nvars;
end
-plotdat.copyindex = get_copy_index(fname,copy);
-plotdat.Npossindex = get_copy_index(fname,'Nposs');
-plotdat.Nusedindex = get_copy_index(fname,'Nused');
-plotdat.NQC4index = get_copy_index(fname,'N_DARTqc_4');
-plotdat.NQC5index = get_copy_index(fname,'N_DARTqc_5');
-plotdat.NQC6index = get_copy_index(fname,'N_DARTqc_6');
-plotdat.NQC7index = get_copy_index(fname,'N_DARTqc_7');
-plotdat.NQC8index = get_copy_index(fname,'N_DARTqc_8');
+global figuredata verbose
-figuredata = setfigure();
+figuredata = set_obsdiag_figure('landscape');
+figuredata.MarkerSize = p.Results.MarkerSize;
+figuredata.DateForm = p.Results.DateForm;
+verbose = p.Results.verbose;
%%---------------------------------------------------------------------
% Loop around (time-copy-level-region) observation types
%----------------------------------------------------------------------
+
psfname = cell(plotdat.nvars);
for ivar = 1:plotdat.nvars
@@ -207,25 +180,39 @@
for iregion = 1:plotdat.nregions
psfname{iregion} = sprintf('%s_%s_evolution_region%d.ps', ...
plotdat.varnames{ivar}, plotdat.copystring, iregion);
- fprintf('Removing %s from the current directory.\n',psfname{iregion})
- system(sprintf('rm %s',psfname{iregion}));
+ if (exist(psfname{iregion},'file') == 2)
+ fprintf('Removing %s from the current directory.\n',psfname{iregion})
+ system(sprintf('rm %s',psfname{iregion}));
+ end
end
% remove any existing log file -
lgfname = sprintf('%s_%s_obscount.txt',plotdat.varnames{ivar},plotdat.copystring);
- fprintf('Removing %s from the current directory.\n',lgfname)
- system(sprintf('rm %s',lgfname));
+ if (exist(lgfname,'file') == 2)
+ fprintf('Removing %s from the current directory.\n',lgfname)
+ system(sprintf('rm %s',lgfname));
+ end
logfid = fopen(lgfname,'wt');
fprintf(logfid,'%s\n',lgfname);
- %% todo FIXME replace with a permute routine to get desired shape
+ % check to see if there is anything to plot
+ % The number possible is decreased by the number of observations
+ % rejected by namelist control.
+
+ qcvalues = get_qc_values(fname, plotdat.guessvar, 'fatal', false, ...
+ 'verbose', false);
+
+ if ( sum(qcvalues.nposs(:)) < 1 )
+ fprintf('no obs for %s... skipping\n', plotdat.varnames{ivar})
+ continue
+ end
+
% get appropriate vertical coordinate variable
- % regions-levels-copy-time
[dimnames, ~] = nc_var_dims(fname, plotdat.guessvar);
- if ( dimensionality == 1 ) % observations on a unit circle, no level
+ if ( plotdat.dimensionality == 1 ) % observations on a unit circle, no level
plotdat.level = 1;
plotdat.level_units = [];
elseif ( strfind(dimnames{2},'surface') > 0 )
@@ -237,96 +224,57 @@
else
plotdat.level = ncread(fname, dimnames{2});
plotdat.level_units = nc_read_att(fname, dimnames{2}, 'units');
+ nlevels = length(plotdat.level);
+ if (p.Results.level < 0 )
+ % use all the levels
+ elseif (p.Results.level > 0 && p.Results.level < nlevels)
+ plotdat.level = p.Results.level;
+ else
+ error('%d is not a valid level for %s',p.Results.level,plotdat.guessvar)
+ end
end
- plotdat.nlevels = length(plotdat.level);
-
- % Here is the tricky part.
- % ncread returns: region-level-copy-time ... we need:
- % time-copy-level-region
- % Singleton dimensions are auto-squeezed; single levels, single regions ...
- % The reshape restores the singleton dimensions
-
- guess_raw = ncread(fname, plotdat.guessvar);
- guess_raw = permute(guess_raw,length(size(guess_raw)):-1:1);
- guess = reshape(guess_raw, plotdat.Nbins, plotdat.ncopies, ...
- plotdat.nlevels, plotdat.nregions);
-
- analy_raw = ncread(fname, plotdat.analyvar);
- analy_raw = permute(analy_raw,length(size(analy_raw)):-1:1);
- analy = reshape(analy_raw, plotdat.Nbins, plotdat.ncopies, ...
- plotdat.nlevels, plotdat.nregions);
-
- % check to see if there is anything to plot
- % The number possible is decreased by the number of observations
- % rejected by namelist control.
- nqc5 = guess(:,plotdat.NQC5index,:,:);
- nqc6 = guess(:,plotdat.NQC6index,:,:);
+ % read the whole variable, subset it later
- fprintf('%10d %s observations had DART QC of 5 (all levels, all regions).\n', ...
- sum(nqc5(:)),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 6 (all levels, all regions).\n', ...
- sum(nqc6(:)),plotdat.myvarname)
-
- nposs = sum(guess(:,plotdat.Npossindex,:,:)) - ...
- sum(guess(:,plotdat.NQC5index ,:,:)) - ...
- sum(guess(:,plotdat.NQC6index ,:,:));
-
- if ( sum(nposs(:)) < 1 )
- fprintf('no obs for %s... skipping\n', plotdat.varnames{ivar})
- continue
- end
-
- if (p.Results.level < 0)
- wantedlevels = 1:plotdat.nlevels;
+ guess = ncread(fname, plotdat.guessvar);
+ analy = local_ncread(fname, plotdat.analyvar);
+ if ( isempty(analy) )
+ % force analysis to be the same shape as the guess and full of NaNs
+ analy = guess;
+ analy(:) = NaN;
+ has_posterior = false;
+ plotdat.post_string = '';
else
- wantedlevels = p.Results.level;
+ has_posterior = true;
+ plotdat.post_string = '; \diamondsuit=posteriorOK';
end
- for ilevel = wantedlevels
-
- % summarize the observation counts in the log file
-
- fprintf(logfid,'\nlevel %d %f %s\n',ilevel,plotdat.level(ilevel),plotdat.level_units);
- plotdat.ges_Nqc4 = guess(:,plotdat.NQC4index ,ilevel,:);
- plotdat.anl_Nqc4 = analy(:,plotdat.NQC4index ,ilevel,:);
- fprintf(logfid,'DART QC == 4, prior/post %d %d\n',sum(plotdat.ges_Nqc4(:)), ...
- sum(plotdat.anl_Nqc4(:)));
-
- plotdat.ges_Nqc5 = guess(:,plotdat.NQC5index ,ilevel,:);
- plotdat.anl_Nqc5 = analy(:,plotdat.NQC5index ,ilevel,:);
- fprintf(logfid,'DART QC == 5, prior/post %d %d\n',sum(plotdat.ges_Nqc5(:)), ...
- sum(plotdat.anl_Nqc5(:)));
-
- plotdat.ges_Nqc6 = guess(:,plotdat.NQC6index ,ilevel,:);
- plotdat.anl_Nqc6 = analy(:,plotdat.NQC6index ,ilevel,:);
- fprintf(logfid,'DART QC == 6, prior/post %d %d\n',sum(plotdat.ges_Nqc6(:)), ...
- sum(plotdat.anl_Nqc6(:)));
-
- plotdat.ges_Nqc7 = guess(:,plotdat.NQC7index ,ilevel,:);
- plotdat.anl_Nqc7 = analy(:,plotdat.NQC7index ,ilevel,:);
- fprintf(logfid,'DART QC == 7, prior/post %d %d\n',sum(plotdat.ges_Nqc7(:)), ...
- sum(plotdat.anl_Nqc7(:)));
-
- plotdat.ges_Nqc8 = guess(:,plotdat.NQC8index ,ilevel,:);
- plotdat.anl_Nqc8 = analy(:,plotdat.NQC8index ,ilevel,:);
- fprintf(logfid,'DART QC == 8, prior/post %d %d\n',sum(plotdat.ges_Nqc8(:)), ...
- sum(plotdat.anl_Nqc8(:)));
+ for ilevel = 1:length(plotdat.level)
- plotdat.ges_Nposs = guess(:,plotdat.Npossindex, ilevel,:) - ...
- plotdat.ges_Nqc5 - plotdat.ges_Nqc6;
- plotdat.anl_Nposs = analy(:,plotdat.Npossindex, ilevel,:) - ...
- plotdat.anl_Nqc5 - plotdat.anl_Nqc6;
- fprintf(logfid,'# obs poss, prior/post %d %d\n',sum(plotdat.ges_Nposs(:)), ...
- sum(plotdat.anl_Nposs(:)));
+ priorQCs = get_qc_values(fname, plotdat.guessvar, ...
+ 'levelindex', ilevel, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
+ plotdat.mylevel = ilevel;
+ plotdat.ges_Neval = priorQCs.num_evaluated;
+ plotdat.ges_Nposs = priorQCs.nposs;
+ plotdat.ges_Nused = priorQCs.nused;
+ plotdat.ges_copy = guess(:,ilevel,plotdat.copyindex,:);
+ plotdat.anl_copy = analy(:,ilevel,plotdat.copyindex,:);
- plotdat.ges_Nused = guess(:,plotdat.Nusedindex, ilevel,:);
- plotdat.anl_Nused = analy(:,plotdat.Nusedindex, ilevel,:);
- fprintf(logfid,'# obs used, prior/post %d %d\n',sum(plotdat.ges_Nused(:)), ...
- sum(plotdat.anl_Nused(:)));
+ if (has_posterior)
+ posteQCs = get_qc_values(fname, plotdat.analyvar, ...
+ 'levelindex', ilevel, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
+ plotdat.anl_Nused = posteQCs.nused;
+ plotdat.anl_copy = analy(:,ilevel,plotdat.copyindex,:);
+ else
+ plotdat.anl_Nused = zeros(size(plotdat.ges_Nused));
+ plotdat.anl_copy = plotdat.ges_copy; % needed for determining limits
+ end
- plotdat.ges_copy = guess(:,plotdat.copyindex, ilevel,:);
- plotdat.anl_copy = analy(:,plotdat.copyindex, ilevel,:);
+ % call report_qc_values.m
if isnan(p.Results.range(1))
plotdat.Yrange = FindRange(plotdat);
@@ -337,27 +285,33 @@
% plot each region, each level to a separate figure
for iregion = 1:plotdat.nregions
- figure(iregion); clf(iregion); orient(figuredata.orientation); wysiwyg
+ figure(iregion); clf(iregion); orient(figuredata.orientation);
plotdat.region = iregion;
plotdat.myregion = deblank(plotdat.region_names(iregion,:));
if ( isempty(plotdat.level_units) )
- plotdat.title = plotdat.myvarname;
+ plotdat.title = plotdat.myvarname;
else
- plotdat.title = sprintf('%s @ %d %s', ...
+ plotdat.title = sprintf('%s @ %d %s', ...
plotdat.myvarname, ...
plotdat.level(ilevel), ...
plotdat.level_units);
end
- myplot(plotdat,figuredata);
+ myplot(plotdat);
% create/append to the postscript file
- print(gcf,'-dpsc','-append',psfname{iregion});
+ if verLessThan('matlab','R2016a')
+ print(gcf, '-dpsc', '-append', psfname{iregion});
+ else
+ print(gcf, '-dpsc', '-append', '-bestfit', psfname{iregion});
+ end
% block to go slow and look at each one ...
- % disp('Pausing, hit any key to continue ...')
- % pause
+ if (p.Results.pause)
+ disp('Pausing, hit any key to continue ...')
+ pause
+ end
end
end
@@ -368,98 +322,77 @@
%=====================================================================
-function myplot(plotdat,figdata)
+function myplot(plotdat)
%% The prior and posterior are plotted as separate items.
% By this point, the middle two dimensions are singletons.
-cg = plotdat.ges_copy(:,:,:,plotdat.region);
-ca = plotdat.anl_copy(:,:,:,plotdat.region);
-
-g = plotdat.ges_Nposs(:,:,:,plotdat.region);
-a = plotdat.anl_Nposs(:,:,:,plotdat.region);
-nobs_poss = reshape([g a]',2*plotdat.Nbins,1);
-
-g = plotdat.ges_Nused(:,:,:,plotdat.region);
-a = plotdat.anl_Nused(:,:,:,plotdat.region);
-nobs_used = reshape([g a]',2*plotdat.Nbins,1);
-
-tg = plotdat.bincenters;
-ta = plotdat.bincenters;
-t = reshape([tg ta]',2*plotdat.Nbins,1);
-
-% Determine some quantities for the legend
-nobs = sum(nobs_used);
-if ( nobs > 1 )
- mean_prior = mean(cg(isfinite(cg)));
- mean_post = mean(ca(isfinite(ca)));
+
+global figuredata verbose
+
+ax1 = subplot('position',figuredata.position);
+set(ax1,'YAxisLocation','left','FontSize',figuredata.fontsize)
+orient(figuredata.orientation)
+
+[hprior, prior_legstr] = plot_quantity('prior', plotdat);
+
+ges_Nposs = squeeze(plotdat.ges_Nposs(plotdat.region,:,:,:));
+ges_Nused = squeeze(plotdat.ges_Nused(plotdat.region,:,:,:));
+anl_Nused = squeeze(plotdat.anl_Nused(plotdat.region,:,:,:));
+anl_Ngood = sum(anl_Nused);
+
+if anl_Ngood
+ [hposte, poste_legstr] = plot_quantity('posterior', plotdat);
+ h = legend([hprior, hposte], prior_legstr, poste_legstr);
else
- mean_prior = NaN;
- mean_post = NaN;
+ h = legend(hprior,prior_legstr);
+ poste_legstr = [];
end
-string_guess = sprintf('forecast: mean=%.5g', mean_prior);
-string_analy = sprintf('analysis: mean=%.5g', mean_post);
-plotdat.subtitle = sprintf('%s %s',string_guess, string_analy);
+set(h,'Interpreter','none','Box','off','FontSize',figuredata.fontsize)
-% Plot the requested quantity on the left axis. This is the first
-% thing plotted to get the proper legend symbols in the easiest manner.
-% The observation count will use the axis on the right.
-% We want to suppress the 'auto' feature of the axis labelling,
-% so we manually set some values that normally
-% don't need to be set.
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+else
+ h.AutoUpdate = 'off';
+end
-ax1 = subplot('position',figdata.position);
-h1 = plot(tg,cg,'k+-',ta,ca,'ro-','LineWidth',figdata.linewidth);
-set(ax1,'YAxisLocation','left','FontSize',figdata.fontsize)
-h = legend(h1,'forecast', 'analysis');
-set(h,'Interpreter','none','Box','off','FontSize',figdata.fontsize)
+if verbose
+ fprintf('region %d %s level %d nobs_poss %d prior %d poste %d\n', ...
+ plotdat.region, plotdat.myvarname, plotdat.mylevel, ...
+ sum(ges_Nposs), sum(ges_Nused), anl_Ngood)
+ fprintf('region %d %s level %d %s %s\n\n', ...
+ plotdat.region, plotdat.myvarname, plotdat.mylevel, prior_legstr, poste_legstr)
+end
% Attempt to make plotting robust in the face of 'empty' bins.
-% There was one case where the observations were only at one time, but
-% obs_diag was run with multple bins. All the empty bins had NaN in them,
-% so matlab auto-ranged to the single time (+/-). Then along comes the
-% need to plot symbols for how many obs are possible (zero) and the axes
-% were a mess.
-% The 't' variable has all the temporal bins specified, so we use that
-% to determine the X axis limits. After we know them, we turn OFF the
-% bits (which normally causes the X axis limits revert) and manually
-% reinstate the full axis values.
-
-hdummy = line(t, ones(size(t)) * plotdat.Yrange);
-axlims = axis;
-set(hdummy,'Visible','off')
-axlims = [axlims(1:2) plotdat.Yrange];
+% The bincenters variable has all the temporal bins specified,
+% so we use that to determine the X axis limits.
+
+axlims = [min(plotdat.bincenters) max(plotdat.bincenters) plotdat.Yrange];
axis(axlims)
switch lower(plotdat.copystring)
case 'bias'
% plot a zero-bias line
- zeroline = line(axlims(1:2),[0 0], 'Color',[0 100 0]/255,'Parent',ax1);
+ zeroline = line(axlims(1:2),[0 0], 'Color',[200 200 200]/255,'Parent',ax1);
set(zeroline,'LineWidth',2.5,'LineStyle','-')
plotdat.ylabel = sprintf('%s (%s)',plotdat.copystring,plotdat.biasconv);
otherwise
plotdat.ylabel = sprintf('%s',plotdat.copystring);
end
-% hokey effort to decide to plot months/days vs. daynum vs.
-ttot = plotdat.bincenters(plotdat.Nbins) - plotdat.bincenters(1) + 1;
-
-if ((plotdat.bincenters(1) > 1000) && (ttot > 5))
- datetick('x',6,'keeplimits','keepticks');
- monstr = datestr(plotdat.bincenters(1),21);
- xlabelstring = sprintf('month/day - %s start',monstr);
-elseif (plotdat.bincenters(1) > 1000)
- datetick('x',15,'keeplimits')
- monstr = datestr(plotdat.bincenters(1),21);
- xlabelstring = sprintf('%s start',monstr);
-else
- xlabelstring = 'days';
-end
+% effort to use user-supplied value for time labelling or
+% make a stab at a useful default.
+
+xlabelstring = set_time_axis('x', plotdat.bincenters, figuredata.DateForm);
+
set(get(ax1,'Xlabel'),'String',xlabelstring, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
-title({plotdat.myregion, plotdat.title, plotdat.subtitle}, ...
- 'Interpreter', 'none', 'Fontsize', figdata.fontsize, 'FontWeight', 'bold')
+title({plotdat.myregion, plotdat.title}, ...
+ 'Interpreter', 'none', 'Fontsize', figuredata.fontsize, 'FontWeight', 'bold')
BottomAnnotation(plotdat)
% create a separate scale for the number of observations
@@ -471,14 +404,30 @@ function myplot(plotdat,figdata)
'XTick' ,get(ax1,'XTick'), ...
'YDir' ,get(ax1,'YDir'), ...
'Color' ,'none', ...
- 'YColor' ,'b', ...
+ 'YColor' ,figuredata.obs_color, ...
'XAxisLocation','top', ...
'YAxisLocation','right');
-h2 = line(t,nobs_poss,'Color','b','Parent',ax2);
-h3 = line(t,nobs_used,'Color','b','Parent',ax2);
-set(h2,'LineStyle','none','Marker','o');
-set(h3,'LineStyle','none','Marker','*');
+ax2h1 = line(plotdat.bincenters, ges_Nposs, 'Parent', ax2);
+ax2h2 = line(plotdat.bincenters, ges_Nused, 'Parent', ax2);
+
+set(ax2h1, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.obs_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+
+set(ax2h2, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.ges_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+
+if anl_Ngood > 0
+ ax2h3 = line(plotdat.bincenters, anl_Nused, 'Parent',ax2);
+ set(ax2h3, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.anl_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+end
% turn off topside X tick labels (clashes with title)
% use the same Y ticks, but find the right label values
@@ -486,9 +435,19 @@ function myplot(plotdat,figdata)
matchingYticks(ax1,ax2);
set(get(ax1,'Ylabel'), 'String', plotdat.ylabel, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
-set(get(ax2,'Ylabel'),'String','# of obs : o=possible, \ast=assimilated', ...
- 'FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
+
+% determine if the observation type was flagged as 'evaluate' or 'assimilate'
+% since we don't have the ability to specify this level-by-level or by
+% regions, we can use an 'all-or-nothing' approach.
+
+if sum(plotdat.ges_Neval(:)) > 0
+ string1 = ['# of obs: o=possible; \ast=evaluated' plotdat.post_string];
+else
+ string1 = ['# of obs: o=possible; \ast=assimilated' plotdat.post_string];
+end
+set(get(ax2,'Ylabel'), 'String', string1, 'FontSize', figuredata.fontsize)
+
%=====================================================================
@@ -530,6 +489,9 @@ function BottomAnnotation(main)
function [y,ydims] = FindTemporalVars(x)
%% Returns UNIQUE (i.e. base) temporal variable names
+
+global verbose
+
if ( ~(isfield(x,'allvarnames') && isfield(x,'allvardims')))
error('Doh! no ''allvarnames'' and ''allvardims'' components')
end
@@ -540,9 +502,8 @@ function BottomAnnotation(main)
indx = strfind(x.allvardims{i},'time');
if (indx > 0)
j = j + 1;
-
- basenames{j} = ReturnBase(x.allvarnames{i});
- basedims{ j} = x.allvardims{i};
+ basenames{j} = ReturnBase(x.allvarnames{i}); %#ok
+ basedims{ j} = x.allvardims{i}; %#ok
end
end
@@ -550,7 +511,7 @@ function BottomAnnotation(main)
y = cell(length(i),1);
ydims = cell(length(i),1);
for k = 1:length(i)
- fprintf('%2d is %s\n',k,basenames{i(k)})
+ if (verbose), fprintf('%3d is %s\n',k,basenames{i(k)}); end
y{k} = basenames{i(k)};
ydims{k} = basedims{ i(k)};
end
@@ -621,27 +582,6 @@ function BottomAnnotation(main)
%=====================================================================
-function figdata = setfigure()
-%%
-% figure out a page layout
-% extra space at the bottom for the date/file annotation
-% extra space at the top because the titles have multiple lines
-
-orientation = 'landscape';
-fontsize = 16;
-position = [0.10 0.15 0.8 0.7];
-linewidth = 2.0;
-
-figdata = struct('expcolors', {{'k','r','b','m','g','c','y'}}, ...
- 'expsymbols', {{'o','s','d','p','h','s','*'}}, ...
- 'prpolines', {{'-','--'}}, 'position', position, ...
- 'fontsize',fontsize, 'orientation',orientation, ...
- 'linewidth',linewidth);
-
-
-%=====================================================================
-
-
function value = local_ncread(fname,varname)
%% If the variable exists in the file, return the contents of the variable.
% if the variable does not exist, return empty value instead of error-ing
@@ -654,6 +594,48 @@ function BottomAnnotation(main)
value = [];
end
+%=====================================================================
+
+function [h, legstr] = plot_quantity(phase, plotdat)
+
+global figuredata
+
+switch lower(phase)
+ case 'prior'
+ data = squeeze(plotdat.ges_copy( plotdat.region,:,:,:));
+ Nused = squeeze(plotdat.ges_Nused(plotdat.region,:,:,:));
+ color = figuredata.ges_color;
+ marker = figuredata.marker1;
+ linestyle = figuredata.solid;
+ linewidth = figuredata.linewidth;
+ string1 = 'forecast:';
+ case 'posterior'
+ data = squeeze(plotdat.anl_copy( plotdat.region,:,:,:));
+ Nused = squeeze(plotdat.anl_Nused(plotdat.region,:,:,:));
+ color = figuredata.anl_color;
+ marker = figuredata.marker2;
+ linestyle = figuredata.solid;
+ linewidth = figuredata.linewidth;
+ string1 = 'analysis:';
+ otherwise
+ error('phase (%s) not supported',phase)
+end
+
+% Determine legend text
+if sum(Nused(:)) > 1
+ data_mean = mean(data(isfinite(data)));
+ legstr = sprintf('%s mean = %.5g', string1, data_mean);
+else
+ legstr = ' ';
+end
+
+h = line(plotdat.bincenters,data);
+set(h, 'LineStyle', linestyle, ...
+ 'LineWidth', linewidth, ...
+ 'Color', color, ...
+ 'Marker', marker, ...
+ 'MarkerFaceColor', color, ...
+ 'MarkerSize', figuredata.MarkerSize);
%
% $URL$
diff --git a/diagnostics/matlab/plot_profile.m b/diagnostics/matlab/plot_profile.m
index 1f16d0910f..3a53ab6c95 100644
--- a/diagnostics/matlab/plot_profile.m
+++ b/diagnostics/matlab/plot_profile.m
@@ -3,8 +3,8 @@
% Part of the observation-space diagnostics routines.
%
% 'obs_diag' produces a netcdf file containing the diagnostics.
-% obs_diag condenses the obs_seq.final information into summaries for a few specified
-% regions - on a level-by-level basis.
+% 'obs_diag' condenses the obs_seq.final information into summaries for a few
+% specified regions - on a level-by-level basis.
%
% The number of observations possible reflects only those observations
% that have incoming QC values of interest. Any observation with a DART
@@ -19,7 +19,7 @@
% For TRUSTED observations, this is different than the number used to calculate
% bias, rmse, spread, etc.
%
-% USAGE: plotdat = plot_profile(fname, copy);
+% USAGE: plotdat = plot_profile(fname, copy [,varargin]);
%
% fname : netcdf file produced by 'obs_diag'
%
@@ -27,10 +27,23 @@
% Possible values are available in the netcdf 'CopyMetaData' variable.
% (ncdump -v CopyMetaData obs_diag_output.nc)
%
-% obsname : Optional. If present, The strings of each observation type to plot.
+% varargin: optional parameter-value pairs. Supported parameters are described below.
+%
+% obsname : The strings of each observation type to plot.
% Each observation type will be plotted in a separate graphic.
% Default is to plot all available observation types.
%
+%
+% range : 'range' of the value being plotted. Default is to
+% automatically determine range based on the data values.
+%
+% verbose : true/false to control amount of run-time output
+%
+% MarkerSize : integer controlling the size of the symbols
+%
+% pause : true/false to conrol pausing after each figure is created.
+% true will require hitting any key to continue to next plot
+%
% OUTPUT: 'plotdat' is a structure containing what was plotted.
% A .pdf of each graphic is created. Each .pdf has a name that
% reflects the variable, quantity, and region being plotted.
@@ -45,7 +58,11 @@
%
% fname = 'obs_diag_output.nc';
% copy = 'totalspread';
-% plotdat = plot_profile(fname, copy, 'obsname', 'RADIOSONDE_TEMPERATURE');
+% obsname = 'RADIOSONDE_TEMPERATURE';
+% plotdat = plot_profile(fname, copy, 'obsname', obsname);
+%
+% EXAMPLE 3: You can tell it to be quiet, too.
+% plotdat = plot_profile(fname, copy, 'verbose', 'no');
%% DART software - Copyright UCAR. This open source software is provided
% by UCAR, "as is", without charge, subject to all terms of use at
@@ -57,29 +74,46 @@
% Decode,Parse,Check the input
%---------------------------------------------------------------------
-default_obsname = 'none';
+default_obsname = 'none';
+default_verbosity = true;
+default_markersize = 12;
+default_pause = false;
+default_range = [NaN NaN];
p = inputParser;
addRequired(p,'fname',@ischar);
addRequired(p,'copy',@ischar);
if (exist('inputParser/addParameter','file') == 2)
- addParameter(p,'obsname',default_obsname,@ischar);
+ addParameter(p,'obsname', default_obsname, @ischar);
+ addParameter(p,'verbose', default_verbosity, @islogical);
+ addParameter(p,'MarkerSize', default_markersize, @isnumeric);
+ addParameter(p,'pause', default_pause, @islogical);
+ addParameter(p,'range', default_range, @isnumeric);
else
- addParamValue(p,'obsname',default_obsname,@ischar);
+ addParamValue(p,'obsname', default_obsname, @ischar); %#ok
+ addParamValue(p,'verbose', default_verbosity, @islogical); %#ok
+ addParamValue(p,'MarkerSize',default_markersize, @isnumeric); %#ok
+ addParamValue(p,'pause', default_pause, @islogical); %#ok
+ addParamValue(p,'range', default_range, @isnumeric); %#ok
end
-
p.parse(fname, copy, varargin{:});
-% if you want to echo the input
-% disp(['fname : ', p.Results.fname])
-% disp(['copy : ', p.Results.copy])
-% disp(['obsname : ', p.Results.obsname])
-
if ~isempty(fieldnames(p.Unmatched))
disp('Extra inputs:')
disp(p.Unmatched)
end
+if (numel(p.Results.range) ~= 2)
+ error('range must be an array of length two ... [bottom top]')
+end
+
+if strcmp(p.Results.obsname,'none')
+ nvars = 0;
+else
+ obsname = p.Results.obsname;
+ nvars = 1;
+end
+
if (exist(fname,'file') ~= 2)
error('file/fname <%s> does not exist',fname)
end
@@ -88,79 +122,29 @@
% Harvest plotting info/metadata from netcdf file.
%---------------------------------------------------------------------
-plotdat.fname = fname;
-plotdat.copystring = copy;
-
-plotdat.binseparation = nc_read_att(fname, '/', 'bin_separation');
-plotdat.binwidth = nc_read_att(fname, '/', 'bin_width');
-time_to_skip = nc_read_att(fname, '/', 'time_to_skip');
-plotdat.lonlim1 = nc_read_att(fname, '/', 'lonlim1');
-plotdat.lonlim2 = nc_read_att(fname, '/', 'lonlim2');
-plotdat.latlim1 = nc_read_att(fname, '/', 'latlim1');
-plotdat.latlim2 = nc_read_att(fname, '/', 'latlim2');
-plotdat.biasconv = nc_read_att(fname, '/', 'bias_convention');
-
-plotdat.mlevel = local_ncread(fname, 'mlevel');
-plotdat.plevel = local_ncread(fname, 'plevel');
-plotdat.plevel_edges = local_ncread(fname, 'plevel_edges');
-plotdat.hlevel = local_ncread(fname, 'hlevel');
-plotdat.hlevel_edges = local_ncread(fname, 'hlevel_edges');
-plotdat.bincenters = ncread(fname, 'time');
-plotdat.binedges = ncread(fname, 'time_bounds');
-plotdat.region_names = strtrim(ncread(fname, 'region_names')');
-[plotdat.nregions,~] = nc_dim_info(fname,'region');
-
-% Coordinate between time types and dates
-
-timeunits = nc_read_att(fname,'time','units');
-timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
-timeorigin = datenum(timebase(1),timebase(2),timebase(3));
-timefloats = zeros(size(time_to_skip)); % stupid int32 type conversion
-timefloats(:) = time_to_skip(:);
-skip_seconds = timefloats(4)*3600 + timefloats(5)*60 + timefloats(6);
-iskip = timefloats(3) + skip_seconds/86400.0;
-
-% Set up a structure to use for plotting
-
-plotdat.bincenters = plotdat.bincenters + timeorigin;
-plotdat.binedges = plotdat.binedges + timeorigin;
-plotdat.Nbins = length(plotdat.bincenters);
-plotdat.toff = plotdat.binedges(1) + iskip;
-plotdat.timespan = sprintf('%s through %s', datestr(plotdat.toff), ...
- datestr(max(plotdat.binedges(:))));
-plotdat.xlabel = sprintf('%s',copy);
-
-[plotdat.allvarnames, plotdat.allvardims] = get_varsNdims(fname);
-[plotdat.varnames, plotdat.vardims] = FindVerticalVars(plotdat);
-
-plotdat.nvars = length(plotdat.varnames);
-plotdat.copyindex = get_copy_index(fname,copy);
-plotdat.Npossindex = get_copy_index(fname,'Nposs');
-plotdat.Nusedindex = get_copy_index(fname,'Nused');
-plotdat.NQC4index = get_copy_index(fname,'N_DARTqc_4');
-plotdat.NQC5index = get_copy_index(fname,'N_DARTqc_5');
-plotdat.NQC6index = get_copy_index(fname,'N_DARTqc_6');
-plotdat.NQC7index = get_copy_index(fname,'N_DARTqc_7');
-plotdat.NQC8index = get_copy_index(fname,'N_DARTqc_8');
-
-figuredata = setfigure();
-
-%%---------------------------------------------------------------------
-% Loop around (copy-level-region) observation types
-%----------------------------------------------------------------------
+plotdat = read_obsdiag_staticdata(fname,copy);
% Either use all the variables or just the one optionally specified.
-
-if strcmp(p.Results.obsname,'none')
- varlist = 1:plotdat.nvars;
+if (nvars == 0)
+ [plotdat.allvarnames, plotdat.allvardims] = get_varsNdims(fname);
+ [plotdat.varnames, plotdat.vardims] = FindVerticalVars(plotdat);
+ plotdat.nvars = length(plotdat.varnames);
else
- varlist = find (strcmpi(p.Results.obsname,plotdat.varnames));
- if isempty(varlist)
- error('%s is not in the list of observations',p.Results.obsname)
- end
+ plotdat.varnames{1} = obsname;
+ plotdat.nvars = nvars;
end
-for ivar = varlist
+global figuredata verbose
+
+figuredata = set_obsdiag_figure('tall');
+figuredata.MarkerSize = p.Results.MarkerSize;
+verbose = p.Results.verbose;
+
+%%---------------------------------------------------------------------
+% Loop around (copy-level-region) observation types
+%----------------------------------------------------------------------
+
+for ivar = 1:plotdat.nvars
% create the variable names of interest.
@@ -189,151 +173,119 @@
continue
end
- [level_org, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname, plotdat.guessvar);
- plotdat.level_org = level_org;
+ [levels, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname, plotdat.guessvar);
+ plotdat.levels = levels;
plotdat.level_units = level_units;
plotdat.nlevels = nlevels;
plotdat.level_edges = level_edges;
plotdat.Yrange = Yrange;
- % Matlab likes strictly ASCENDING order for things to be plotted,
- % then you can impose the direction. The data is stored in the original
- % order, so the sort indices are saved to reorder the data.
+ % Matlab likes strictly ASCENDING order for the axes and ticks,
+ % then you can impose the direction.
- if (plotdat.level_org(1) > plotdat.level_org(plotdat.nlevels))
+ if (plotdat.levels(1) > plotdat.levels(plotdat.nlevels))
plotdat.YDir = 'reverse';
else
plotdat.YDir = 'normal';
end
- % Add error-checking for output from older versions of obs_diag.
+ [levels, ~] = sort(plotdat.levels);
+ plotdat.YTick = unique(levels);
- [levels, indices] = sort(plotdat.level_org);
- plotdat.level = unique(levels);
- if (length(plotdat.level) ~= length(levels))
+ % Add error-checking for output from older versions of obs_diag.
+ if (length(plotdat.YTick) ~= length(plotdat.levels))
error('There is a duplicated value in the array specifying the levels - must change your input.nml and rerun obs_diag')
end
- plotdat.indices = indices;
level_edges = sort(plotdat.level_edges);
plotdat.level_edges = level_edges;
- % The rest of this script was written for the third-party netcdf
- % support. Matlab's native ncread transposes the variables, so I have to
- % permute them back to the expected storage order.
+ % guess(nregions,nlevels,ncopies)
guess = ncread(fname, plotdat.guessvar);
- analy = ncread(fname, plotdat.analyvar);
- rank = length(size(guess));
- guess = permute(guess,rank:-1:1);
- analy = permute(analy,rank:-1:1);
-
- % singleton dimensions are auto-squeezed - which is unfortunate.
- % We want these things to be 3D. [copy-level-region]
-
- if ( plotdat.nlevels == 1 )
- bob(:,1,:) = guess;
- ted(:,1,:) = analy;
- guess = bob; clear bob
- analy = ted; clear ted
+ analy = local_ncread(fname, plotdat.analyvar);
+ if (isempty(analy))
+ analy = guess; % make the variable the same shape as guess
+ analy(:) = NaN; % and fill it with nothing
+ plotdat.has_analysis = false;
+ plotdat.post_string = '';
+ else
+ plotdat.has_analysis = true;
+ plotdat.post_string = '; \diamondsuit=posteriorOK';
end
% check to see if there is anything to plot
% The number possible is decreased by the number of observations
% rejected by namelist control.
- fprintf('\n')
- fprintf('%10d %s observations had DART QC of 4 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC4index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 5 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC5index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 6 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC6index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 7 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC7index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 8 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC8index, :,:))),plotdat.myvarname)
+ priorQCs = get_qc_values(fname, plotdat.guessvar, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
- nposs = sum(guess(plotdat.Npossindex,:,:)) - ...
- sum(guess(plotdat.NQC5index ,:,:)) - ...
- sum(guess(plotdat.NQC6index ,:,:));
+ plotdat.ges_Neval = priorQCs.num_evaluated;
+ plotdat.ges_Nposs = priorQCs.nposs;
+ plotdat.ges_Nused = priorQCs.nused;
+ plotdat.ges_copy = guess(:,:,plotdat.copyindex);
- if ( sum(nposs(:)) < 1 )
- fprintf('No obs for %s... skipping\n', plotdat.varnames{ivar})
+ if ( sum(plotdat.ges_Nposs(:)) < 1 )
+ fprintf('no obs for %s... skipping\n', plotdat.varnames{ivar})
continue
end
- plotdat.ges_copy = guess(plotdat.copyindex, :, :);
- plotdat.anl_copy = analy(plotdat.copyindex, :, :);
- plotdat.ges_Nqc4 = guess(plotdat.NQC4index, :, :);
- plotdat.anl_Nqc4 = analy(plotdat.NQC4index, :, :);
- plotdat.ges_Nqc5 = guess(plotdat.NQC5index, :, :);
- plotdat.anl_Nqc5 = analy(plotdat.NQC5index, :, :);
- plotdat.ges_Nqc6 = guess(plotdat.NQC6index, :, :);
- plotdat.anl_Nqc6 = analy(plotdat.NQC6index, :, :);
- plotdat.ges_Nqc7 = guess(plotdat.NQC7index, :, :);
- plotdat.anl_Nqc7 = analy(plotdat.NQC7index, :, :);
- plotdat.ges_Nqc8 = guess(plotdat.NQC8index, :, :);
- plotdat.anl_Nqc8 = analy(plotdat.NQC8index, :, :);
-
- plotdat.ges_Nused = guess(plotdat.Nusedindex, :, :);
- plotdat.anl_Nused = guess(plotdat.Nusedindex, :, :);
- plotdat.ges_Nposs = guess(plotdat.Npossindex, :, :) - ...
- plotdat.ges_Nqc5 - plotdat.ges_Nqc6;
- plotdat.anl_Nposs = analy(plotdat.Npossindex, :, :) - ...
- plotdat.anl_Nqc5 - plotdat.anl_Nqc6;
+ if (plotdat.has_analysis)
+ posteQCs = get_qc_values(fname, plotdat.analyvar, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
+ plotdat.anl_Nused = posteQCs.nused;
+ plotdat.anl_copy = analy(:,:,plotdat.copyindex);
+ else
+ plotdat.anl_Nused = zeros(size(plotdat.ges_Nused));
+ plotdat.anl_copy = plotdat.ges_copy; % needed for determining limits
+ end
+
+ % call report_qc_values.m
+
plotdat.Xrange = FindRange(plotdat);
% plot by region - each in its own figure.
for iregion = 1:plotdat.nregions
- figure(iregion); clf(iregion); orient(figuredata.orientation); wysiwyg
+ figure(iregion);
+ clf(iregion);
+ orient(figuredata.orientation);
plotdat.region = iregion;
plotdat.myregion = deblank(plotdat.region_names(iregion,:));
- myplot(plotdat, figuredata);
+
+ myplot(plotdat);
+
BottomAnnotation(fname)
- psfname = sprintf('%s_%s_profile_region%d', plotdat.varnames{ivar}, ...
- plotdat.copystring, iregion);
- print(gcf,'-dpdf',psfname);
+ psfname = sprintf('%s_%s_profile_region%d', ...
+ plotdat.varnames{ivar}, plotdat.copystring, iregion);
+
+ if verLessThan('matlab','R2016a')
+ print(gcf, '-dpdf', psfname);
+ else
+ print(gcf, '-dpdf', '-bestfit', psfname);
+ end
+
+ % block to go slow and look at each one ...
+ if (p.Results.pause)
+ disp('Pausing, hit any key to continue ...')
+ pause
+ end
+
end
-
end
-
%=====================================================================
% 'Helper' functions
%=====================================================================
-function myplot(plotdat,figdata)
-
-%% Interlace the [ges,anl] to make a sawtooth plot.
-% By this point, the middle two dimensions are singletons.
-% The data must be sorted to match the order of the levels.
-cg = plotdat.ges_copy(:,:,plotdat.region); CG = cg(plotdat.indices);
-ca = plotdat.anl_copy(:,:,plotdat.region); CA = ca(plotdat.indices);
-
-g = plotdat.ges_Nposs(:,:,plotdat.region); G = g(plotdat.indices);
-a = plotdat.anl_Nposs(:,:,plotdat.region); A = a(plotdat.indices);
-nobs_poss = G;
-
-g = plotdat.ges_Nused(:,:,plotdat.region); G = g(plotdat.indices);
-a = plotdat.anl_Nused(:,:,plotdat.region); A = a(plotdat.indices);
-nobs_used = G;
-
-% Determine some quantities for the legend
-nobs = sum(nobs_used);
-if ( nobs > 1 )
- other_guess = mean(CG(isfinite(CG)));
- other_analy = mean(CA(isfinite(CA)));
-else
- other_guess = NaN;
- other_analy = NaN;
-end
+function myplot(plotdat)
-str_other_pr = sprintf('%s pr=%.5g',plotdat.copystring,other_guess);
-str_other_po = sprintf('%s po=%.5g',plotdat.copystring,other_analy);
+%% The prior and posterior are plotted as separate items.
% Plot 'xxx' on the bottom axis.
% The observation count will use the axis on the top.
@@ -341,33 +293,61 @@ function myplot(plotdat,figdata)
% axis labelling, so we manually set some values that normally
% don't need to be set.
-ax1 = subplot('position',figdata.position);
+global figuredata verbose
+
+ax1 = subplot('position',figuredata.position);
+orient(figuredata.orientation)
% add type of vertical coordinate info for adjusting axes to accomodate legend
Stripes(plotdat.Xrange, plotdat.level_edges, plotdat.level_units);
-set(ax1, 'YDir', plotdat.YDir, 'YTick', plotdat.level, 'Layer', 'top')
-set(ax1,'YAxisLocation','left','FontSize',figdata.fontsize)
+set(ax1, 'YDir', plotdat.YDir, 'YTick', plotdat.YTick, 'Layer', 'top')
+set(ax1,'YAxisLocation','left','FontSize',figuredata.fontsize)
% draw the result of the experiment
-hold on;
-h1 = plot(CG,plotdat.level,'k+-',CA,plotdat.level,'k+--');
-set(h1,'LineWidth',figdata.linewidth);
-hold off;
+[hprior, prior_legstr] = plot_quantity('prior', plotdat);
+
+ges_Nposs = plotdat.ges_Nposs(plotdat.region,:);
+ges_Nused = plotdat.ges_Nused(plotdat.region,:);
+anl_Nused = plotdat.anl_Nused(plotdat.region,:);
+anl_Ngood = sum(anl_Nused);
+
+if verbose
+ fprintf('region %d %s nobs_poss %d prior %d poste %d\n', ...
+ plotdat.region, plotdat.myvarname, ...
+ sum(ges_Nposs), sum(ges_Nused), anl_Ngood)
+ fprintf('region %d %s\n\n', plotdat.region, prior_legstr)
+end
+
+if anl_Ngood > 0
+ [hposte, poste_legstr] = plot_quantity('posterior', plotdat);
+ h = legend([hprior, hposte], prior_legstr, poste_legstr);
+else
+ h = legend(hprior,prior_legstr);
+end
+
+set(h,'Interpreter','none','Box','off','Location','NorthWest')
+
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+else
+ h.AutoUpdate = 'off';
+end
switch plotdat.copystring
case {'bias'}
- zeroline = line([0 0],plotdat.Yrange,'Color',[0 100 0]/255,'Parent',ax1);
+ zeroline = line([0 0],plotdat.Yrange,'Color',[200 200 200]/255,'Parent',ax1);
set(zeroline,'LineWidth',2.5,'LineStyle','-')
plotdat.xlabel = sprintf('%s (%s)',plotdat.copystring, plotdat.biasconv);
otherwise
+ plotdat.xlabel = plotdat.copystring;
end
-h = legend(h1, str_other_pr, str_other_po, 'Location', 'NorthWest');
-set(h,'Interpreter','none','Box','off')
-
% If the observation is trusted, reference that somehow
+
switch lower(plotdat.trusted)
case 'true'
axlims = axis;
@@ -388,16 +368,32 @@ function myplot(plotdat,figdata)
'XAxisLocation','top', ...
'YAxisLocation','right', ...
'Color','none', ...
- 'XColor','b', ...
+ 'XColor',figuredata.obs_color, ...
'YColor',get(ax1,'YColor'), ...
'YLim',get(ax1,'YLim'), ...
'YDir',get(ax1,'YDir'), ...
'FontSize',get(ax1,'FontSize'));
-h2 = line(nobs_poss,plotdat.level,'Color','b','Parent',ax2);
-h3 = line(nobs_used,plotdat.level,'Color','b','Parent',ax2);
-set(h2,'LineStyle','none','Marker','o');
-set(h3,'LineStyle','none','Marker','*');
+ax2h1 = line(ges_Nposs, plotdat.levels, 'Parent', ax2);
+ax2h2 = line(ges_Nused, plotdat.levels, 'Parent', ax2);
+
+set(ax2h1, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.obs_marker, ...
+ 'MarkerSize', figuredata.MarkerSize);
+
+set(ax2h2, 'LineStyle', 'none', ...
+ 'Color', figuredata.ges_color, ...
+ 'Marker', figuredata.ges_marker, ...
+ 'MarkerSize', figuredata.MarkerSize);
+
+if anl_Ngood > 0
+ ax2h3 = line(anl_Nused, plotdat.levels, 'Parent',ax2);
+ set(ax2h3, 'LineStyle', 'none', ...
+ 'Color', figuredata.anl_color, ...
+ 'Marker', figuredata.anl_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+end
% use same Y ticks - but no labels.
set(ax2,'YTick',get(ax1,'YTick'), 'YTicklabel',[]);
@@ -406,14 +402,24 @@ function myplot(plotdat,figdata)
xscale = matchingXticks(ax1,ax2);
set(get(ax1,'Ylabel'),'String',plotdat.level_units, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
set(get(ax1,'Xlabel'),'String',{plotdat.xlabel, plotdat.timespan}, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
-set(get(ax2,'Xlabel'),'String', ...
- ['# of obs (o=possible, \ast=assimilated) x' int2str(uint32(xscale))],'FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
+
+% determine if the observation was flagged as 'evaluate' or 'assimilate'
+
+if sum(plotdat.ges_Neval(plotdat.region,:)) > 0
+ string1 = sprintf('# of obs (o=possible; %s %s) x %d', ...
+ '\ast=evaluated', plotdat.post_string, uint32(xscale));
+else
+ string1 = sprintf('# of obs (o=possible; %s %s) x %d', ...
+ '\ast=assimilated', plotdat.post_string, uint32(xscale));
+end
+
+set(get(ax2,'Xlabel'), 'String', string1, 'FontSize', figuredata.fontsize)
title({plotdat.myregion, plotdat.myvarname}, ...
- 'Interpreter', 'none', 'FontSize', figdata.fontsize, 'FontWeight', 'bold')
+ 'Interpreter', 'none', 'FontSize', figuredata.fontsize, 'FontWeight', 'bold')
%=====================================================================
@@ -446,6 +452,8 @@ function BottomAnnotation(main)
% In this context, if the variable has a 'time' dimension
% it cannot be a variable of interest.
+global verbose
+
if ( ~(isfield(x,'allvarnames') && isfield(x,'allvardims')))
error('Doh! no ''allvarnames'' and ''allvardims'' components')
end
@@ -456,7 +464,7 @@ function BottomAnnotation(main)
for i = 1:length(x.allvarnames)
dimnames = lower(x.allvardims{i});
- if (isempty(strfind(dimnames,'time')))
+ if (isempty(strfind(dimnames,'time'))) %#ok
platform = ReturnBase(x.allvarnames{i});
if (~ isempty(platform))
j = j + 1;
@@ -471,7 +479,7 @@ function BottomAnnotation(main)
ydims = struct([]);
for k = 1:length(i)
- fprintf('%2d is %s\n',k,basenames{i(k)})
+ if (verbose), fprintf('%3d is %s\n',k,basenames{i(k)}); end
y{k} = basenames{i(k)};
ydims{k} = basedims{i(k)};
end
@@ -480,7 +488,7 @@ function BottomAnnotation(main)
%=====================================================================
-function [level_org, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname,varname)
+function [levels, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname,varname)
%% Find the vertical dimension and harvest some info
varinfo = ncinfo(fname,varname);
@@ -495,7 +503,7 @@ function BottomAnnotation(main)
error('There is no level information for %s in %s',varname,fname)
end
-level_org = ncread( fname,varinfo.Dimensions(leveldim).Name);
+levels = ncread( fname,varinfo.Dimensions(leveldim).Name);
level_units = ncreadatt(fname,varinfo.Dimensions(leveldim).Name,'units');
nlevels = varinfo.Size(leveldim);
edgename = sprintf('%s_edges',varinfo.Dimensions(leveldim).Name);
@@ -629,7 +637,7 @@ function BottomAnnotation(main)
hold on;
for i = 1:2:(length(edges)-1)
yc = [ edges(i) edges(i) edges(i+1) edges(i+1) edges(i) ];
- hf = fill(xc,yc,[0.8 0.8 0.8],'EdgeColor','none');
+ fill(xc,yc,[0.8 0.8 0.8],'EdgeColor','none');
end
hold off;
@@ -640,39 +648,61 @@ function BottomAnnotation(main)
%=====================================================================
-function figdata = setfigure()
-%%
-% figure out a page layout
-% extra space at the bottom for the date/file annotation
-% extra space at the top because the titles have multiple lines
-
-orientation = 'tall';
-fontsize = 16;
-position = [0.15 0.12 0.7 0.75];
-linewidth = 2.0;
-
-figdata = struct('expcolors', {{'k','r','b','m','g','c','y'}}, ...
- 'expsymbols', {{'o','s','d','p','h','s','*'}}, ...
- 'prpolines', {{'-','--'}}, 'position', position, ...
- 'fontsize',fontsize, 'orientation',orientation, ...
- 'linewidth',linewidth);
-
-
-%=====================================================================
-
-
function value = local_ncread(fname,varname)
%% If the variable exists in the file, return the contents of the variable.
% if the variable does not exist, return empty value instead of error-ing
% out.
-[variable_present, varid] = nc_var_exists(fname,varname);
+[variable_present, ~] = nc_var_exists(fname,varname);
if (variable_present)
value = ncread(fname, varname);
else
value = [];
end
+%=====================================================================
+
+function [h, legstr] = plot_quantity(phase, plotdat)
+
+global figuredata
+
+switch lower(phase)
+ case 'prior'
+ data = plotdat.ges_copy( plotdat.region,:);
+ Nused = plotdat.ges_Nused(plotdat.region,:);
+ color = figuredata.ges_color;
+ marker = figuredata.marker1;
+ linestyle = figuredata.solid;
+ linewidth = figuredata.linewidth;
+ string1 = 'forecast:';
+ case 'posterior'
+ data = plotdat.anl_copy( plotdat.region,:);
+ Nused = plotdat.anl_Nused(plotdat.region,:);
+ color = figuredata.anl_color;
+ marker = figuredata.marker2;
+ linestyle = figuredata.solid;
+ linewidth = figuredata.linewidth;
+ string1 = 'analysis:';
+ otherwise
+ error('phase (%s) not supported',phase)
+end
+
+% Determine legend text
+nobs = sum(Nused);
+if ( nobs > 1 )
+ data_mean = mean(data(isfinite(data)));
+ legstr = sprintf('%s mean= %.5g', string1, data_mean);
+else
+ legstr = ' ';
+end
+
+h = line(data, plotdat.levels);
+set(h, 'LineStyle', linestyle, ...
+ 'LineWidth', linewidth, ...
+ 'Color', color, ...
+ 'Marker', marker, ...
+ 'MarkerFaceColor', color, ...
+ 'MarkerSize', figuredata.MarkerSize);
%
% $URL$
diff --git a/diagnostics/matlab/plot_rank_histogram.m b/diagnostics/matlab/plot_rank_histogram.m
index 6a2ad8588d..64306a2fd8 100644
--- a/diagnostics/matlab/plot_rank_histogram.m
+++ b/diagnostics/matlab/plot_rank_histogram.m
@@ -60,6 +60,10 @@
error('wrong number of arguments ... ')
end
+%TODO actually implement the varargin ... should be able to specify a
+% specific region or level
+
+
% Make sure the file exists.
if (exist(fname,'file') ~= 2)
@@ -152,7 +156,7 @@
plotdat.NQC5index = get_copy_index(fname,'N_DARTqc_5');
plotdat.NQC6index = get_copy_index(fname,'N_DARTqc_6');
plotdat.NQC7index = get_copy_index(fname,'N_DARTqc_7');
-plotdat.NQC8index = get_copy_index(fname,'N_DARTqc_8');
+plotdat.NQC8index = get_copy_index(fname,'N_DARTqc_8','fatal',false);
figuredata = setfigure();
@@ -162,42 +166,42 @@
psfname = cell(plotdat.nvars);
for ivar = 1:plotdat.nvars
-
+
% create the variable names of interest.
% netCDF can only support variable names less than 41 chars.
-
+
plotdat.myvarname = plotdat.varnames{ivar};
plotdat.guessvar = sprintf('%s_guess',plotdat.varnames{ivar});
-
+
plotdat.rhistvar = BuildFullVarname(plotdat.varnames{ivar});
-
+
[present, ~] = nc_var_exists(fname, plotdat.rhistvar);
if ( ~ present )
fprintf('Could not find %s in %s ... skipping\n',plotdat.rhistvar, fname)
continue
end
-
+
% remove any existing postscript file - will simply append each
% level as another 'page' in the .ps file.
-
+
for iregion = 1:plotdat.nregions
psfname{iregion} = sprintf('%s_rank_hist_region%d.ps',plotdat.varnames{ivar},iregion);
fprintf('Removing %s from the current directory.\n',psfname{iregion})
system(sprintf('rm %s',psfname{iregion}));
end
-
+
% remove any existing log file -
-
+
lgfname = sprintf('%s_rank_hist_obscount.txt',plotdat.varnames{ivar});
fprintf('Removing %s from the current directory.\n',lgfname)
system(sprintf('rm %s',lgfname));
logfid = fopen(lgfname,'wt');
fprintf(logfid,'%s\n',lgfname);
-
+
% get appropriate vertical coordinate variable
-
+
[dimnames, ~] = nc_var_dims(fname, plotdat.guessvar);
-
+
if ( dimensionality == 1 ) % observations on a unit circle, no level
plotdat.level = 1;
plotdat.level_units = [];
@@ -212,70 +216,72 @@
plotdat.level_units = nc_read_att(fname, dimnames{2}, 'units');
end
plotdat.nlevels = length(plotdat.level);
-
+
% Here is the tricky part. Singleton dimensions are auto-squeezed ...
% single levels, single regions ...
-
+
guess_raw = ncread(fname, plotdat.guessvar);
guess_raw = permute(guess_raw,length(size(guess_raw)):-1:1);
guess = reshape(guess_raw, plotdat.Ntimes, plotdat.ncopies, ...
plotdat.nlevels, plotdat.nregions);
-
+
rhist_raw = ncread(fname, plotdat.rhistvar);
rhist_raw = permute(rhist_raw,length(size(rhist_raw)):-1:1);
rhist = reshape(rhist_raw, plotdat.Ntimes, plotdat.Nrhbins, ...
plotdat.nlevels, plotdat.nregions);
-
+
% Collapse the time dimension if need be.
% >@todo TJH FIXME ... this should honor the time_to_skip ...
-
+
if ( timeindex < 0 )
guess = sum(guess,1);
rhist = sum(rhist,1);
plotdat.timeindex = 1;
end
-
+
% check to see if there is anything to plot
nposs = sum(guess(plotdat.timeindex,plotdat.Npossindex,:,:)) - ...
sum(guess(plotdat.timeindex,plotdat.NQC5index ,:,:)) - ...
sum(guess(plotdat.timeindex,plotdat.NQC6index ,:,:));
-
+
if ( sum(nposs(:)) < 1 )
fprintf('no obs for %s ... skipping\n', plotdat.varnames{ivar})
continue
end
-
+
for ilevel = 1:plotdat.nlevels
-
+
fprintf(logfid,'\nlevel %d %f %s\n',ilevel,plotdat.level(ilevel),plotdat.level_units);
-
+
plotdat.ges_Nqc4 = squeeze(guess(plotdat.timeindex,plotdat.NQC4index ,ilevel,:));
fprintf(logfid,'DART QC == 4, prior %d\n',sum(plotdat.ges_Nqc4(:)));
-
+
plotdat.ges_Nqc5 = squeeze(guess(plotdat.timeindex,plotdat.NQC5index ,ilevel,:));
fprintf(logfid,'DART QC == 5, prior %d\n',sum(plotdat.ges_Nqc5(:)));
-
+
plotdat.ges_Nqc6 = squeeze(guess(plotdat.timeindex,plotdat.NQC6index ,ilevel,:));
fprintf(logfid,'DART QC == 6, prior %d\n',sum(plotdat.ges_Nqc6(:)));
-
+
plotdat.ges_Nqc7 = squeeze(guess(plotdat.timeindex,plotdat.NQC7index ,ilevel,:));
fprintf(logfid,'DART QC == 7, prior %d\n',sum(plotdat.ges_Nqc7(:)));
- plotdat.ges_Nqc8 = squeeze(guess(plotdat.timeindex,plotdat.NQC8index ,ilevel,:));
- fprintf(logfid,'DART QC == 8, prior %d\n',sum(plotdat.ges_Nqc8(:)));
-
+ if (plotdat.NQC8index > 0)
+ plotdat.ges_Nqc8 = squeeze(guess(plotdat.timeindex,plotdat.NQC8index ,ilevel,:));
+ fprintf(logfid,'DART QC == 8, prior %d\n',sum(plotdat.ges_Nqc8(:)));
+ end
+
plotdat.ges_Nposs = squeeze(guess(plotdat.timeindex,plotdat.Npossindex, ilevel,:)) ...
- plotdat.ges_Nqc5 - plotdat.ges_Nqc6;
fprintf(logfid,'# obs poss, prior %d\n',sum(plotdat.ges_Nposs(:)));
-
+
plotdat.ges_Nused = squeeze(guess(plotdat.timeindex,plotdat.Nusedindex, ilevel,:));
fprintf(logfid,'# obs used, prior %d\n',sum(plotdat.ges_Nused(:)));
-
+
% plot by region
-
+
for iregion = 1:plotdat.nregions
- figure(iregion); clf; orient(figuredata.orientation); wysiwyg
-
+ figure(iregion); clf; orient(figuredata.orientation);
+
plotdat.region = iregion;
plotdat.myregion = deblank(plotdat.region_names(iregion,:));
if ( isempty(plotdat.level_units) )
@@ -286,14 +292,14 @@
plotdat.level(ilevel), ...
plotdat.level_units);
end
-
+
plotdat.rank_hist = squeeze(rhist(plotdat.timeindex, :, ilevel,iregion));
-
+
myplot(plotdat,figuredata);
-
+
% create a postscript file
print(gcf,'-dpsc','-append',psfname{iregion});
-
+
% block to go slow and look at each one ...
% disp('Pausing, hit any key to continue ...')
% pause
@@ -387,7 +393,7 @@ function BottomAnnotation(main)
indx = strfind(x.allvardims{i},'time');
if (indx > 0)
j = j + 1;
-
+
basenames{j} = ReturnBase(x.allvarnames{i});
basedims{j} = x.allvardims{i};
end
diff --git a/diagnostics/matlab/plot_rmse_xxx_evolution.m b/diagnostics/matlab/plot_rmse_xxx_evolution.m
index 7ed9fb2d84..0ef6777d49 100644
--- a/diagnostics/matlab/plot_rmse_xxx_evolution.m
+++ b/diagnostics/matlab/plot_rmse_xxx_evolution.m
@@ -3,8 +3,8 @@
% Part of the observation-space diagnostics routines.
%
% 'obs_diag' produces a netcdf file containing the diagnostics.
-% obs_diag condenses the obs_seq.final information into summaries for a few specified
-% regions - on a level-by-level basis.
+% 'obs_diag' condenses the obs_seq.final information into summaries for a few
+% specified regions - on a level-by-level basis.
%
% The number of observations possible reflects only those observations
% that have incoming QC values of interest. Any observation with a DART
@@ -19,23 +19,36 @@
% For TRUSTED observations, this is different than the number used to calculate
% bias, rmse, spread, etc.
%
-% USAGE: plotdat = plot_evolution(fname, copy);
+% USAGE: plotdat = plot_rmse_xxx_evolution(fname, copy [,varargin]);
%
% fname : netcdf file produced by 'obs_diag'
%
% copy : string defining the metric of interest. 'rmse', 'spread', etc.
% Possible values are available in the netcdf 'CopyMetaData' variable.
-% (ncdump -v CopyMetaData obs_diag_output.nc)%
+% (ncdump -v CopyMetaData obs_diag_output.nc)
%
-% obsname : Optional. If present, The strings of each observation type to plot.
+% varargin: optional parameter-value pairs. Supported parameters are described below.
+%
+% obsname : The strings of each observation type to plot.
% Each observation type will be plotted in a separate graphic.
% Default is to plot all available observation types.
%
-% level : Optional. 'level' index. Default is to plot all levels.
+% level : 'level' index. Default is to plot all levels.
%
-% range : Optional. 'range' of the value being plotted. Default is to
+% range : 'range' of the value being plotted. Default is to
% automatically determine range based on the data values.
%
+% verbose : true/false to control amount of run-time output
+%
+% MarkerSize : integer controlling the size of the symbols
+%
+% DateForm : Free-form character string controlling representation of the time axis.
+% See 'help datetick' for discussion and valid values.
+% Example ones are 'mm/dd' and 'dd HH:MM'.
+%
+% pause : true/false to conrol pausing after each figure is created.
+% true will require hitting any key to continue to next plot
+%
% OUTPUT: 'plotdat' is a structure containing what was last plotted.
% A postscript file containing a page for each level - each region.
% The other file is a simple text file containing summary information
@@ -71,31 +84,36 @@
%
% DART $Id$
-default_level = -1;
-default_obsname = 'none';
-default_range = [NaN NaN];
+default_obsname = 'none';
+default_verbosity = true;
+default_markersize = 12;
+default_pause = false;
+default_range = [NaN NaN];
+default_level = -1;
+default_dateform = 'default';
p = inputParser;
addRequired(p,'fname',@ischar);
addRequired(p,'copy',@ischar);
if (exist('inputParser/addParameter','file') == 2)
- addParameter(p,'obsname',default_obsname,@ischar);
- addParameter(p,'range',default_range,@isnumeric);
- addParameter(p,'level',default_level,@isnumeric);
+ addParameter(p,'obsname', default_obsname, @ischar);
+ addParameter(p,'verbose', default_verbosity, @islogical);
+ addParameter(p,'MarkerSize', default_markersize, @isnumeric);
+ addParameter(p,'pause', default_pause, @islogical);
+ addParameter(p,'range', default_range, @isnumeric);
+ addParameter(p,'level', default_level, @isnumeric);
+ addParameter(p,'DateForm', default_dateform, @ischar);
else
- addParamValue(p,'obsname',default_obsname,@ischar);
- addParamValue(p,'range',default_range,@isnumeric);
- addParamValue(p,'level',default_level,@isnumeric);
+ addParamValue(p,'obsname', default_obsname, @ischar); %#ok
+ addParamValue(p,'verbose', default_verbosity, @islogical); %#ok
+ addParamValue(p,'MarkerSize',default_markersize, @isnumeric); %#ok
+ addParamValue(p,'pause', default_pause, @islogical); %#ok
+ addParamValue(p,'range', default_range, @isnumeric); %#ok
+ addParamValue(p,'level', default_level, @isnumeric); %#ok
+ addParamValue(p,'DateForm', default_dateform, @ischar); %#ok
end
p.parse(fname, copy, varargin{:});
-% if you want to echo the input
-% fprintf('fname : %s\n', p.Results.fname)
-% fprintf('copy : %s\n', p.Results.copy)
-% fprintf('obsname : %s\n', p.Results.obsname)
-% fprintf('level : %d\n', p.Results.level)
-% fprintf('range : %f %f \n', p.Results.range)
-
if ~isempty(fieldnames(p.Unmatched))
disp('Extra inputs:')
disp(p.Unmatched)
@@ -120,50 +138,7 @@
% Harvest plotting info/metadata from netcdf file.
%---------------------------------------------------------------------
-plotdat.fname = fname;
-plotdat.copystring = copy;
-plotdat.bincenters = ncread(fname,'time');
-plotdat.binedges = ncread(fname,'time_bounds');
-plotdat.mlevel = local_ncread(fname,'mlevel');
-plotdat.plevel = local_ncread(fname,'plevel');
-plotdat.plevel_edges = local_ncread(fname,'plevel_edges');
-plotdat.hlevel = local_ncread(fname,'hlevel');
-plotdat.hlevel_edges = local_ncread(fname,'hlevel_edges');
-[plotdat.ncopies, ~] = nc_dim_info(fname,'copy');
-[plotdat.nregions, ~] = nc_dim_info(fname,'region');
-plotdat.region_names = strtrim(ncread(fname,'region_names')');
-
-dimensionality = nc_read_att(fname, '/', 'LocationRank');
-plotdat.binseparation = nc_read_att(fname, '/', 'bin_separation');
-plotdat.binwidth = nc_read_att(fname, '/', 'bin_width');
-time_to_skip = nc_read_att(fname, '/', 'time_to_skip');
-plotdat.lonlim1 = nc_read_att(fname, '/', 'lonlim1');
-plotdat.lonlim2 = nc_read_att(fname, '/', 'lonlim2');
-plotdat.latlim1 = nc_read_att(fname, '/', 'latlim1');
-plotdat.latlim2 = nc_read_att(fname, '/', 'latlim2');
-plotdat.biasconv = nc_read_att(fname, '/', 'bias_convention');
-
-% Coordinate between time types and dates
-
-calendar = nc_read_att(fname,'time','calendar');
-timeunits = nc_read_att(fname,'time','units');
-timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
-timeorigin = datenum(timebase(1),timebase(2),timebase(3));
-if ( isempty(time_to_skip) == 1)
- iskip = 0;
-elseif ( numel(time_to_skip) == 6)
- skip_seconds = time_to_skip(4)*3600 + time_to_skip(5)*60 + time_to_skip(6);
- iskip = time_to_skip(3) + skip_seconds/86400;
-else
- error('time_to_skip variable has unusual length. Should be either 0 or 6.')
-end
-
-% set up a structure with all static plotting components
-
-plotdat.bincenters = plotdat.bincenters + timeorigin;
-plotdat.binedges = plotdat.binedges + timeorigin;
-plotdat.Nbins = length(plotdat.bincenters);
-plotdat.toff = plotdat.bincenters(1) + iskip;
+plotdat = read_obsdiag_staticdata(fname,copy);
if (nvars == 0)
[plotdat.allvarnames, plotdat.allvardims] = get_varsNdims(fname);
@@ -174,21 +149,17 @@
plotdat.nvars = nvars;
end
-plotdat.copyindex = get_copy_index(fname,copy);
-plotdat.rmseindex = get_copy_index(fname,'rmse');
-plotdat.Npossindex = get_copy_index(fname,'Nposs');
-plotdat.Nusedindex = get_copy_index(fname,'Nused');
-plotdat.NQC4index = get_copy_index(fname,'N_DARTqc_4');
-plotdat.NQC5index = get_copy_index(fname,'N_DARTqc_5');
-plotdat.NQC6index = get_copy_index(fname,'N_DARTqc_6');
-plotdat.NQC7index = get_copy_index(fname,'N_DARTqc_7');
-plotdat.NQC8index = get_copy_index(fname,'N_DARTqc_8');
+global figuredata verbose
-figuredata = setfigure();
+figuredata = set_obsdiag_figure('landscape');
+figuredata.MarkerSize = p.Results.MarkerSize;
+figuredata.DateForm = p.Results.DateForm;
+verbose = p.Results.verbose;
%%---------------------------------------------------------------------
% Loop around (time-copy-level-region) observation types
%----------------------------------------------------------------------
+
psfname = cell(plotdat.nvars);
for ivar = 1:plotdat.nvars
@@ -208,23 +179,39 @@
for iregion = 1:plotdat.nregions
psfname{iregion} = sprintf('%s_rmse_%s_evolution_region%d.ps', ...
plotdat.varnames{ivar}, plotdat.copystring, iregion);
- fprintf('Removing %s from the current directory.\n',psfname{iregion})
- system(sprintf('rm %s',psfname{iregion}));
+ if (exist(psfname{iregion},'file') == 2)
+ fprintf('Removing %s from the current directory.\n',psfname{iregion})
+ system(sprintf('rm %s',psfname{iregion}));
+ end
end
% remove any existing log file -
lgfname = sprintf('%s_rmse_%s_obscount.txt',plotdat.varnames{ivar},plotdat.copystring);
- fprintf('Removing %s from the current directory.\n',lgfname)
- system(sprintf('rm %s',lgfname));
+ if (exist(lgfname,'file') == 2)
+ fprintf('Removing %s from the current directory.\n',lgfname)
+ system(sprintf('rm %s',lgfname));
+ end
logfid = fopen(lgfname,'wt');
fprintf(logfid,'%s\n',lgfname);
+ % check to see if there is anything to plot
+ % The number possible is decreased by the number of observations
+ % rejected by namelist control.
+
+ qcvalues = get_qc_values(fname, plotdat.guessvar, 'fatal', false, ...
+ 'verbose', false);
+
+ if ( sum(qcvalues.nposs(:)) < 1 )
+ fprintf('no obs for %s... skipping\n', plotdat.varnames{ivar})
+ continue
+ end
+
% get appropriate vertical coordinate variable
[dimnames, ~] = nc_var_dims(fname, plotdat.guessvar);
- if ( dimensionality == 1 ) % observations on a unit circle, no level
+ if ( plotdat.dimensionality == 1 ) % observations on a unit circle, no level
plotdat.level = 1;
plotdat.level_units = [];
elseif ( strfind(dimnames{2},'surface') > 0 )
@@ -236,95 +223,59 @@
else
plotdat.level = ncread(fname, dimnames{2});
plotdat.level_units = nc_read_att(fname, dimnames{2}, 'units');
+ nlevels = length(plotdat.level);
+ if (p.Results.level < 0 )
+ % use all the levels
+ elseif (p.Results.level > 0 && p.Results.level < nlevels)
+ plotdat.level = p.Results.level;
+ else
+ error('%d is not a valid level for %s',p.Results.level,plotdat.guessvar)
+ end
end
- plotdat.nlevels = length(plotdat.level);
-
- % Here is the tricky part. Singleton dimensions are auto-squeezed ...
- % single levels, single regions ...
-
- guess_raw = ncread(fname, plotdat.guessvar);
- guess_raw = permute(guess_raw,length(size(guess_raw)):-1:1);
- guess = reshape(guess_raw, plotdat.Nbins, plotdat.ncopies, ...
- plotdat.nlevels, plotdat.nregions);
-
- analy_raw = ncread(fname, plotdat.analyvar);
- analy_raw = permute(analy_raw,length(size(analy_raw)):-1:1);
- analy = reshape(analy_raw, plotdat.Nbins, plotdat.ncopies, ...
- plotdat.nlevels, plotdat.nregions);
-
- % check to see if there is anything to plot
- % The number possible is decreased by the number of observations
- % rejected by namelist control.
-
- nqc5 = guess(:,plotdat.NQC5index,:,:);
- nqc6 = guess(:,plotdat.NQC6index,:,:);
-
- fprintf('%10d %s observations had DART QC of 5 (all levels, all regions).\n', ...
- sum(nqc5(:)),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 6 (all levels, all regions).\n', ...
- sum(nqc6(:)),plotdat.myvarname)
- nposs = sum(guess(:,plotdat.Npossindex,:,:)) - ...
- sum(guess(:,plotdat.NQC5index ,:,:)) - ...
- sum(guess(:,plotdat.NQC6index ,:,:));
+ % read the whole variable, subset it later
- if ( sum(nposs(:)) < 1 )
- fprintf('no obs for %s... skipping\n', plotdat.varnames{ivar})
- continue
- end
-
- if (p.Results.level < 0)
- wantedlevels = 1:plotdat.nlevels;
+ guess = ncread(fname, plotdat.guessvar);
+ analy = local_ncread(fname, plotdat.analyvar);
+ if ( isempty(analy) )
+ % force analysis to be the same shape as the guess and full of NaNs
+ analy = guess;
+ analy(:) = NaN;
+ has_posterior = false;
+ plotdat.post_string = '';
else
- wantedlevels = p.Results.level;
+ has_posterior = true;
+ plotdat.post_string = '; \diamondsuit=posteriorOK';
end
- for ilevel = wantedlevels
-
- % summarize the observation counts in the log file
-
- fprintf(logfid,'\nlevel %d %f %s\n',ilevel,plotdat.level(ilevel),plotdat.level_units);
- plotdat.ges_Nqc4 = guess(:,plotdat.NQC4index ,ilevel,:);
- plotdat.anl_Nqc4 = analy(:,plotdat.NQC4index ,ilevel,:);
- fprintf(logfid,'DART QC == 4, prior/post %d %d\n',sum(plotdat.ges_Nqc4(:)), ...
- sum(plotdat.anl_Nqc4(:)));
-
- plotdat.ges_Nqc5 = guess(:,plotdat.NQC5index ,ilevel,:);
- plotdat.anl_Nqc5 = analy(:,plotdat.NQC5index ,ilevel,:);
- fprintf(logfid,'DART QC == 5, prior/post %d %d\n',sum(plotdat.ges_Nqc5(:)), ...
- sum(plotdat.anl_Nqc5(:)));
-
- plotdat.ges_Nqc6 = guess(:,plotdat.NQC6index ,ilevel,:);
- plotdat.anl_Nqc6 = analy(:,plotdat.NQC6index ,ilevel,:);
- fprintf(logfid,'DART QC == 6, prior/post %d %d\n',sum(plotdat.ges_Nqc6(:)), ...
- sum(plotdat.anl_Nqc6(:)));
+ for ilevel = 1:length(plotdat.level)
- plotdat.ges_Nqc7 = guess(:,plotdat.NQC7index ,ilevel,:);
- plotdat.anl_Nqc7 = analy(:,plotdat.NQC7index ,ilevel,:);
- fprintf(logfid,'DART QC == 7, prior/post %d %d\n',sum(plotdat.ges_Nqc7(:)), ...
- sum(plotdat.anl_Nqc7(:)));
+ priorQCs = get_qc_values(fname, plotdat.guessvar, ...
+ 'levelindex', ilevel, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
+ plotdat.mylevel = ilevel;
+ plotdat.ges_Neval = priorQCs.num_evaluated;
+ plotdat.ges_Nposs = priorQCs.nposs;
+ plotdat.ges_Nused = priorQCs.nused;
+ plotdat.ges_copy = guess(:,ilevel,plotdat.copyindex,:);
+ plotdat.ges_rmse = guess(:,ilevel,plotdat.rmseindex,:);
- plotdat.ges_Nqc8 = guess(:,plotdat.NQC8index ,ilevel,:);
- plotdat.anl_Nqc8 = analy(:,plotdat.NQC8index ,ilevel,:);
- fprintf(logfid,'DART QC == 8, prior/post %d %d\n',sum(plotdat.ges_Nqc8(:)), ...
- sum(plotdat.anl_Nqc8(:)));
-
- plotdat.ges_Nposs = guess(:,plotdat.Npossindex, ilevel,:) - ...
- plotdat.ges_Nqc5 - plotdat.ges_Nqc6;
- plotdat.anl_Nposs = analy(:,plotdat.Npossindex, ilevel,:) - ...
- plotdat.anl_Nqc5 - plotdat.anl_Nqc6;
- fprintf(logfid,'# obs poss, prior/post %d %d\n',sum(plotdat.ges_Nposs(:)), ...
- sum(plotdat.anl_Nposs(:)));
-
- plotdat.ges_Nused = guess(:,plotdat.Nusedindex, ilevel,:);
- plotdat.anl_Nused = analy(:,plotdat.Nusedindex, ilevel,:);
- fprintf(logfid,'# obs used, prior/post %d %d\n',sum(plotdat.ges_Nused(:)), ...
- sum(plotdat.anl_Nused(:)));
+ if (has_posterior)
+ posteQCs = get_qc_values(fname, plotdat.analyvar, ...
+ 'levelindex', ilevel, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
+ plotdat.anl_Nused = posteQCs.nused;
+ plotdat.anl_copy = analy(:,ilevel,plotdat.copyindex,:);
+ plotdat.anl_rmse = analy(:,ilevel,plotdat.rmseindex,:);
+ else
+ plotdat.anl_Nused = zeros(size(plotdat.ges_Nused));
+ plotdat.anl_copy = plotdat.ges_copy; % needed for determining limits
+ plotdat.anl_rmse = plotdat.ges_rmse; % needed for determining limits
+ end
- plotdat.ges_copy = guess(:,plotdat.copyindex, ilevel,:);
- plotdat.anl_copy = analy(:,plotdat.copyindex, ilevel,:);
- plotdat.ges_rmse = guess(:,plotdat.rmseindex, ilevel,:);
- plotdat.anl_rmse = analy(:,plotdat.rmseindex, ilevel,:);
+ % call report_qc_values.m
if isnan(p.Results.range(1))
plotdat.Yrange = FindRange(plotdat);
@@ -335,27 +286,33 @@
% plot each region, each level to a separate figure
for iregion = 1:plotdat.nregions
- figure(iregion); clf(iregion); orient(figuredata.orientation); wysiwyg
+ figure(iregion); clf(iregion); orient(figuredata.orientation);
plotdat.region = iregion;
plotdat.myregion = deblank(plotdat.region_names(iregion,:));
if ( isempty(plotdat.level_units) )
- plotdat.title = plotdat.myvarname;
+ plotdat.title = plotdat.myvarname;
else
- plotdat.title = sprintf('%s @ %d %s', ...
+ plotdat.title = sprintf('%s @ %d %s', ...
plotdat.myvarname, ...
plotdat.level(ilevel), ...
plotdat.level_units);
end
- myplot(plotdat,figuredata);
+ myplot(plotdat);
% create/append to the postscript file
- print(gcf,'-dpsc','-append',psfname{iregion});
+ if verLessThan('matlab','R2016a')
+ print(gcf, '-dpsc', '-append', psfname{iregion});
+ else
+ print(gcf, '-dpsc', '-append', '-bestfit', psfname{iregion});
+ end
% block to go slow and look at each one ...
- % disp('Pausing, hit any key to continue ...')
- % pause
+ if (p.Results.pause)
+ disp('Pausing, hit any key to continue ...')
+ pause
+ end
end
end
@@ -366,109 +323,68 @@
%=====================================================================
-function myplot(plotdat,figdata)
+function myplot(plotdat)
-% Interlace the [ges,anl] to make a sawtooth plot.
-% By this point, the middle two dimensions are singletons.
-cg = plotdat.ges_copy(:,:,:,plotdat.region);
-ca = plotdat.anl_copy(:,:,:,plotdat.region);
-other = reshape([cg ca]',2*plotdat.Nbins,1);
+global figuredata verbose
-mg = plotdat.ges_rmse(:,:,:,plotdat.region);
-ma = plotdat.anl_rmse(:,:,:,plotdat.region);
-rmse = reshape([mg ma]',2*plotdat.Nbins,1);
+ax1 = subplot('position',figuredata.position);
+set(ax1,'YAxisLocation','left','FontSize',figuredata.fontsize)
+orient(figuredata.orientation)
-g = plotdat.ges_Nposs(:,:,:,plotdat.region);
-a = plotdat.anl_Nposs(:,:,:,plotdat.region);
-nobs_poss = reshape([g a]',2*plotdat.Nbins,1);
+ges_Nposs = squeeze(plotdat.ges_Nposs(plotdat.region,:,:,:));
+ges_Nused = squeeze(plotdat.ges_Nused(plotdat.region,:,:,:));
+anl_Nused = squeeze(plotdat.anl_Nused(plotdat.region,:,:,:));
+ges_Neval = squeeze(plotdat.ges_Neval(plotdat.region,:,:,:));
+anl_Ngood = sum(anl_Nused);
-g = plotdat.ges_Nused(:,:,:,plotdat.region);
-a = plotdat.anl_Nused(:,:,:,plotdat.region);
-nobs_used = reshape([g a]',2*plotdat.Nbins,1);
+[hrmse, legstr_rmse ] = plot_quantity( 'rmse', plotdat);
+[hother, legstr_other] = plot_quantity(plotdat.copystring, plotdat);
-tg = plotdat.bincenters;
-ta = plotdat.bincenters;
-t = reshape([tg ta]',2*plotdat.Nbins,1);
+h = legend([hrmse,hother], legstr_rmse, legstr_other);
+set(h,'Interpreter','none','Box','off','FontSize',figuredata.fontsize)
-% Determine some quantities for the legend
-nobs = sum(nobs_used);
-if ( nobs > 1 )
- mean_pr_rmse = mean(mg(isfinite(mg)));
- mean_po_rmse = mean(ma(isfinite(ma)));
- mean_pr_other = mean(cg(isfinite(cg)));
- mean_po_other = mean(ca(isfinite(ca)));
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
else
- mean_pr_rmse = NaN;
- mean_po_rmse = NaN;
- mean_pr_other = NaN;
- mean_po_other = NaN;
+ h.AutoUpdate = 'off';
end
-string_rmse = sprintf('%s pr=%.5g, po=%.5g','rmse', mean_pr_rmse, mean_po_rmse);
-string_other = sprintf('%s pr=%.5g, po=%.5g', plotdat.copystring, ...
- mean_pr_other, mean_po_other);
-plotdat.subtitle = sprintf('%s %s',string_rmse, string_other);
-
-% Plot the requested quantity on the left axis. This is the first
-% thing plotted to get the proper legend symbols in the easiest manner.
-% Plot the rmse and 'xxx' on the same (left) axis.
-% The observation count will use the axis on the right.
-% We want to suppress the 'auto' feature of the axis labelling,
-% so we manually set some values that normally
-% don't need to be set.
-
-ax1 = subplot('position',figdata.position);
-h1 = plot(t,rmse,'k+-',t,other,'ro-','LineWidth',figdata.linewidth);
-set(ax1,'YAxisLocation','left','FontSize',figdata.fontsize)
-h = legend(h1,'rmse', plotdat.copystring);
-set(h,'Interpreter','none','Box','off')
+if verbose
+ fprintf('region %d %s level %d nobs_poss %d prior %d poste %d\n', ...
+ plotdat.region, plotdat.myvarname, plotdat.mylevel, ...
+ sum(ges_Nposs), sum(ges_Nused), anl_Ngood)
+ fprintf('%s; %s\n\n', legstr_rmse, legstr_other)
+end
% Attempt to make plotting robust in the face of 'empty' bins.
-% There was one case where the observations were only at one time, but
-% obs_diag was run with multple bins. All the empty bins had NaN in them,
-% so matlab auto-ranged to the single time (+/-). Then along comes the
-% need to plot symbols for how many obs are possible (zero) and the axes
-% were a mess.
-% The 't' variable has all the temporal bins specified, so we use that
-% to determine the X axis limits. After we know them, we turn OFF the
-% bits (which normally causes the X axis limits revert) and manually
-% reinstate the full axis values.
-
-hdummy = line(t, ones(size(t)) * plotdat.Yrange);
-axlims = axis;
-set(hdummy,'Visible','off')
-axlims = [axlims(1:2) plotdat.Yrange];
+% The bincenters variable has all the temporal bins specified,
+% so we use that to determine the X axis limits.
+
+axlims = [min(plotdat.bincenters) max(plotdat.bincenters) plotdat.Yrange];
axis(axlims)
switch lower(plotdat.copystring)
case 'bias'
% plot a zero-bias line
- zeroline = line(axlims(1:2),[0 0], 'Color',[0 100 0]/255,'Parent',ax1);
+ zeroline = line(axlims(1:2),[0 0], 'Color',[200 200 200]/255,'Parent',ax1);
set(zeroline,'LineWidth',2.5,'LineStyle','-')
plotdat.ylabel = sprintf('rmse and %s (%s)',plotdat.copystring,plotdat.biasconv);
otherwise
plotdat.ylabel = sprintf('rmse and %s',plotdat.copystring);
end
-% hokey effort to decide to plot months/days vs. daynum vs.
-ttot = plotdat.bincenters(plotdat.Nbins) - plotdat.bincenters(1) + 1;
-
-if ((plotdat.bincenters(1) > 1000) && (ttot > 5))
- datetick('x',6,'keeplimits','keepticks');
- monstr = datestr(plotdat.bincenters(1),21);
- xlabelstring = sprintf('month/day - %s start',monstr);
-elseif (plotdat.bincenters(1) > 1000)
- datetick('x',15,'keeplimits')
- monstr = datestr(plotdat.bincenters(1),21);
- xlabelstring = sprintf('%s start',monstr);
-else
- xlabelstring = 'days';
-end
+% effort to use user-supplied value for time labelling or
+% make a stab at a useful default.
+
+xlabelstring = set_time_axis('x', plotdat.bincenters, figuredata.DateForm);
+
set(get(ax1,'Xlabel'),'String',xlabelstring, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
-title({plotdat.myregion, plotdat.title, plotdat.subtitle}, ...
- 'Interpreter', 'none', 'Fontsize', figdata.fontsize, 'FontWeight', 'bold')
+title({plotdat.myregion, plotdat.title}, ...
+ 'Interpreter', 'none', 'Fontsize', figuredata.fontsize, 'FontWeight', 'bold')
BottomAnnotation(plotdat)
% create a separate scale for the number of observations
@@ -480,14 +396,35 @@ function myplot(plotdat,figdata)
'XTick' ,get(ax1,'XTick'), ...
'YDir' ,get(ax1,'YDir'), ...
'Color' ,'none', ...
- 'YColor' ,'b', ...
+ 'YColor' ,figuredata.obs_color, ...
'XAxisLocation','top', ...
'YAxisLocation','right');
-h2 = line(t,nobs_poss,'Color','b','Parent',ax2);
-h3 = line(t,nobs_used,'Color','b','Parent',ax2);
-set(h2,'LineStyle','none','Marker','o');
-set(h3,'LineStyle','none','Marker','*');
+ax2h1 = line(plotdat.bincenters, ges_Nposs, 'Parent', ax2);
+ax2h2 = line(plotdat.bincenters, ges_Nused, 'Parent', ax2);
+
+set(ax2h1, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.obs_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+
+set(ax2h2, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.ges_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+
+if anl_Ngood > 0
+ ax2h3 = line(plotdat.bincenters, anl_Nused, 'Parent',ax2);
+ set(ax2h3, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.anl_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+end
+
+% Force the number of observation axis to start at 0
+ylims = get(ax2,'Ylim');
+ylims(1) = 0;
+set(ax2,'Ylim',ylims);
% turn off topside X tick labels (clashes with title)
% use the same Y ticks, but find the right label values
@@ -495,9 +432,19 @@ function myplot(plotdat,figdata)
matchingYticks(ax1,ax2);
set(get(ax1,'Ylabel'), 'String', plotdat.ylabel, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
-set(get(ax2,'Ylabel'),'String','# of obs : o=possible, \ast=assimilated', ...
- 'FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
+
+% determine if the observation type was flagged as 'evaluate' or 'assimilate'
+% since we don't have the ability to specify this level-by-level or by
+% regions, we can use an 'all-or-nothing' approach.
+
+if sum(ges_Neval(:)) > 0
+ string1 = ['# of obs: o=possible; \ast=evaluated' plotdat.post_string];
+else
+ string1 = ['# of obs: o=possible; \ast=assimilated' plotdat.post_string];
+end
+set(get(ax2,'Ylabel'), 'String', string1, 'FontSize', figuredata.fontsize)
+
%=====================================================================
@@ -539,6 +486,9 @@ function BottomAnnotation(main)
function [y,ydims] = FindTemporalVars(x)
%% Returns UNIQUE (i.e. base) temporal variable names
+
+global verbose
+
if ( ~(isfield(x,'allvarnames') && isfield(x,'allvardims')))
error('Doh! no ''allvarnames'' and ''allvardims'' components')
end
@@ -549,9 +499,8 @@ function BottomAnnotation(main)
indx = strfind(x.allvardims{i},'time');
if (indx > 0)
j = j + 1;
-
- basenames{j} = ReturnBase(x.allvarnames{i});
- basedims{ j} = x.allvardims{i};
+ basenames{j} = ReturnBase(x.allvarnames{i}); %#ok
+ basedims{ j} = x.allvardims{i}; %#ok
end
end
@@ -559,7 +508,7 @@ function BottomAnnotation(main)
y = cell(length(i),1);
ydims = cell(length(i),1);
for k = 1:length(i)
- fprintf('%2d is %s\n',k,basenames{i(k)})
+ if (verbose), fprintf('%3d is %s\n',k,basenames{i(k)}); end
y{k} = basenames{i(k)};
ydims{k} = basedims{ i(k)};
end
@@ -630,27 +579,6 @@ function BottomAnnotation(main)
%=====================================================================
-function figdata = setfigure()
-%%
-% figure out a page layout
-% extra space at the bottom for the date/file annotation
-% extra space at the top because the titles have multiple lines
-
-orientation = 'landscape';
-fontsize = 16;
-position = [0.10 0.15 0.8 0.7];
-linewidth = 2.0;
-
-figdata = struct('expcolors', {{'k','r','b','m','g','c','y'}}, ...
- 'expsymbols', {{'o','s','d','p','h','s','*'}}, ...
- 'prpolines', {{'-','--'}}, 'position', position, ...
- 'fontsize',fontsize, 'orientation',orientation, ...
- 'linewidth',linewidth);
-
-
-%=====================================================================
-
-
function value = local_ncread(fname,varname)
%% If the variable exists in the file, return the contents of the variable.
% if the variable does not exist, return empty value instead of error-ing
@@ -663,6 +591,62 @@ function BottomAnnotation(main)
value = [];
end
+%=====================================================================
+
+function [h, legstr] = plot_quantity(quantity, plotdat)
+
+global figuredata
+
+anl_Nused = squeeze(plotdat.anl_Nused(plotdat.region,:,:,:));
+anl_Nposs = sum(anl_Nused);
+
+switch lower(quantity)
+ case 'rmse'
+
+ prior = squeeze(plotdat.ges_rmse(plotdat.region,:,:,:));
+ posterior = squeeze(plotdat.anl_rmse(plotdat.region,:,:,:));
+ mean_prior = mean( prior(isfinite( prior)));
+ mean_posterior = mean(posterior(isfinite(posterior)));
+
+ color = figuredata.rmse_color;
+ marker = figuredata.marker1;
+ linestyle = figuredata.solid;
+ linewidth = figuredata.linewidth;
+
+ otherwise
+
+ prior = squeeze(plotdat.ges_copy(plotdat.region, :,:,:));
+ posterior = squeeze(plotdat.anl_copy(plotdat.region, :,:,:));
+ mean_prior = mean( prior(isfinite( prior)));
+ mean_posterior = mean(posterior(isfinite(posterior)));
+
+ color = figuredata.copy_color;
+ marker = figuredata.marker2;
+ linestyle = figuredata.solid;
+ linewidth = figuredata.linewidth;
+
+end
+
+% If the posterior is available, interlace to make a sawtooth plot
+% and create meaningful legend strings
+
+if anl_Nposs > 0
+ data = reshape([prior posterior ]',2*plotdat.Nbins,1);
+ t = reshape([plotdat.bincenters plotdat.bincenters]',2*plotdat.Nbins,1);
+ legstr = sprintf('%s pr=%.5g, po=%.5g',quantity, mean_prior, mean_posterior);
+else
+ data = prior;
+ t = plotdat.bincenters;
+ legstr = sprintf('%s pr=%.5g',quantity, mean_prior);
+end
+
+h = line(t,data);
+set(h, 'LineStyle', linestyle, ...
+ 'LineWidth', linewidth, ...
+ 'Color', color, ...
+ 'Marker', marker, ...
+ 'MarkerFaceColor', color, ...
+ 'MarkerSize', figuredata.MarkerSize);
%
% $URL$
diff --git a/diagnostics/matlab/plot_rmse_xxx_profile.m b/diagnostics/matlab/plot_rmse_xxx_profile.m
index 3b16431890..6dab5f29eb 100644
--- a/diagnostics/matlab/plot_rmse_xxx_profile.m
+++ b/diagnostics/matlab/plot_rmse_xxx_profile.m
@@ -3,8 +3,8 @@
% Part of the observation-space diagnostics routines.
%
% 'obs_diag' produces a netcdf file containing the diagnostics.
-% obs_diag condenses the obs_seq.final information into summaries for a few specified
-% regions - on a level-by-level basis.
+% 'obs_diag' condenses the obs_seq.final information into summaries for a few
+% specified regions - on a level-by-level basis.
%
% The number of observations possible reflects only those observations
% that have incoming QC values of interest. Any observation with a DART
@@ -19,7 +19,7 @@
% For TRUSTED observations, this is different than the number used to calculate
% bias, rmse, spread, etc.
%
-% USAGE: plotdat = plot_rmse_xxx_profile(fname, copy);
+% USAGE: plotdat = plot_rmse_xxx_profile(fname, copy [,varargin]);
%
% fname : netcdf file produced by 'obs_diag'
%
@@ -27,10 +27,23 @@
% Possible values are available in the netcdf 'CopyMetaData' variable.
% (ncdump -v CopyMetaData obs_diag_output.nc)
%
-% obsname : Optional. If present, The strings of each observation type to plot.
+% varargin: optional parameter-value pairs. Supported parameters are described below.
+%
+% obsname : The strings of each observation type to plot.
% Each observation type will be plotted in a separate graphic.
% Default is to plot all available observation types.
%
+%
+% range : 'range' of the value being plotted. Default is to
+% automatically determine range based on the data values.
+%
+% verbose : true/false to control amount of run-time output
+%
+% MarkerSize : integer controlling the size of the symbols
+%
+% pause : true/false to conrol pausing after each figure is created.
+% true will require hitting any key to continue to next plot
+%
% OUTPUT: 'plotdat' is a structure containing what was plotted.
% A .pdf of each graphic is created. Each .pdf has a name that
% reflects the variable, quantity, and region being plotted.
@@ -58,29 +71,46 @@
% Decode,Parse,Check the input
%---------------------------------------------------------------------
-default_obsname = 'none';
+default_obsname = 'none';
+default_verbosity = true;
+default_markersize = 12;
+default_pause = false;
+default_range = [NaN NaN];
p = inputParser;
addRequired(p,'fname',@ischar);
addRequired(p,'copy',@ischar);
if (exist('inputParser/addParameter','file') == 2)
- addParameter(p,'obsname',default_obsname,@ischar);
+ addParameter(p,'obsname', default_obsname, @ischar);
+ addParameter(p,'verbose', default_verbosity, @islogical);
+ addParameter(p,'MarkerSize', default_markersize, @isnumeric);
+ addParameter(p,'pause', default_pause, @islogical);
+ addParameter(p,'range', default_range, @isnumeric);
else
- addParamValue(p,'obsname',default_obsname,@ischar);
+ addParamValue(p,'obsname', default_obsname, @ischar); %#ok
+ addParamValue(p,'verbose', default_verbosity, @islogical); %#ok
+ addParamValue(p,'MarkerSize',default_markersize, @isnumeric); %#ok
+ addParamValue(p,'pause', default_pause, @islogical); %#ok
+ addParamValue(p,'range', default_range, @isnumeric); %#ok
end
-
p.parse(fname, copy, varargin{:});
-% if you want to echo the input
-% disp(['fname : ', p.Results.fname])
-% disp(['copy : ', p.Results.copy])
-% disp(['obsname : ', p.Results.obsname])
-
if ~isempty(fieldnames(p.Unmatched))
disp('Extra inputs:')
disp(p.Unmatched)
end
+if (numel(p.Results.range) ~= 2)
+ error('range must be an array of length two ... [bottom top]')
+end
+
+if strcmp(p.Results.obsname,'none')
+ nvars = 0;
+else
+ obsname = p.Results.obsname;
+ nvars = 1;
+end
+
if (exist(fname,'file') ~= 2)
error('file/fname <%s> does not exist',fname)
end
@@ -89,80 +119,30 @@
% Harvest plotting info/metadata from netcdf file.
%---------------------------------------------------------------------
-plotdat.fname = fname;
-plotdat.copystring = copy;
-
-plotdat.binseparation = nc_read_att(fname, '/', 'bin_separation');
-plotdat.binwidth = nc_read_att(fname, '/', 'bin_width');
-time_to_skip = nc_read_att(fname, '/', 'time_to_skip');
-plotdat.lonlim1 = nc_read_att(fname, '/', 'lonlim1');
-plotdat.lonlim2 = nc_read_att(fname, '/', 'lonlim2');
-plotdat.latlim1 = nc_read_att(fname, '/', 'latlim1');
-plotdat.latlim2 = nc_read_att(fname, '/', 'latlim2');
-plotdat.biasconv = nc_read_att(fname, '/', 'bias_convention');
-
-plotdat.mlevel = local_ncread(fname, 'mlevel');
-plotdat.plevel = local_ncread(fname, 'plevel');
-plotdat.plevel_edges = local_ncread(fname, 'plevel_edges');
-plotdat.hlevel = local_ncread(fname, 'hlevel');
-plotdat.hlevel_edges = local_ncread(fname, 'hlevel_edges');
-plotdat.bincenters = ncread(fname, 'time');
-plotdat.binedges = ncread(fname, 'time_bounds');
-plotdat.region_names = strtrim(ncread(fname, 'region_names')');
-[plotdat.nregions,~] = nc_dim_info(fname,'region');
-
-% Coordinate between time types and dates
-
-timeunits = nc_read_att(fname,'time','units');
-timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
-timeorigin = datenum(timebase(1),timebase(2),timebase(3));
-timefloats = zeros(size(time_to_skip)); % stupid int32 type conversion
-timefloats(:) = time_to_skip(:);
-skip_seconds = timefloats(4)*3600 + timefloats(5)*60 + timefloats(6);
-iskip = timefloats(3) + skip_seconds/86400.0;
-
-% Set up a structure to use for plotting
-
-plotdat.bincenters = plotdat.bincenters + timeorigin;
-plotdat.binedges = plotdat.binedges + timeorigin;
-plotdat.Nbins = length(plotdat.bincenters);
-plotdat.toff = plotdat.binedges(1) + iskip;
-plotdat.timespan = sprintf('%s through %s', datestr(plotdat.toff), ...
- datestr(max(plotdat.binedges(:))));
-plotdat.xlabel = sprintf('rmse and %s',copy);
-
-[plotdat.allvarnames, plotdat.allvardims] = get_varsNdims(fname);
-[plotdat.varnames, plotdat.vardims] = FindVerticalVars(plotdat);
-
-plotdat.nvars = length(plotdat.varnames);
-plotdat.copyindex = get_copy_index(fname,copy);
-plotdat.rmseindex = get_copy_index(fname,'rmse');
-plotdat.Npossindex = get_copy_index(fname,'Nposs');
-plotdat.Nusedindex = get_copy_index(fname,'Nused');
-plotdat.NQC4index = get_copy_index(fname,'N_DARTqc_4');
-plotdat.NQC5index = get_copy_index(fname,'N_DARTqc_5');
-plotdat.NQC6index = get_copy_index(fname,'N_DARTqc_6');
-plotdat.NQC7index = get_copy_index(fname,'N_DARTqc_7');
-plotdat.NQC8index = get_copy_index(fname,'N_DARTqc_8');
-
-figuredata = setfigure();
-
-%%---------------------------------------------------------------------
-% Loop around (copy-level-region) observation types
-%----------------------------------------------------------------------
+plotdat = read_obsdiag_staticdata(fname,copy);
+plotdat.xlabel = sprintf('rmse and %s',copy);
% Either use all the variables or just the one optionally specified.
-
-if strcmp(p.Results.obsname,'none')
- varlist = 1:plotdat.nvars;
+if (nvars == 0)
+ [plotdat.allvarnames, plotdat.allvardims] = get_varsNdims(fname);
+ [plotdat.varnames, plotdat.vardims] = FindVerticalVars(plotdat);
+ plotdat.nvars = length(plotdat.varnames);
else
- varlist = find (strcmpi(p.Results.obsname,plotdat.varnames));
- if isempty(varlist)
- error('%s is not in the list of observations',p.Results.obsname)
- end
+ plotdat.varnames{1} = obsname;
+ plotdat.nvars = nvars;
end
-for ivar = varlist
+global figuredata verbose
+
+figuredata = set_obsdiag_figure('tall');
+figuredata.MarkerSize = p.Results.MarkerSize;
+verbose = p.Results.verbose;
+
+%%---------------------------------------------------------------------
+% Loop around (copy-level-region) observation types
+%----------------------------------------------------------------------
+
+for ivar = 1:plotdat.nvars
% create the variable names of interest.
@@ -191,195 +171,222 @@
continue
end
- [level_org, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname, plotdat.guessvar);
- plotdat.level_org = level_org;
+ [levels, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname, plotdat.guessvar);
+ plotdat.levels = levels;
plotdat.level_units = level_units;
plotdat.nlevels = nlevels;
plotdat.level_edges = level_edges;
plotdat.Yrange = Yrange;
- % Matlab likes strictly ASCENDING order for things to be plotted,
- % then you can impose the direction. The data is stored in the original
- % order, so the sort indices are saved to reorder the data.
+ % Matlab likes strictly ASCENDING order for the axes and ticks,
+ % then you can impose the direction.
- if (plotdat.level_org(1) > plotdat.level_org(plotdat.nlevels))
+ if (plotdat.levels(1) > plotdat.levels(plotdat.nlevels))
plotdat.YDir = 'reverse';
else
plotdat.YDir = 'normal';
end
- % Add error-checking for output from older versions of obs_diag.
+ [levels, ~] = sort(plotdat.levels);
+ plotdat.YTick = unique(levels);
- [levels, indices] = sort(plotdat.level_org);
- plotdat.level = unique(levels);
- if (length(plotdat.level) ~= length(levels))
+ % Add error-checking for output from older versions of obs_diag.
+ if (length(plotdat.YTick) ~= length(plotdat.levels))
error('There is a duplicated value in the array specifying the levels - must change your input.nml and rerun obs_diag')
end
- plotdat.indices = indices;
level_edges = sort(plotdat.level_edges);
plotdat.level_edges = level_edges;
- % The rest of this script was written for the third-party netcdf
- % support. Matlab's native ncread transposes the variables, so I have to
- % permute them back to the expected storage order.
+ % guess(nregions,nlevels,ncopies)
guess = ncread(fname, plotdat.guessvar);
- analy = ncread(fname, plotdat.analyvar);
- rank = length(size(guess));
- guess = permute(guess,rank:-1:1);
- analy = permute(analy,rank:-1:1);
-
- % singleton dimensions are auto-squeezed - which is unfortunate.
- % We want these things to be 3D. [copy-level-region]
-
- if ( plotdat.nlevels == 1 )
- bob(:,1,:) = guess;
- ted(:,1,:) = analy;
- guess = bob; clear bob
- analy = ted; clear ted
+ analy = local_ncread(fname, plotdat.analyvar);
+ if (isempty(analy))
+ analy = guess; % make the variable the same shape as guess
+ analy(:) = NaN; % and fill it with nothing
+ plotdat.has_analysis = false;
+ plotdat.post_string = '';
+ else
+ plotdat.has_analysis = true;
+ plotdat.post_string = '; \diamondsuit=posteriorOK';
end
% check to see if there is anything to plot
% The number possible is decreased by the number of observations
% rejected by namelist control.
- fprintf('\n')
- fprintf('%10d %s observations had DART QC of 4 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC4index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 5 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC5index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 6 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC6index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 7 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC7index, :,:))),plotdat.myvarname)
- fprintf('%10d %s observations had DART QC of 8 (all regions).\n', ...
- sum(sum(guess(plotdat.NQC8index, :,:))),plotdat.myvarname)
-
- nposs = sum(guess(plotdat.Npossindex,:,:)) - ...
- sum(guess(plotdat.NQC5index ,:,:)) - ...
- sum(guess(plotdat.NQC6index ,:,:));
-
- if ( sum(nposs(:)) < 1 )
- fprintf('No obs for %s... skipping\n', plotdat.varnames{ivar})
+ priorQCs = get_qc_values(fname, plotdat.guessvar, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
+
+ plotdat.ges_Neval = priorQCs.num_evaluated;
+ plotdat.ges_Nposs = priorQCs.nposs;
+ plotdat.ges_Nused = priorQCs.nused;
+ plotdat.ges_rmse = guess(:,:,plotdat.rmseindex);
+ plotdat.ges_copy = guess(:,:,plotdat.copyindex);
+
+ if ( sum(plotdat.ges_Nposs(:)) < 1 )
+ fprintf('no obs for %s... skipping\n', plotdat.varnames{ivar})
continue
end
- plotdat.ges_copy = guess(plotdat.copyindex, :, :);
- plotdat.anl_copy = analy(plotdat.copyindex, :, :);
- plotdat.ges_rmse = guess(plotdat.rmseindex, :, :);
- plotdat.anl_rmse = analy(plotdat.rmseindex, :, :);
- plotdat.ges_Nqc4 = guess(plotdat.NQC4index, :, :);
- plotdat.anl_Nqc4 = analy(plotdat.NQC4index, :, :);
- plotdat.ges_Nqc5 = guess(plotdat.NQC5index, :, :);
- plotdat.anl_Nqc5 = analy(plotdat.NQC5index, :, :);
- plotdat.ges_Nqc6 = guess(plotdat.NQC6index, :, :);
- plotdat.anl_Nqc6 = analy(plotdat.NQC6index, :, :);
- plotdat.ges_Nqc7 = guess(plotdat.NQC7index, :, :);
- plotdat.anl_Nqc7 = analy(plotdat.NQC7index, :, :);
- plotdat.ges_Nqc8 = guess(plotdat.NQC8index, :, :);
- plotdat.anl_Nqc8 = analy(plotdat.NQC8index, :, :);
-
- plotdat.ges_Nused = guess(plotdat.Nusedindex, :, :);
- plotdat.anl_Nused = guess(plotdat.Nusedindex, :, :);
- plotdat.ges_Nposs = guess(plotdat.Npossindex, :, :) - ...
- plotdat.ges_Nqc5 - plotdat.ges_Nqc6;
- plotdat.anl_Nposs = analy(plotdat.Npossindex, :, :) - ...
- plotdat.anl_Nqc5 - plotdat.anl_Nqc6;
+ if (plotdat.has_analysis)
+ posteQCs = get_qc_values(fname, plotdat.analyvar, ...
+ 'fatal', false, ...
+ 'verbose', verbose);
+ plotdat.anl_Nused = posteQCs.nused;
+ plotdat.anl_rmse = analy(:,:,plotdat.rmseindex);
+ plotdat.anl_copy = analy(:,:,plotdat.copyindex);
+ else
+ plotdat.anl_Nused = zeros(size(plotdat.ges_Nused));
+ plotdat.anl_rmse = plotdat.ges_rmse; % needed for determining limits
+ plotdat.anl_copy = plotdat.ges_copy; % needed for determining limits
+ end
+
+ % call report_qc_values.m
+
plotdat.Xrange = FindRange(plotdat);
% plot by region - each in its own figure.
for iregion = 1:plotdat.nregions
- figure(iregion); clf(iregion); orient(figuredata.orientation); wysiwyg
+ figure(iregion);
+ clf(iregion);
+ orient(figuredata.orientation);
plotdat.region = iregion;
plotdat.myregion = deblank(plotdat.region_names(iregion,:));
- myplot(plotdat, figuredata);
+
+ myplot(plotdat);
+
BottomAnnotation(fname)
psfname = sprintf('%s_rmse_%s_profile_region%d', ...
plotdat.varnames{ivar}, plotdat.copystring, iregion);
- print(gcf,'-dpdf',psfname);
+
+ if verLessThan('matlab','R2016a')
+ print(gcf, '-dpdf', psfname);
+ else
+ print(gcf, '-dpdf', '-bestfit', psfname);
+ end
+
+ % block to go slow and look at each one ...
+ if (p.Results.pause)
+ disp('Pausing, hit any key to continue ...')
+ pause
+ end
+
end
-
end
-
%=====================================================================
% 'Helper' functions
%=====================================================================
-function myplot(plotdat,figdata)
+function myplot(plotdat)
-%% Interlace the [ges,anl] to make a sawtooth plot.
-% By this point, the middle two dimensions are singletons.
-% The data must be sorted to match the order of the levels.
-cg = plotdat.ges_copy(:,:,plotdat.region); CG = cg(plotdat.indices);
-ca = plotdat.anl_copy(:,:,plotdat.region); CA = ca(plotdat.indices);
+global figuredata
-mg = plotdat.ges_rmse(:,:,plotdat.region); MG = mg(plotdat.indices);
-ma = plotdat.anl_rmse(:,:,plotdat.region); MA = ma(plotdat.indices);
+ges_copy = plotdat.ges_copy(plotdat.region,:);
+anl_copy = plotdat.anl_copy(plotdat.region,:);
+ges_rmse = plotdat.ges_rmse(plotdat.region,:);
+anl_rmse = plotdat.anl_rmse(plotdat.region,:);
-g = plotdat.ges_Nposs(:,:,plotdat.region); G = g(plotdat.indices);
-a = plotdat.anl_Nposs(:,:,plotdat.region); A = a(plotdat.indices);
+ges_Nposs = plotdat.ges_Nposs(plotdat.region,:);
+ges_Nused = plotdat.ges_Nused(plotdat.region,:);
+anl_Nused = plotdat.anl_Nused(plotdat.region,:);
+anl_Ngood = sum(anl_Nused);
-nobs_poss = G;
-nposs_delta = G - A;
+mean_pr_rmse = mean(ges_rmse(isfinite(ges_rmse)));
+mean_pr_copy = mean(ges_copy(isfinite(ges_copy)));
+str_pr_rmse = sprintf('%s pr=%.5g','rmse',mean_pr_rmse);
+str_pr_copy = sprintf('%s pr=%.5g',plotdat.copystring,mean_pr_copy);
-g = plotdat.ges_Nused(:,:,plotdat.region); G = g(plotdat.indices);
-a = plotdat.anl_Nused(:,:,plotdat.region); A = a(plotdat.indices);
-nobs_used = G;
-nused_delta = G - A;
+% If the posterior is available, plot them too.
-% Determine some quantities for the legend
-nobs = sum(nobs_used);
-if ( nobs > 1 )
- rmse_guess = mean(MG(isfinite(MG)));
- rmse_analy = mean(MA(isfinite(MA)));
- other_guess = mean(CG(isfinite(CG)));
- other_analy = mean(CA(isfinite(CA)));
-else
- rmse_guess = NaN;
- rmse_analy = NaN;
- other_guess = NaN;
- other_analy = NaN;
+if anl_Ngood > 0
+ mean_po_rmse = mean(anl_rmse(isfinite(anl_rmse)));
+ mean_po_copy = mean(anl_copy(isfinite(anl_copy)));
+ str_po_rmse = sprintf('%s po=%.5g','rmse',mean_po_rmse);
+ str_po_copy = sprintf('%s po=%.5g',plotdat.copystring,mean_po_copy);
end
-str_rmse_pr = sprintf('%s pr=%.5g','rmse',rmse_guess);
-str_rmse_po = sprintf('%s po=%.5g','rmse',rmse_analy);
-str_other_pr = sprintf('%s pr=%.5g',plotdat.copystring,other_guess);
-str_other_po = sprintf('%s po=%.5g',plotdat.copystring,other_analy);
-
% Plot the rmse and 'xxx' on the same (bottom) axis.
% The observation count will use the axis on the top.
% Ultimately, we want to suppress the 'auto' feature of the
% axis labelling, so we manually set some values that normally
% don't need to be set.
-ax1 = subplot('position',figdata.position);
+ax1 = subplot('position',figuredata.position);
+orient(figuredata.orientation)
% add type of vertical coordinate info for adjusting axes to accomodate legend
Stripes(plotdat.Xrange, plotdat.level_edges, plotdat.level_units);
-set(ax1, 'YDir', plotdat.YDir, 'YTick', plotdat.level, 'Layer', 'top')
-set(ax1,'YAxisLocation','left','FontSize',figdata.fontsize)
+set(ax1, 'YDir', plotdat.YDir, 'YTick', plotdat.YTick, 'Layer', 'top')
+set(ax1,'YAxisLocation','left','FontSize',figuredata.fontsize)
% draw the result of the experiment
-hold on;
-h1 = plot(MG,plotdat.level,'k+-',MA,plotdat.level,'k+--', ...
- CG,plotdat.level,'ro-',CA,plotdat.level,'ro--');
-set(h1,'LineWidth',figdata.linewidth);
-hold off;
+h1 = line(ges_rmse,plotdat.levels);
+h2 = line(ges_copy,plotdat.levels);
+
+set(h1,'Color', figuredata.rmse_color, ...
+ 'Marker', figuredata.marker1, ...
+ 'LineStyle', figuredata.solid, ...
+ 'LineWidth', figuredata.linewidth, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'MarkerFaceColor',figuredata.rmse_color)
+
+set(h2,'Color', figuredata.copy_color, ...
+ 'Marker', figuredata.marker2, ...
+ 'LineStyle', figuredata.solid, ...
+ 'LineWidth', figuredata.linewidth, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'MarkerFaceColor',figuredata.copy_color)
+
+if anl_Ngood > 0
+ h3 = line(anl_rmse,plotdat.levels);
+ h4 = line(anl_copy,plotdat.levels);
+
+ set(h3,'Color', figuredata.rmse_color, ...
+ 'Marker', figuredata.marker1, ...
+ 'LineStyle', figuredata.dashed, ...
+ 'LineWidth', figuredata.linewidth, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'MarkerFaceColor',figuredata.rmse_color)
+
+ set(h4,'Color', figuredata.copy_color, ...
+ 'Marker', figuredata.marker2, ...
+ 'LineStyle', figuredata.dashed, ...
+ 'LineWidth', figuredata.linewidth, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'MarkerFaceColor',figuredata.copy_color)
+
+ h = legend([h1,h3,h2,h4], str_pr_rmse, str_po_rmse, ...
+ str_pr_copy, str_po_copy);
+else
+
+ h = legend([h1,h2], str_pr_rmse, str_pr_copy);
+end
-zeroline = line([0 0],plotdat.Yrange,'Color',[0 100 0]/255,'Parent',ax1);
-set(zeroline,'LineWidth',2.5,'LineStyle','-')
+set(h,'Interpreter','none','Box','off','Location','NorthWest')
-h = legend(h1, str_rmse_pr, str_rmse_po, str_other_pr, str_other_po, 'Location', 'NorthWest');
-set(h,'Interpreter','none','Box','off')
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+else
+ h.AutoUpdate = 'off';
+end
+
+% Want a zeroline for bias plots.
+zeroline = line([0 0],plotdat.Yrange,'Color',[200 200 200]/255,'Parent',ax1);
+set(zeroline,'LineWidth',2.5,'LineStyle','-')
% If the observation is trusted, reference that somehow
+
switch lower(plotdat.trusted)
case 'true'
axlims = axis;
@@ -400,16 +407,32 @@ function myplot(plotdat,figdata)
'XAxisLocation','top', ...
'YAxisLocation','right', ...
'Color','none', ...
- 'XColor','b', ...
+ 'XColor',figuredata.obs_color, ...
'YColor',get(ax1,'YColor'), ...
'YLim',get(ax1,'YLim'), ...
'YDir',get(ax1,'YDir'), ...
'FontSize',get(ax1,'FontSize'));
-h2 = line(nobs_poss,plotdat.level,'Color','b','Parent',ax2);
-h3 = line(nobs_used,plotdat.level,'Color','b','Parent',ax2);
-set(h2,'LineStyle','none','Marker','o');
-set(h3,'LineStyle','none','Marker','*');
+ax2h1 = line(ges_Nposs, plotdat.levels, 'Parent', ax2);
+ax2h2 = line(ges_Nused, plotdat.levels, 'Parent', ax2);
+
+set(ax2h1, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.obs_marker, ...
+ 'MarkerSize', figuredata.MarkerSize);
+
+set(ax2h2, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.ges_marker, ...
+ 'MarkerSize', figuredata.MarkerSize);
+
+if anl_Ngood > 0
+ ax2h3 = line(anl_Nused, plotdat.levels, 'Parent',ax2);
+ set(ax2h3, 'LineStyle', 'none', ...
+ 'Color', figuredata.obs_color, ...
+ 'Marker', figuredata.anl_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+end
% use same Y ticks - but no labels.
set(ax2,'YTick',get(ax1,'YTick'), 'YTicklabel',[]);
@@ -418,14 +441,24 @@ function myplot(plotdat,figdata)
xscale = matchingXticks(ax1,ax2);
set(get(ax1,'Ylabel'),'String',plotdat.level_units, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
set(get(ax1,'Xlabel'),'String',{plotdat.xlabel, plotdat.timespan}, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
-set(get(ax2,'Xlabel'),'String', ...
- ['# of obs (o=possible, \ast=assimilated) x' int2str(uint32(xscale))],'FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
+
+% determine if the observation was flagged as 'evaluate' or 'assimilate'
+
+if sum(plotdat.ges_Neval(plotdat.region,:)) > 0
+ string1 = sprintf('# of obs (o=possible; %s %s) x %d', ...
+ '\ast=evaluated', plotdat.post_string, uint32(xscale));
+else
+ string1 = sprintf('# of obs (o=possible; %s %s) x %d', ...
+ '\ast=assimilated', plotdat.post_string, uint32(xscale));
+end
+
+set(get(ax2,'Xlabel'), 'String', string1, 'FontSize', figuredata.fontsize)
title({plotdat.myregion, plotdat.myvarname}, ...
- 'Interpreter', 'none', 'FontSize', figdata.fontsize, 'FontWeight', 'bold')
+ 'Interpreter', 'none', 'FontSize', figuredata.fontsize, 'FontWeight', 'bold')
%=====================================================================
@@ -458,6 +491,8 @@ function BottomAnnotation(main)
% In this context, if the variable has a 'time' dimension
% it cannot be a variable of interest.
+global verbose
+
if ( ~(isfield(x,'allvarnames') && isfield(x,'allvardims')))
error('Doh! no ''allvarnames'' and ''allvardims'' components')
end
@@ -468,7 +503,7 @@ function BottomAnnotation(main)
for i = 1:length(x.allvarnames)
dimnames = lower(x.allvardims{i});
- if (isempty(strfind(dimnames,'time')))
+ if (isempty(strfind(dimnames,'time'))) %#ok
platform = ReturnBase(x.allvarnames{i});
if (~ isempty(platform))
j = j + 1;
@@ -483,7 +518,7 @@ function BottomAnnotation(main)
ydims = struct([]);
for k = 1:length(i)
- fprintf('%2d is %s\n',k,basenames{i(k)})
+ if (verbose), fprintf('%3d is %s\n',k,basenames{i(k)}); end
y{k} = basenames{i(k)};
ydims{k} = basedims{i(k)};
end
@@ -492,7 +527,7 @@ function BottomAnnotation(main)
%=====================================================================
-function [level_org, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname,varname)
+function [levels, level_units, nlevels, level_edges, Yrange] = FindVerticalInfo(fname,varname)
%% Find the vertical dimension and harvest some info
varinfo = ncinfo(fname,varname);
@@ -507,7 +542,7 @@ function BottomAnnotation(main)
error('There is no level information for %s in %s',varname,fname)
end
-level_org = ncread( fname,varinfo.Dimensions(leveldim).Name);
+levels = ncread( fname,varinfo.Dimensions(leveldim).Name);
level_units = ncreadatt(fname,varinfo.Dimensions(leveldim).Name,'units');
nlevels = varinfo.Size(leveldim);
edgename = sprintf('%s_edges',varinfo.Dimensions(leveldim).Name);
@@ -631,7 +666,7 @@ function BottomAnnotation(main)
hold on;
for i = 1:2:(length(edges)-1)
yc = [ edges(i) edges(i) edges(i+1) edges(i+1) edges(i) ];
- hf = fill(xc,yc,[0.8 0.8 0.8],'EdgeColor','none');
+ fill(xc,yc,[0.8 0.8 0.8],'EdgeColor','none');
end
hold off;
@@ -642,33 +677,12 @@ function BottomAnnotation(main)
%=====================================================================
-function figdata = setfigure()
-%%
-% figure out a page layout
-% extra space at the bottom for the date/file annotation
-% extra space at the top because the titles have multiple lines
-
-orientation = 'tall';
-fontsize = 16;
-position = [0.15 0.12 0.7 0.75];
-linewidth = 2.0;
-
-figdata = struct('expcolors', {{'k','r','b','m','g','c','y'}}, ...
- 'expsymbols', {{'o','s','d','p','h','s','*'}}, ...
- 'prpolines', {{'-','--'}}, 'position', position, ...
- 'fontsize',fontsize, 'orientation',orientation, ...
- 'linewidth',linewidth);
-
-
-%=====================================================================
-
-
function value = local_ncread(fname,varname)
%% If the variable exists in the file, return the contents of the variable.
% if the variable does not exist, return empty value instead of error-ing
% out.
-[variable_present, varid] = nc_var_exists(fname,varname);
+[variable_present, ~] = nc_var_exists(fname,varname);
if (variable_present)
value = ncread(fname, varname);
else
diff --git a/diagnostics/matlab/private/blue_to_darkred.m b/diagnostics/matlab/private/blue_to_darkred.m
new file mode 100644
index 0000000000..41e6a2ba4d
--- /dev/null
+++ b/diagnostics/matlab/private/blue_to_darkred.m
@@ -0,0 +1,76 @@
+function colors = blue_to_darkred()
+% Dark Red to Blue, 18 steps, based on ColorBrewer RdYlBu_11
+%
+% 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
+%
+% DART $Id$
+
+RGB = [ ...
+ 0.142 0.000 0.850; ...
+ 0.097 0.112 0.970; ...
+ 0.160 0.342 1.000; ...
+ 0.240 0.531 1.000; ...
+ 0.340 0.692 1.000; ...
+ 0.460 0.829 1.000; ...
+ 0.600 0.920 1.000; ...
+ 0.740 0.978 1.000; ...
+ 0.920 1.000 1.000; ...
+ 1.000 1.000 1.000; ...
+ 1.000 1.000 0.920; ...
+ 1.000 0.948 0.740; ...
+ 1.000 0.840 0.600; ...
+ 1.000 0.676 0.460; ...
+ 1.000 0.472 0.340; ...
+ 1.000 0.240 0.240; ...
+ 0.970 0.155 0.210; ...
+ 0.850 0.085 0.187; ...
+ 0.650 0.000 0.130 ];
+
+HSV = [ ...
+250.000 1.000 0.850; ...
+239.000 0.900 0.970; ...
+227.000 0.840 1.000; ...
+217.000 0.760 1.000; ...
+208.000 0.660 1.000; ...
+199.000 0.540 1.000; ...
+192.000 0.400 1.000; ...
+185.000 0.260 1.000; ...
+180.000 0.080 1.000; ...
+ 60.000 0.080 1.000; ...
+ 48.000 0.260 1.000; ...
+ 36.000 0.400 1.000; ...
+ 24.000 0.540 1.000; ...
+ 12.000 0.660 1.000; ...
+ 0.000 0.760 1.000; ...
+356.000 0.840 0.970; ...
+352.000 0.900 0.850; ...
+348.000 1.000 0.650 ];
+
+CMYK = [ ...
+ 0.708 0.850 0.000 0.150; ...
+ 0.873 0.858 0.000 0.030; ...
+ 0.840 0.658 0.000 0.000; ...
+ 0.760 0.469 0.000 0.000; ...
+ 0.660 0.308 0.000 0.000; ...
+ 0.540 0.171 0.000 0.000; ...
+ 0.400 0.080 0.000 0.000; ...
+ 0.260 0.022 0.000 0.000; ...
+ 0.080 0.000 0.000 0.000; ...
+ 0.000 0.000 0.080 0.000; ...
+ 0.000 0.052 0.260 0.000; ...
+ 0.000 0.160 0.400 0.000; ...
+ 0.000 0.324 0.540 0.000; ...
+ 0.000 0.528 0.660 0.000; ...
+ 0.000 0.760 0.760 0.000; ...
+ 0.000 0.815 0.760 0.030; ...
+ 0.000 0.765 0.663 0.150; ...
+ 0.000 0.650 0.520 0.350 ];
+
+colors = RGB;
+
+%
+% $URL$
+% $Revision$
+% $Date$
diff --git a/diagnostics/matlab/private/brown_to_blue.m b/diagnostics/matlab/private/brown_to_blue.m
new file mode 100644
index 0000000000..87bab37744
--- /dev/null
+++ b/diagnostics/matlab/private/brown_to_blue.m
@@ -0,0 +1,59 @@
+function colors = brown_to_blue()
+% Brown to Blue, 12 steps
+%
+% 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
+%
+% DART $Id$
+
+RGB = [ ...
+ 0.200 0.100 0.000; ...
+ 0.400 0.187 0.000; ...
+ 0.600 0.379 0.210; ...
+ 0.800 0.608 0.480; ...
+ 0.850 0.688 0.595; ...
+ 0.950 0.855 0.808; ...
+ 0.800 0.993 1.000; ...
+ 0.600 0.973 1.000; ...
+ 0.400 0.940 1.000; ...
+ 0.200 0.893 1.000; ...
+ 0.000 0.667 0.800; ...
+ 0.000 0.480 0.600];
+
+
+HSV = [ ...
+ 30.000 1.000 0.200; ...
+ 28.000 1.000 0.400; ...
+ 26.000 0.650 0.600; ...
+ 24.000 0.400 0.800; ...
+ 22.000 0.300 0.850; ...
+ 20.000 0.150 0.950; ...
+ 182.000 0.200 1.000; ...
+ 184.000 0.400 1.000; ...
+ 186.000 0.600 1.000; ...
+ 188.000 0.800 1.000; ...
+ 190.000 1.000 0.800; ...
+ 192.000 1.000 0.600];
+
+
+CMYK = [ ...
+ 0.000 0.100 0.200 0.800; ...
+ 0.000 0.213 0.400 0.600; ...
+ 0.000 0.221 0.390 0.400; ...
+ 0.000 0.192 0.320 0.200; ...
+ 0.000 0.162 0.255 0.150; ...
+ 0.000 0.095 0.142 0.050; ...
+ 0.200 0.007 0.000 0.000; ...
+ 0.400 0.027 0.000 0.000; ...
+ 0.600 0.060 0.000 0.000; ...
+ 0.800 0.107 0.000 0.000; ...
+ 0.800 0.133 0.000 0.200; ...
+ 0.600 0.120 0.000 0.400];
+
+colors = RGB;
+
+%
+% $URL$
+% $Revision$
+% $Date$
diff --git a/diagnostics/matlab/private/get_DARTvars.m b/diagnostics/matlab/private/get_DARTvars.m
index 5d7b2a0c75..7962af51e5 100644
--- a/diagnostics/matlab/private/get_DARTvars.m
+++ b/diagnostics/matlab/private/get_DARTvars.m
@@ -5,13 +5,13 @@
% the result is a cell array of strings ... must use {} notation to address elements.
%
% EXAMPLE:
-% fname = 'obs_seq.final.nc';
+% fname = 'preassim.nc';
% DARTvars = get_DARTvars(fname);
% DARTvars{:}
% nvars = length(DARTvars);
% disp(sprintf('first atmospheric variable (of %d) is %s',nvars,DARTvars{1}))
-%% DART software - Copyright UCAR. This open source software is provided
+% 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
%
@@ -33,6 +33,15 @@
% Reject the obvious metadata variable
varname = fileinfo.Variables(i).Name;
if (strcmp(varname, 'MemberMetadata')), isDARTvar(i) = 0; end
+
+ % Anything with a 'copy' dimension is probably a DART state vector variable.
+ dimname = fileinfo.Variables(i).Dimensions(idim).Name;
+ if (strcmp(dimname,'copy')), isDARTvar(i) = 1; end
+
+ % Reject the obvious metadata variable
+ varname = fileinfo.Variables(i).Name;
+ if (strcmp(varname, 'CopyMetaData')), isDARTvar(i) = 0; end
+
end
% If the variable is 1D and the name and the dimension name are the same,
@@ -59,6 +68,7 @@
end
% Each of the candidate variables may have a _mean or _sd counterpart
+% TJH ... not sure why this is here ...
% varind = nDARTvars;
% extensions = {'mean','sd','priorinf_mean', 'priorinf_sd','postinf_mean','postinf_sd'};
diff --git a/diagnostics/matlab/private/get_copy_index.m b/diagnostics/matlab/private/get_copy_index.m
index 031e1344a1..551f4a925e 100644
--- a/diagnostics/matlab/private/get_copy_index.m
+++ b/diagnostics/matlab/private/get_copy_index.m
@@ -1,6 +1,6 @@
-function copy_index = get_copy_index(fname, copystring, context)
+function copy_index = get_copy_index(fname, copystring, varargin)
%% GET_COPY_INDEX Gets an index corresponding to copy metadata string
-% Retrieves index associated with a given string in the
+% Retrieves index associated with a given string in the
% CopyMetaData netCDF variable in the given file. If the string
% does not exist - a fatal error is thrown.
%
@@ -8,6 +8,11 @@
% fname = 'obs_diag_output.nc';
% copystring = 'N_DARTqc_5';
% copy_index = get_copy_index(fname, copystring);
+%
+% If you prefer the error to be non-fatal, you can do that too.
+% If the index does not exist, the copy_index will be -1
+% Example:
+% copy_index = get_copy_index(fname, copystring, 'fatal', false);
%% DART software - Copyright UCAR. This open source software is provided
% by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,13 +20,33 @@
%
% DART $Id$
+defaultContext = [];
+defaultFatality = true;
+defaultVerbose = false;
+
+p = inputParser;
+addRequired(p,'fname',@ischar);
+addRequired(p,'copystring',@ischar);
+
+if (exist('inputParser/addParameter','file') == 2)
+ addParameter(p,'context',defaultContext, @ischar);
+ addParameter(p,'fatal', defaultFatality,@islogical);
+ addParameter(p,'verbose',defaultVerbose, @islogical);
+else
+ addParamValue(p,'context',defaultContext, @ischar);
+ addParamValue(p,'fatal', defaultFatality,@islogical);
+ addParamValue(p,'verbose',defaultVerbose, @islogical);
+end
+
+p.parse(fname, copystring, varargin{:});
+
errorstring = sprintf('\nERROR: "%s" is not a valid CopyMetaData value for file %s\n', ...
- strtrim(copystring), fname);
+ strtrim(p.Results.copystring), p.Results.fname);
-if (nargin == 3)
- msgstring = sprintf('valid values for "%s" are', context);
+if (isempty(p.Results.context))
+ msgstring = 'valid values for CopyMetaData are';
else
- msgstring = 'valid values for CopyMetaData are';
+ msgstring = sprintf('valid CopyMetaData values for "%s" are', p.Results.context);
end
if ( exist(fname,'file') ~= 2 ), error('%s does not exist.',fname); end
@@ -41,21 +66,21 @@
copy_index = -1;
for i = 1:num_copies,
- % for matching -- we want to ignore whitespace -- find it & remove it
- nowhitemd = dewhite(copy_meta_data(i,:));
+ % for matching -- we want to ignore whitespace -- find it & remove it
+ nowhitemd = dewhite(copy_meta_data(i,:));
- if strcmp(nowhitemd , nowhitecs) == 1
- copy_index = i;
- end
+ if strcmp(nowhitemd , nowhitecs) == 1
+ copy_index = i;
+ end
end
% Provide modest error support
-if (copy_index < 0)
- for i = 1:num_copies,
- msgstring = sprintf('%s\n%s',msgstring,deblank(copy_meta_data(i,:)));
- end
- error(sprintf('%s\n%s',errorstring,msgstring))
+if (copy_index < 0 && p.Results.fatal)
+ for i = 1:num_copies,
+ msgstring = sprintf('%s\n%s',msgstring,deblank(copy_meta_data(i,:)));
+ end
+ error('%s\n%s',errorstring,msgstring)
end
diff --git a/diagnostics/matlab/private/get_qc_values.m b/diagnostics/matlab/private/get_qc_values.m
new file mode 100644
index 0000000000..ceddf7389b
--- /dev/null
+++ b/diagnostics/matlab/private/get_qc_values.m
@@ -0,0 +1,108 @@
+function qcvalues = get_qc_values(fname, varname, varargin)
+%%
+
+%% 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
+%
+% DART $Id$
+
+defaultRegion = [];
+defaultLevel = [];
+defaultTimeStep = [];
+defaultVerbose = false;
+defaultFatal = true;
+
+p = inputParser;
+addRequired(p,'fname',@ischar);
+addRequired(p,'varname',@ischar);
+
+if (exist('inputParser/addParameter','file') == 2)
+ addParameter(p,'regionindex',defaultRegion,@isnumeric);
+ addParameter(p,'levelindex',defaultLevel,@isnumeric);
+ addParameter(p,'timeindex',defaultTimeStep,@isnumeric);
+ addParameter(p,'verbose',defaultVerbose,@islogical);
+ addParameter(p,'fatal',defaultFatal,@islogical);
+else
+ addParamValue(p,'regionindex',defaultRegion,@isnumeric);
+ addParamValue(p,'levelindex',defaultLevel,@isnumeric);
+ addParamValue(p,'timeindex',defaultTimeStep,@isnumeric);
+ addParamValue(p,'verbose',defaultVerbose,@islogical);
+ addParamValue(p,'fatal',defaultFatal,@islogical);
+end
+
+p.parse(fname, varname, varargin{:});
+
+myinfo.diagn_file = p.Results.fname;
+
+regionstring = 'all regions';
+levelstring = 'all levels';
+timestring = 'all times';
+
+if ~isempty(p.Results.regionindex)
+ myinfo.regionindex = p.Results.regionindex;
+ regionstring = sprintf('region %d',myinfo.regionindex);
+end
+
+if ~isempty(p.Results.levelindex)
+ myinfo.levelindex = p.Results.levelindex;
+ levelstring = sprintf('level %d',myinfo.levelindex);
+end
+
+if ~isempty(p.Results.timeindex)
+ myinfo.timeindex = p.Results.timeindex;
+ timestring = sprintf('time %d',myinfo.timeindex);
+end
+
+qcvalues = struct('fname',fname,'varname',varname);
+
+myinfo.copyindex = get_copy_index(fname, 'Nposs');
+[start, count] = GetNCindices(myinfo,'diagn',varname);
+nposs = ncread(fname, varname, start, count);
+
+myinfo.copyindex = get_copy_index(fname, 'Nused');
+[start, count] = GetNCindices(myinfo,'diagn',varname);
+nused = ncread(fname, varname, start, count);
+
+for qc = 0:8
+ myinfo.copyindex = get_copy_index(fname, sprintf('N_DARTqc_%d',qc),'fatal',p.Results.fatal);
+
+ if (myinfo.copyindex > 0)
+ [start, count] = GetNCindices(myinfo,'diagn',varname);
+ cmd = sprintf('qcvalues.Nqc%d = ncread(fname, varname, start, count);',qc);
+ eval(cmd)
+ end
+end
+
+qcvalues.nposs = nposs - qcvalues.Nqc5 - qcvalues.Nqc6;
+qcvalues.nused = nused;
+qcvalues.num_evaluated = qcvalues.Nqc1 + qcvalues.Nqc3;
+
+%=====================================================================
+
+if (~ p.Results.verbose), return; end
+
+%=====================================================================
+
+if (exist('levelstring','var')==1)
+
+ fprintf('\n %s %s %s %s\n',varname, regionstring, levelstring, timestring);
+
+end
+
+fprintf('DART QC == 0, n = %d\n',sum(qcvalues.Nqc0(:)))
+fprintf('DART QC == 1, n = %d\n',sum(qcvalues.Nqc1(:)))
+fprintf('DART QC == 2, n = %d\n',sum(qcvalues.Nqc2(:)))
+fprintf('DART QC == 3, n = %d\n',sum(qcvalues.Nqc3(:)))
+fprintf('DART QC == 4, n = %d\n',sum(qcvalues.Nqc4(:)))
+fprintf('DART QC == 5, n = %d\n',sum(qcvalues.Nqc5(:)))
+fprintf('DART QC == 6, n = %d\n',sum(qcvalues.Nqc6(:)))
+fprintf('DART QC == 7, n = %d\n',sum(qcvalues.Nqc7(:)))
+if (isfield(qcvalues,'Nqc8'))
+ fprintf('DART QC == 8, n = %d\n',sum(qcvalues.Nqc8(:)))
+end
+
+%
+% $URL$
+% $Revision$
+% $Date$
diff --git a/diagnostics/matlab/private/matchingYticks.m b/diagnostics/matlab/private/matchingYticks.m
index 1c1f4a49d2..a2a8b562d2 100644
--- a/diagnostics/matlab/private/matchingYticks.m
+++ b/diagnostics/matlab/private/matchingYticks.m
@@ -43,8 +43,8 @@ function matchingYticks(ax1, ax2)
% Rescale the magnitude and span if the span is to small to be useful.
if ((nYticks -1 - yrange_span) > delta )
- yrange_span = yrange_span * 10;
- yrange_magnitude = yrange_magnitude - 1;
+ yrange_span = yrange_span * 10;
+ yrange_magnitude = yrange_magnitude - 1;
end
% Here's the distance between obs ticks, in units of # of observations.
diff --git a/diagnostics/matlab/private/read_obsdiag_staticdata.m b/diagnostics/matlab/private/read_obsdiag_staticdata.m
new file mode 100644
index 0000000000..764e8d60a1
--- /dev/null
+++ b/diagnostics/matlab/private/read_obsdiag_staticdata.m
@@ -0,0 +1,78 @@
+function plotdat = read_obsdiag_staticdata(fname, copy)
+%% read the static data from the netCDF output of threed_sphere/obs_diag
+
+%% 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
+%
+% DART $Id$
+
+plotdat = struct('fname',fname,'copystring',copy);
+
+plotdat.bincenters = double(ncread(fname,'time'));
+plotdat.binedges = double(ncread(fname,'time_bounds'));
+plotdat.mlevel = local_ncread(fname,'mlevel');
+plotdat.plevel = local_ncread(fname,'plevel');
+plotdat.plevel_edges = local_ncread(fname,'plevel_edges');
+plotdat.hlevel = local_ncread(fname,'hlevel');
+plotdat.hlevel_edges = local_ncread(fname,'hlevel_edges');
+[plotdat.ncopies, ~] = nc_dim_info(fname,'copy');
+[plotdat.nregions, ~] = nc_dim_info(fname,'region');
+plotdat.region_names = strtrim(ncread(fname,'region_names')');
+
+plotdat.dimensionality = nc_read_att(fname, '/', 'LocationRank');
+plotdat.binseparation = nc_read_att(fname, '/', 'bin_separation');
+plotdat.binwidth = nc_read_att(fname, '/', 'bin_width');
+plotdat.lonlim1 = nc_read_att(fname, '/', 'lonlim1');
+plotdat.lonlim2 = nc_read_att(fname, '/', 'lonlim2');
+plotdat.latlim1 = nc_read_att(fname, '/', 'latlim1');
+plotdat.latlim2 = nc_read_att(fname, '/', 'latlim2');
+plotdat.biasconv = nc_read_att(fname, '/', 'bias_convention');
+
+plotdat.copyindex = get_copy_index(fname,copy);
+plotdat.rmseindex = get_copy_index(fname,'rmse');
+plotdat.biasindex = get_copy_index(fname,'bias');
+
+% Coordinate between time types and dates
+
+time_to_skip = double(nc_read_att(fname, '/', 'time_to_skip'));
+timeunits = nc_read_att(fname,'time','units');
+timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
+timeorigin = datenum(timebase(1),timebase(2),timebase(3));
+
+if isempty(time_to_skip)
+ iskip = 0.0;
+elseif ( numel(time_to_skip) == 6)
+ skip_seconds = time_to_skip(4)*3600 + time_to_skip(5)*60 + time_to_skip(6);
+ iskip = time_to_skip(3) + skip_seconds/86400.0;
+else
+ error('time_to_skip variable has unusual length. Should be either 0 or 6.')
+end
+
+% Set up a structure to use for plotting
+
+plotdat.bincenters = plotdat.bincenters + timeorigin;
+plotdat.binedges = plotdat.binedges + timeorigin;
+plotdat.Nbins = length(plotdat.bincenters);
+plotdat.toff = plotdat.binedges(1) + iskip;
+plotdat.timespan = sprintf('%s through %s', datestr(plotdat.toff), ...
+ datestr(max(plotdat.binedges(:))));
+
+%=====================================================================
+
+function value = local_ncread(fname,varname)
+%% If the variable exists in the file, return the contents of the variable.
+% if the variable does not exist, return empty value instead of error-ing
+% out.
+
+[variable_present, ~] = nc_var_exists(fname,varname);
+if (variable_present)
+ value = ncread(fname,varname);
+else
+ value = [];
+end
+
+%
+% $URL$
+% $Revision$
+% $Date$
diff --git a/diagnostics/matlab/private/set_obsdiag_figure.m b/diagnostics/matlab/private/set_obsdiag_figure.m
new file mode 100644
index 0000000000..7d01971d96
--- /dev/null
+++ b/diagnostics/matlab/private/set_obsdiag_figure.m
@@ -0,0 +1,102 @@
+function figdata = set_obsdiag_figure(orientation,varargin)
+%%
+% figure out a page layout
+% extra space at the bottom for the date/file annotation
+% extra space at the top because the titles have multiple lines
+%
+%% 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
+%
+% DART $Id$
+
+default_nexp = 1; % The number of experiments
+p = inputParser;
+
+addRequired(p,'orientation',@ischar);
+
+if (exist('inputParser/addParameter','file') == 2)
+ addParameter(p,'numexp', default_nexp, @isnumeric);
+else
+ addParamValue(p,'numexp',default_nexp, @isnumeric); %#ok
+end
+
+p.parse(orientation,varargin{:});
+
+nexp = p.Results.numexp;
+
+if ~isempty(fieldnames(p.Unmatched))
+ disp('Extra inputs:')
+ disp(p.Unmatched)
+end
+
+if strncmpi(orientation,'tall',4)
+ orientation = 'tall';
+ position = [0.15 0.12 0.7 0.75];
+
+ if (nexp > 1) % to replicate the 'two_experiments' behaviour
+ ybot = 0.06 + nexp*0.035; % room for dates/files
+ ytop = 0.125; % room for title (always 2 lines)
+ dy = 1.0 - ytop - ybot;
+ position = [0.15 ybot 0.7 dy];
+ end
+
+else
+ orientation = 'landscape';
+ position = [0.10 0.15 0.8 0.7];
+
+ if (nexp > 1) % to replicate the 'two_experiments' behaviour
+ ybot = 0.06 + nexp*0.075; % room for dates/files
+ ytop = 0.125; % room for title (always 2 lines)
+ dy = 1.0 - ytop - ybot;
+ position = [0.10 ybot 0.8 dy];
+ end
+
+end
+
+fontsize = 16;
+linewidth = 2.5;
+obs_color = [215/255 10/255 83/255]; % obs_red
+ges_color = [ 0/255 128/255 0/255]; % prior_green
+anl_color = [ 0/255 0/255 255/255]; % poste_blue
+rmse_color = [ 0/255 0/255 0/255]; % black
+copy_color = [ 0/255 128/255 128/255]; % teal
+purple = [ 153,51,255 ]/255;
+orange = [ 255,153,51 ]/255;
+obs_marker = 'o';
+ges_marker = '*';
+anl_marker = 'd';
+marker1 = 'o';
+marker2 = 's';
+ges_linestyle = '-';
+anl_linestyle = '-';
+dashed = '--';
+solid = '-';
+
+figdata = struct( ...
+ 'expcolors', {{'k','b','m','g','c','y','r'}}, ...
+ 'expsymbols', {{'o','s','d','p','h','s','*'}}, ...
+ 'prpolines', {{'-','--'}}, ...
+ 'position' , position, ...
+ 'fontsize' , fontsize, ...
+ 'orientation' , orientation, ...
+ 'linewidth' , linewidth, ...
+ 'obs_color' , obs_color, ...
+ 'ges_color' , ges_color, ...
+ 'anl_color' , anl_color, ...
+ 'rmse_color' , rmse_color, ...
+ 'copy_color' , copy_color, ...
+ 'obs_marker' , obs_marker, ...
+ 'ges_marker' , ges_marker, ...
+ 'anl_marker' , anl_marker, ...
+ 'marker1' , marker1, ...
+ 'marker2' , marker2, ...
+ 'ges_linestyle', ges_linestyle, ...
+ 'anl_linestyle', anl_linestyle, ...
+ 'dashed' , dashed, ...
+ 'solid' , solid );
+
+%
+% $URL$
+% $Revision$
+% $Date$
diff --git a/diagnostics/matlab/private/set_time_axis.m b/diagnostics/matlab/private/set_time_axis.m
new file mode 100644
index 0000000000..581f146236
--- /dev/null
+++ b/diagnostics/matlab/private/set_time_axis.m
@@ -0,0 +1,45 @@
+function timestring = set_time_axis(whichone,bincenters,DateForm)
+%%
+%
+
+%% 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
+%
+% DART $Id$
+
+if strncmpi(whichone,'x',1)
+ ax = 'x';
+else
+ ax = 'y';
+end
+
+ndays = max(bincenters(:)) - min(bincenters(:)) + 1;
+
+if (bincenters(1) > 1000) && (ndays > 5)
+ if strncmpi(DateForm,'default',7)
+ dateform = 'mm/dd';
+ else
+ dateform = DateForm;
+ end
+ datetick('x',dateform,'keeplimits','keepticks');
+ monstr = datestr(bincenters(1),21);
+ timestring = sprintf('%s start',monstr);
+elseif (bincenters(1) > 1000)
+ if strncmpi(DateForm,'default',7)
+ dateform = 'dd HH:MM';
+ else
+ dateform = DateForm;
+ end
+ datetick(ax,dateform,'keeplimits')
+ monstr = datestr(bincenters(1),21);
+ timestring = sprintf('%s start',monstr);
+else
+ timestring = 'days';
+end
+
+%
+% $URL$
+% $Revision$
+% $Date$
+
diff --git a/diagnostics/matlab/private/setfigure.m b/diagnostics/matlab/private/setfigure.m
new file mode 100644
index 0000000000..da9f57d8eb
--- /dev/null
+++ b/diagnostics/matlab/private/setfigure.m
@@ -0,0 +1,44 @@
+function figdata = setfigure(whichway)
+%%
+% figure out a page layout
+% extra space at the bottom for the date/file annotation
+% extra space at the top because the titles have multiple lines
+
+if (strncmpi(whichway,'land',4))
+ orientation = 'landscape';
+ position = [0.10 0.15 0.8 0.7];
+else
+ orientation = 'tall';
+ position = [0.15 0.12 0.7 0.75];
+end
+
+fontsize = 16;
+linewidth = 2.5;
+markersize = 8.0;
+ges_color = [ 0 128 0]/255; % prior_green
+anl_color = [ 0 0 255]/255; % poste_blue
+obs_color = [215 10 83]/255; % obs_red
+teal = [ 0 128 128]/255;
+ges_marker = '*';
+anl_marker = 'd';
+ges_linestyle = '-';
+anl_linestyle = '-';
+
+figdata = struct( ...
+ 'expcolors', {{'k','r','b','m','g','c','y'}}, ...
+ 'expsymbols', {{'o','s','d','p','h','s','*'}}, ...
+ 'prpolines', {{'-','--'}}, ...
+ 'position' , position, ...
+ 'fontsize' , fontsize, ...
+ 'orientation' , orientation, ...
+ 'linewidth' , linewidth, ...
+ 'markersize' , markersize, ...
+ 'ges_color' , ges_color, ...
+ 'anl_color' , anl_color, ...
+ 'obs_color' , obs_color, ...
+ 'teal' , teal, ...
+ 'ges_marker' , ges_marker, ...
+ 'anl_marker' , anl_marker, ...
+ 'ges_linestyle', ges_linestyle, ...
+ 'anl_linestyle', anl_linestyle );
+
diff --git a/diagnostics/matlab/read_obs_netcdf.m b/diagnostics/matlab/read_obs_netcdf.m
index 4597ef266a..bf510f2e1d 100644
--- a/diagnostics/matlab/read_obs_netcdf.m
+++ b/diagnostics/matlab/read_obs_netcdf.m
@@ -130,7 +130,7 @@
case 'all'
mytypeind = 1:ncopies;
otherwise
- mytypeind = get_copy_index(fname, CopyString, 'CopyString');
+ mytypeind = get_copy_index(fname, CopyString, 'context', 'CopyString');
end
%% Find observations of the correct type.
diff --git a/diagnostics/matlab/two_experiments_evolution.m b/diagnostics/matlab/two_experiments_evolution.m
index d7fa3efa75..1aa02c3359 100644
--- a/diagnostics/matlab/two_experiments_evolution.m
+++ b/diagnostics/matlab/two_experiments_evolution.m
@@ -18,7 +18,7 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
% For TRUSTED observations, this is different than the number used to calculate
% bias, rmse, spread, etc.
%
-% USAGE: two_experiments_evolution(files, titles, obsnames, copy, prpo, 'level', 1)
+% USAGE: two_experiments_evolution(files, titles, obsnames, copy, prpo [,varargin])
%
% files : Cell array containing the locations of the obs_diag_output.nc
% files to compare. Each file is presumed to be the results from
@@ -38,8 +38,24 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
% conscious decision not to support plotting both prior and posterior
% on the same plot.
%
+% varargin: optional parameter-value pairs. Supported parameters are described below.
+%
% level : The index of the level to plot. Defaults to level 1.
%
+% verbose : true/false to control amount of run-time output
+%
+% MarkerSize : integer controlling the size of the symbols
+%
+% DateForm : Free-form character string controlling representation of the time axis.
+% See 'help datetick' for discussion and valid values.
+% Example ones are 'mm/dd' and 'dd HH:MM'.
+%
+% pause : true/false to conrol pausing after each figure is created.
+% true will require hitting any key to continue to next plot
+%
+% range : 'range' of the value being plotted. Default is to
+% automatically determine range based on the data values.
+%
% OUTPUT: A .pdf of each graphic is created. Each .pdf has a name that
% reflects the variable, quantity, and region being plotted.
%
@@ -66,7 +82,12 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
% Decode,Parse,Check the input
%---------------------------------------------------------------------
-default_level = 1;
+default_verbosity = true;
+default_markersize = 12;
+default_pause = false;
+default_range = [NaN NaN];
+default_level = 1;
+default_dateform = 'default';
p = inputParser;
addRequired(p,'files',@iscell);
@@ -76,24 +97,32 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
addRequired(p,'prpo',@ischar);
if (exist('inputParser/addParameter','file') == 2)
- addParameter(p,'level',default_level,@isnumeric);
+ addParameter(p,'verbose', default_verbosity, @islogical);
+ addParameter(p,'MarkerSize', default_markersize, @isnumeric);
+ addParameter(p,'pause', default_pause, @islogical);
+ addParameter(p,'range', default_range, @isnumeric);
+ addParameter(p,'level', default_level, @isnumeric);
+ addParameter(p,'DateForm', default_dateform, @ischar);
else
- addParamValue(p,'level',default_level,@isnumeric);
+ addParamValue(p,'verbose', default_verbosity, @islogical); %#ok
+ addParamValue(p,'MarkerSize',default_markersize, @isnumeric); %#ok
+ addParamValue(p,'pause', default_pause, @islogical); %#ok
+ addParamValue(p,'range', default_range, @isnumeric); %#ok
+ addParamValue(p,'level', default_level, @isnumeric); %#ok
+ addParamValue(p,'DateForm', default_dateform, @ischar); %#ok
end
p.parse(files, titles, obsnames, copy, prpo, varargin{:});
-% if you want to echo the input
-% disp(['files : ', p.Results.files])
-% disp(['titles : ', p.Results.titles])
-% disp(['obsnames: ', p.Results.obsnames])
-% fprintf('level : %d \n', p.Results.level)
-
if ~isempty(fieldnames(p.Unmatched))
disp('Extra inputs:')
disp(p.Unmatched)
end
+if (numel(p.Results.range) ~= 2)
+ error('range must be an array of length two ... [bottom top]')
+end
+
NumExp = length(files);
for i = 1:NumExp
@@ -108,8 +137,14 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
%% set up all the stuff that is common.
-commondata = check_compatibility(files, obsnames, copy);
-figuredata = setfigure(NumExp);
+global figuredata verbose
+
+commondata = check_compatibility(files, prpo, obsnames, copy);
+figuredata = set_obsdiag_figure('landscape','numexp',NumExp);
+figuredata.MarkerSize = p.Results.MarkerSize;
+figuredata.DateForm = p.Results.DateForm;
+verbose = p.Results.verbose;
+plotobj = cell(NumExp,1);
%%--------------------------------------------------------------------
% Set some static data
@@ -129,7 +164,6 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
figure(iregion);
clf(iregion);
orient(figuredata.orientation);
- wysiwyg;
%---------------------------------------------------------------------
% 1) Get the data for each experiment
@@ -139,24 +173,30 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
for iexp = 1:NumExp
- plotobj{iexp} = getvals(files{iexp}, obsnames{ivar}, copy, prpo, iregion, p.Results.level);
+ plotobj{iexp} = getvals(files{iexp}, commondata.targets{ivar}, copy, iregion, p.Results.level);
plotobj{iexp}.title = titles{iexp};
plotobj{iexp}.nregions = commondata.nregions;
plotobj{iexp}.region_names = commondata.region_names;
+ plotobj{iexp}.phase = commondata.phase;
end
- myplot(plotobj, figuredata);
+ myplot(plotobj);
BottomAnnotation(plotobj)
psfname = sprintf('%s_%s_region%d_ilev%d_evolution_%dexp', ...
obsnames{ivar}, plotobj{1}.copystring, iregion, p.Results.level, NumExp);
- print(iregion,'-dpdf',psfname)
+
+ if verLessThan('matlab','R2016a')
+ print(iregion, '-dpdf', psfname)
+ else
+ print(iregion, '-dpdf', '-bestfit', psfname)
+ end
end % of loop around regions
- if ( ivar ~= nvars )
+ if ( ivar ~= nvars && p.Results.pause )
disp('Pausing, hit any key to continue ...')
pause
end
@@ -171,7 +211,7 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
-function common = check_compatibility(filenames, varnames, copystring)
+function common = check_compatibility(filenames, prpo, varnames, copystring)
%% Trying to prevent the comparison of apples and oranges.
% make sure the diagnostics were generated the same way.
@@ -182,22 +222,30 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
mystat = 0;
nexp = length(filenames);
commondata = cell(1,nexp);
-priornames = struct([]);
-postenames = struct([]);
+targets = struct([]);
for i = 1:length(varnames)
- priornames{i} = sprintf('%s_guess',varnames{i});
- postenames{i} = sprintf('%s_analy',varnames{i});
+ switch lower(prpo)
+ case {'guess','forecast','prior'}
+ targets{i} = sprintf('%s_guess',varnames{i});
+ commondata{i}.phase = 'prior';
+ case {'analy','analysis','posterior'}
+ targets{i} = sprintf('%s_analy',varnames{i});
+ commondata{i}.phase = 'posterior';
+ otherwise
+ error('unknown prpo ... "%s"',prpo)
+ end
end
for i = 1:nexp
- varexist(filenames{i}, {priornames{:}, postenames{:}, 'time', 'time_bounds'})
+ varexist(filenames{i}, {targets{:}, 'time', 'time_bounds'}) %#ok
+ commondata{i}.targets = targets;
commondata{i}.region_names = strtrim(ncread(filenames{i},'region_names')');
commondata{i}.times = ncread(filenames{i}, 'time');
commondata{i}.time_bnds = ncread(filenames{i}, 'time_bounds');
- commondata{i}.copyindex = get_copy_index(filenames{i},copystring,'copy');
+ commondata{i}.copyindex = get_copy_index(filenames{i},copystring);
commondata{i}.ncopies = nc_dim_info(filenames{i}, 'copy');
commondata{i}.nobstypes = nc_dim_info(filenames{i}, 'obstypes');
commondata{i}.nregions = nc_dim_info(filenames{i}, 'region');
@@ -247,161 +295,79 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
%=====================================================================
-function plotdat = getvals(fname, varname, copystring, prpo, regionindex, levelindex )
+function plotdat = getvals(fname, varname, copystring, regionindex, levelindex )
%% Get the data for each experiment
if (exist(fname,'file') ~= 2)
error('%s does not exist',fname)
end
-plotdat.fname = fname;
-plotdat.varname = varname;
-plotdat.copystring = copystring;
-plotdat.region = regionindex;
-plotdat.levelindex = levelindex;
-plotdat.bincenters = ncread(fname,'time');
-plotdat.binedges = ncread(fname,'time_bounds');
-plotdat.mlevel = local_ncread(fname,'mlevel');
-plotdat.plevel = local_ncread(fname,'plevel');
-plotdat.plevel_edges = local_ncread(fname,'plevel_edges');
-plotdat.hlevel = local_ncread(fname,'hlevel');
-plotdat.hlevel_edges = local_ncread(fname,'hlevel_edges');
-plotdat.ncopies = nc_dim_info(fname,'copy');
-
-dimensionality = nc_read_att(fname, '/', 'LocationRank');
-plotdat.biasconv = nc_read_att(fname, '/', 'bias_convention');
-plotdat.binseparation = nc_read_att(fname, '/', 'bin_separation');
-plotdat.binwidth = nc_read_att(fname, '/', 'bin_width');
-plotdat.lonlim1 = nc_read_att(fname, '/', 'lonlim1');
-plotdat.lonlim2 = nc_read_att(fname, '/', 'lonlim2');
-plotdat.latlim1 = nc_read_att(fname, '/', 'latlim1');
-plotdat.latlim2 = nc_read_att(fname, '/', 'latlim2');
-
-% Coordinate between time types and dates
-
-timeunits = nc_read_att(fname,'time','units');
-calendar = nc_read_att(fname,'time','calendar');
-timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
-timeorigin = datenum(timebase(1),timebase(2),timebase(3));
-
-plotdat.bincenters = plotdat.bincenters + timeorigin;
-plotdat.binedges = plotdat.binedges + timeorigin;
-plotdat.Nbins = length(plotdat.bincenters);
-
-plotdat.timespan = sprintf('%s through %s', ...
- datestr(min(plotdat.binedges(:))), ...
- datestr(max(plotdat.binedges(:))));
-
-% Get the right indices for the intended variable, regardless of the storage order
-% as well as some indices of other quantities of interest for future use.
-
-plotdat.copyindex = get_copy_index(fname, copystring);
-plotdat.Npossindex = get_copy_index(fname, 'Nposs');
-plotdat.Nusedindex = get_copy_index(fname, 'Nused');
-plotdat.NQC4index = get_copy_index(fname, 'N_DARTqc_4');
-plotdat.NQC5index = get_copy_index(fname, 'N_DARTqc_5');
-plotdat.NQC6index = get_copy_index(fname, 'N_DARTqc_6');
-plotdat.NQC7index = get_copy_index(fname, 'N_DARTqc_7');
-plotdat.NQC8index = get_copy_index(fname, 'N_DARTqc_8');
-
-plotdat.priorvar = sprintf('%s_guess',plotdat.varname);
-plotdat.postevar = sprintf('%s_analy',plotdat.varname);
-
-plotdat.trusted = nc_read_att(fname, plotdat.priorvar, 'TRUSTED');
-if (isempty(plotdat.trusted)), plotdat.trusted = 'NO'; end
-
-myinfo.diagn_file = fname;
-myinfo.copyindex = plotdat.copyindex;
-myinfo.regionindex = plotdat.region;
-myinfo.levelindex = plotdat.levelindex;
+plotdat = read_obsdiag_staticdata(fname,copystring);
+plotdat.region = regionindex;
+plotdat.varname = varname;
% get appropriate vertical coordinate variable
-[dimnames, ~] = nc_var_dims(fname, plotdat.priorvar);
+[dimnames, ~] = nc_var_dims(fname, plotdat.varname);
-if ( dimensionality == 1 ) % observations on a unit circle, no level
- plotdat.level = 1;
+if ( plotdat.dimensionality == 1 ) % observations on a unit circle, no level
+ plotdat.levelindex = 1;
+ plotdat.level = 1;
plotdat.level_units = [];
elseif ( strfind(dimnames{2},'surface') > 0 )
+ plotdat.levelindex = 1;
plotdat.level = 1;
plotdat.level_units = 'surface';
plotdat.level_edges = [];
elseif ( strfind(dimnames{2},'undef') > 0 )
+ plotdat.levelindex = 1;
plotdat.level = 1;
plotdat.level_units = 'undefined';
plotdat.level_edges = [];
else
+ plotdat.levelindex = levelindex;
plotdat.level = ncread(fname, dimnames{2});
plotdat.level_units = nc_read_att(fname, dimnames{2}, 'units');
plotdat.level_edges = ncread(fname,sprintf('%s_edges',dimnames{2}));
end
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
-hyperslab = ncread(fname, plotdat.priorvar, start, count);
-plotdat.prior = squeeze(hyperslab);
-
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.postevar);
-hyperslab = ncread(fname, plotdat.postevar, start, count);
-plotdat.poste = squeeze(hyperslab);
+myinfo.diagn_file = fname;
+myinfo.copyindex = plotdat.copyindex;
+myinfo.regionindex = plotdat.region;
+myinfo.levelindex = plotdat.levelindex;
+[start, count] = GetNCindices(myinfo,'diagn',plotdat.varname);
+hyperslab = ncread(fname, plotdat.varname, start, count);
+plotdat.data = squeeze(hyperslab);
+plotdat.trusted = nc_read_att(fname, plotdat.varname, 'TRUSTED');
+if (isempty(plotdat.trusted)), plotdat.trusted = 'NO'; end
-%% Determine data limits - Do we use prior and/or posterior
+%% Determine data limits
% always make sure we have a zero bias line ...
-plotdat.useposterior = 0;
-plotdat.useprior = 0;
-switch lower(prpo)
- case {'analy','analysis','posterior'}
- plotdat.useposterior = 1;
- bob = plotdat.poste(:);
- case {'guess','forecast','prior'}
- plotdat.useprior = 1;
- bob = plotdat.prior(:);
- otherwise
- plotdat.useposterior = 1;
- plotdat.useprior = 1;
- bob = [plotdat.prior(:) ; plotdat.poste(:)]; % one long array
-end
-
switch copystring
case {'bias'}
- dmin = min( [ min(bob) 0.0 ] );
- dmax = max( [ max(bob) 0.0 ] );
+ dmin = min( [ min(plotdat.data) 0.0 ] );
+ dmax = max( [ max(plotdat.data) 0.0 ] );
plotdat.Drange = [ dmin dmax ];
plotdat.ylabel = sprintf('%s (%s)',copystring, plotdat.biasconv);
otherwise
- plotdat.Drange = [min(bob) max(bob)];
+ plotdat.Drange = [min(plotdat.data) max(plotdat.data)];
plotdat.ylabel = copystring;
end
-%% Get the number of observations possible and the number used.
-% N_DARTqc_5 is the number ignored because of namelist control.
-% N_DARTqc_6 is the number ignored because of incoming QC values.
-% It doesn't matter which prior/poste variable you get this information
-% from - they are both the same.
-
-myinfo.diagn_file = fname;
-myinfo.copyindex = plotdat.Npossindex;
-myinfo.levelindex = plotdat.levelindex;
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
-plotdat.nposs = squeeze(ncread(fname, plotdat.priorvar, start, count));
-
-myinfo.copyindex = plotdat.NQC5index;
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
-plotdat.Nqc5 = squeeze(ncread(fname, plotdat.priorvar, start, count));
-plotdat.nposs = plotdat.nposs - plotdat.Nqc5;
-
-myinfo.copyindex = plotdat.NQC6index;
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
-plotdat.Nqc6 = squeeze(ncread(fname, plotdat.priorvar, start, count));
-plotdat.nposs = plotdat.nposs - plotdat.Nqc6;
-
-if ( plotdat.useprior )
- myinfo.copyindex = plotdat.Nusedindex;
- [start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
- plotdat.nused = squeeze(ncread(fname, plotdat.priorvar, start, count));
+qcvalues = get_qc_values(fname, plotdat.varname, ...
+ 'regionindex', plotdat.region, ...
+ 'levelindex',plotdat.levelindex, ...
+ 'fatal', false, ...
+ 'verbose', false);
+
+plotdat.nposs = squeeze(qcvalues.nposs);
+plotdat.nused = squeeze(qcvalues.nused);
+plotdat.num_evaluated = squeeze(qcvalues.num_evaluated);
+
+if sum(plotdat.num_evaluated > 0)
+ plotdat.assim_eval_string = 'evaluated';
else
- myinfo.copyindex = plotdat.Nusedindex;
- [start, count] = GetNCindices(myinfo,'diagn',plotdat.postevar);
- plotdat.nused = squeeze(ncread(fname, plotdat.postevar, start, count));
+ plotdat.assim_eval_string = 'assimilated';
end
%% Set the last of the ranges
@@ -412,69 +378,59 @@ function two_experiments_evolution(files, titles, obsnames, copy, prpo, varargin
%=====================================================================
-function myplot(plotobj, figdata)
+function myplot(plotobj)
%% myplot Creates a graphic for one region
+global figuredata
+
Nexp = length(plotobj);
%% Create the background
-ax1 = subplot('position',figdata.position);
-set(ax1,'YAxisLocation','left','FontSize',figdata.fontsize)
+ax1 = subplot('position',figuredata.position);
+set(ax1,'YAxisLocation','left','FontSize',figuredata.fontsize)
%% draw the results of the experiments, priors and posteriors
% each with their own line type.
-iexp = 0;
hd = []; % handle to an unknown number of data lines
legstr = {[]}; % strings for the legend
for i = 1:Nexp
- if ( plotobj{i}.useprior )
- iexp = iexp + 1;
- hd(iexp) = line(plotobj{i}.bincenters, plotobj{i}.prior, ...
- 'Color', figdata.expcolors{i}, ...
- 'Marker', figdata.expsymbols{i}, ...
- 'LineStyle',figdata.prpolines{1}, ...
- 'LineWidth', figdata.linewidth,'Parent',ax1);
- legstr{iexp} = sprintf('%s Prior',plotobj{i}.title);
- end
+ hd(i) = line(plotobj{i}.bincenters, plotobj{i}.data, 'Parent', ax1); %#ok
- if ( plotobj{i}.useposterior )
- iexp = iexp + 1;
- hd(iexp) = line(plotobj{i}.bincenters, plotobj{i}.poste, ...
- 'Color', figdata.expcolors{i}, ...
- 'Marker', figdata.expsymbols{i}, ...
- 'LineStyle',figdata.prpolines{2}, ...
- 'LineWidth',figdata.linewidth,'Parent',ax1);
- legstr{iexp} = sprintf('%s Posterior',plotobj{i}.title);
- end
+ set(hd(i), 'Color', figuredata.expcolors{i}, ...
+ 'Marker', figuredata.expsymbols{i}, ...
+ 'MarkerFaceColor', figuredata.expcolors{i}, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'LineStyle', figuredata.prpolines{1}, ...
+ 'LineWidth', figuredata.linewidth);
+
+ % calculate the weighted mean for a summary. Each experiment
+ % may use different numbers of observations, so a simple mean
+ % may be misleading.
+
+ N = sum(plotobj{i}.nused,'omitnan');
+ X = sum(plotobj{i}.data .* plotobj{i}.nused,'omitnan')/N;
+
+ legstr{i} = sprintf('%s ... mean = %s',plotobj{i}.title,num2str(X));
end
% Plot a bias line.
switch plotobj{1}.copystring
case {'bias'}
- zeroline = line(get(ax1,'XLim'),[0 0],'Color',[0 100 0]/255,'Parent',ax1);
+ zeroline = line(get(ax1,'XLim'),[0 0],'Color',[200 200 200]/255,'Parent',ax1);
set(zeroline,'LineWidth',2.5,'LineStyle','-')
otherwise
end
-% hokey effort to decide to plot months/days vs. daynum vs.
-ttot = plotobj{1}.bincenters(plotobj{1}.Nbins) - plotobj{1}.bincenters(1) + 1;
-
-if ((plotobj{1}.bincenters(1) > 1000) && (ttot > 5))
- datetick('x',6,'keeplimits','keepticks');
- monstr = datestr(plotobj{1}.bincenters(1),21);
- xlabelstring = sprintf('month/day - %s start',monstr);
-elseif (plotobj{1}.bincenters(1) > 1000)
- datetick('x',15,'keeplimits','keepticks')
- monstr = datestr(plotobj{1}.bincenters(1),21);
- xlabelstring = sprintf('%s start',monstr);
-else
- xlabelstring = 'days';
-end
+% effort to use user-supplied value for time labelling or
+% make a stab at a useful default.
+
+set_time_axis('x', plotobj{i}.bincenters, figuredata.DateForm);
% Create another axes to use for plotting the observation counts
+% using a black axis because there is no single observation color.
ax2 = axes( ...
'Position',get(ax1,'Position'), ...
@@ -484,18 +440,24 @@ function myplot(plotobj, figdata)
'XTick' ,get(ax1,'XTick'), ...
'YDir' ,get(ax1,'YDir'), ...
'Color' ,'none', ...
- 'YColor' ,'b', ...
+ 'YColor' ,'k', ...
'XAxisLocation','top', ...
'YAxisLocation','right');
% Plot the data, which sets the range of the axis
for i = 1:Nexp
- h2 = line(plotobj{i}.bincenters, plotobj{i}.nposs, ...
- 'Color',figdata.expcolors{i},'Parent',ax2);
- h3 = line(plotobj{i}.bincenters, plotobj{i}.nused, ...
- 'Color',figdata.expcolors{i},'Parent',ax2);
- set(h2,'LineStyle','none','Marker','o','MarkerSize',10);
- set(h3,'LineStyle','none','Marker','*','MarkerSize',10);
+ ax2h1 = line(plotobj{i}.bincenters, plotobj{i}.nposs, 'Parent',ax2);
+ ax2h2 = line(plotobj{i}.bincenters, plotobj{i}.nused, 'Parent',ax2);
+
+ set(ax2h1,'LineStyle','none', ...
+ 'Color', figuredata.expcolors{i}, ...
+ 'Marker', figuredata.obs_marker, ...
+ 'MarkerSize', figuredata.MarkerSize);
+
+ set(ax2h2,'LineStyle','none', ...
+ 'Color', figuredata.expcolors{i}, ...
+ 'Marker', figuredata.ges_marker, ...
+ 'MarkerSize', figuredata.MarkerSize);
end
% turn off topside X tick labels (clashes with title)
@@ -504,37 +466,38 @@ function myplot(plotobj, figdata)
matchingYticks(ax1,ax2);
% Annotate. Trying to maximize content, minimize clutter.
-annotate( ax1, ax2, plotobj{1}, figdata)
+annotate( ax1, ax2, plotobj{1})
lh = legend(hd,legstr);
-set(lh,'Interpreter','none','Box','off');
-
-% The legend linesizes should match - 2 is hardwired - suprises me.
-
-set(lh,'FontSize',figdata.fontsize);
-kids = get(lh,'Children');
-set(kids,'LineWidth',figdata.linewidth);
+set(lh,'Interpreter','none','Box','off','FontSize',figuredata.fontsize);
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+else
+ lh.AutoUpdate = 'off';
+end
%=====================================================================
-function annotate(ax1, ax2, plotobj, figdata)
+function annotate(ax1, ax2, plotobj)
%% One figure ... everything gets annotated.
+global figuredata
+
set(get(ax1,'Xlabel'),'String',plotobj.timespan, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
-if ( plotobj.useprior )
- ylabel = sprintf('forecast %s',plotobj.ylabel);
-else
- ylabel = sprintf('analysis %s',plotobj.ylabel);
-end
+ylabel = sprintf('%s (%s)',plotobj.ylabel, plotobj.phase);
set(get(ax1,'Ylabel'),'String',ylabel, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
-set(get(ax2,'Ylabel'),'String','# of obs (o=possible, \ast=assimilated)', ...
- 'FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
+
+string1 = sprintf('# of obs (o=possible, %s=%s)', '\ast', plotobj.assim_eval_string);
+
+set(get(ax2,'Ylabel'), 'String', string1, 'FontSize', figuredata.fontsize)
if ( isempty(plotobj.level_units) )
th = title({deblank(plotobj.region_names(plotobj.region,:)), ...
@@ -544,7 +507,7 @@ function annotate(ax1, ax2, plotobj, figdata)
sprintf('%s @ %d %s', plotobj.varname, plotobj.level(plotobj.levelindex), ...
plotobj.level_units)});
end
-set(th,'Interpreter','none','FontSize',figdata.fontsize,'FontWeight','bold');
+set(th,'Interpreter','none','FontSize',figuredata.fontsize,'FontWeight','bold');
%=====================================================================
@@ -615,48 +578,6 @@ function varexist(filename, varnames)
end
-%=====================================================================
-
-
-function figdata = setfigure(nexp)
-%% try to set the axes into nicer-looking sizes with room for annotation.
-% figure out a page layout
-% extra space at the bottom for the date/file annotation
-% extra space at the top because the titles have multiple lines
-
-ybot = 0.06 + nexp*0.075; % room for dates/files
-ytop = 0.125; % room for title (always 2 lines)
-dy = 1.0 - ytop - ybot;
-orientation = 'landscape';
-fontsize = 16;
-position = [0.10 ybot 0.8 dy];
-linewidth = 2.0;
-
-figdata = struct('expcolors', {{'k','r','b','m','g','c','y'}}, ...
- 'expsymbols', {{'o','s','d','p','h','s','*'}}, ...
- 'prpolines', {{'-','--'}}, 'position', position, ...
- 'fontsize',fontsize, 'orientation',orientation, ...
- 'linewidth',linewidth);
-
-
-%=====================================================================
-
-
-function value = local_ncread(fname,varname)
-%% If the variable exists in the file, return the contents of the variable.
-% if the variable does not exist, return empty value instead of error-ing
-% out.
-
-[variable_present, varid] = nc_var_exists(fname,varname);
-if (variable_present)
- ncid = netcdf.open(fname,'NOWRITE');
- value = netcdf.getVar(ncid, varid);
- netcdf.close(ncid)
-else
- value = [];
-end
-
-
%
% $URL$
% $Revision$
diff --git a/diagnostics/matlab/two_experiments_profile.m b/diagnostics/matlab/two_experiments_profile.m
index b753f28178..1506de415e 100644
--- a/diagnostics/matlab/two_experiments_profile.m
+++ b/diagnostics/matlab/two_experiments_profile.m
@@ -39,8 +39,19 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
% conscious decision not to support plotting both prior and posterior
% on the same plot.
%
+% varargin: optional parameter-value pairs. Supported parameters are described below.
+%
% level : The index of the level to plot. Defaults to level 1.
%
+% verbose : true/false to control amount of run-time output
+%
+% MarkerSize : integer controlling the size of the symbols
+%
+% pause : true/false to conrol pausing after each figure is created.
+% true will require hitting any key to continue to next plot
+%
+% range : 'range' of the value being plotted. Default is to
+% automatically determine range based on the data values.
%
% OUTPUT: A .pdf of each graphic is created. Each .pdf has a name that
% reflects the variable, quantity, and region being plotted.
@@ -86,6 +97,12 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
defaultPlevels = [ Inf 0 ];
defaultHlevels = [-Inf Inf];
defaultMlevels = [ 1 Inf];
+
+default_verbosity = true;
+default_markersize = 12;
+default_pause = false;
+default_range = [NaN NaN];
+default_level = 1;
p = inputParser;
addRequired(p,'files',@iscell);
addRequired(p,'titles',@iscell);
@@ -97,10 +114,20 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
addParameter(p,'plevel',defaultPlevels,@isnumeric);
addParameter(p,'hlevel',defaultHlevels,@isnumeric);
addParameter(p,'mlevel',defaultMlevels,@isnumeric);
+ addParameter(p,'verbose', default_verbosity, @islogical);
+ addParameter(p,'MarkerSize', default_markersize, @isnumeric);
+ addParameter(p,'pause', default_pause, @islogical);
+ addParameter(p,'range', default_range, @isnumeric);
+ addParameter(p,'level', default_level, @isnumeric);
else
- addParamValue(p,'plevel',defaultPlevels,@isnumeric);
- addParamValue(p,'hlevel',defaultHlevels,@isnumeric);
- addParamValue(p,'mlevel',defaultMlevels,@isnumeric);
+ addParamValue(p,'plevel',defaultPlevels,@isnumeric); %#ok
+ addParamValue(p,'hlevel',defaultHlevels,@isnumeric); %#ok
+ addParamValue(p,'mlevel',defaultMlevels,@isnumeric); %#ok
+ addParamValue(p,'verbose', default_verbosity, @islogical); %#ok
+ addParamValue(p,'MarkerSize',default_markersize, @isnumeric); %#ok
+ addParamValue(p,'pause', default_pause, @islogical); %#ok
+ addParamValue(p,'range', default_range, @isnumeric); %#ok
+ addParamValue(p,'level', default_level, @isnumeric); %#ok
end
p.parse(files, titles, obsnames, copy, prpo, varargin{:});
@@ -151,10 +178,17 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
end
end
-% set up all the stuff that is common.
+if (NumExp ~= length(titles))
+ error('each file must have an experiment title')
+end
-commondata = check_compatibility(files, obsnames, copy);
-figuredata = setfigure(NumExp);
+%% set up all the stuff that is common.
+
+global figuredata
+
+commondata = check_compatibility(files, prpo, obsnames, copy);
+figuredata = set_obsdiag_figure('tall', 'numexp', NumExp);
+figuredata.MarkerSize = p.Results.MarkerSize;
%%--------------------------------------------------------------------
% Set some static data
@@ -171,19 +205,16 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
% Getting the data for each experiment
%---------------------------------------------------------------------
- Nlimits = zeros(NumExp,2); % range of observation count - min, then max
Dlimits = zeros(NumExp,2); % range of the data
- Ylimits = zeros(NumExp,2); % range of the vertical coords
plotobj = cell(1,NumExp);
for iexp = 1:NumExp
- plotobj{iexp} = getvals(files{iexp}, obsnames{ivar}, copy, prpo, iregion, p);
+ plotobj{iexp} = getvals(files{iexp}, commondata.targets{ivar}, copy, iregion, p);
plotobj{iexp}.title = titles{iexp};
+ plotobj{iexp}.phase = commondata.phase;
- Nlimits(iexp,:) = plotobj{iexp}.Nrange;
Dlimits(iexp,:) = plotobj{iexp}.Drange;
- Ylimits(iexp,:) = plotobj{iexp}.Yrange;
end
@@ -192,9 +223,7 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
% Note that Dlimits has been constructed by ignoring the top levels.
%---------------------------------------------------------------------
- Nrange = [min(Nlimits(:,1)) max(Nlimits(:,2))];
Drange = [min(Dlimits(:,1)) max(Dlimits(:,2))];
- Yrange = [min(Ylimits(:,1)) max(Ylimits(:,2))];
span = abs(Drange(2) - Drange(1))* 0.05;
Drange(1) = Drange(1) - span;
Drange(2) = Drange(2) + span;
@@ -203,17 +232,22 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
% Plot all regions - one region to a page
%---------------------------------------------------------------------
- myplot(plotobj, Drange, Yrange, figuredata);
+ myplot(plotobj, Drange);
BottomAnnotation(files)
psfname = sprintf('%s_%s_region%d_profile_%dexp', ...
obsnames{ivar}, plotobj{1}.copystring, iregion, NumExp);
- print(iregion,'-dpdf',psfname)
+
+ if verLessThan('matlab','R2016a')
+ print(iregion, '-dpdf', psfname)
+ else
+ print(iregion, '-dpdf', '-bestfit', psfname)
+ end
end % of loop around regions
- if ( ivar ~= nvars )
+ if ( ivar ~= nvars && p.Results.pause )
disp('Pausing, hit any key to continue ...')
pause
end
@@ -228,7 +262,7 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
-function common = check_compatibility(filenames, varnames, copystring)
+function common = check_compatibility(filenames, prpo, varnames, copystring)
%% Trying to prevent the comparison of apples and oranges.
% make sure the diagnostics were generated the same way.
@@ -239,27 +273,37 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
mystat = 0;
nexp = length(filenames);
commondata = cell(1,nexp);
-priornames = struct([]);
-postenames = struct([]);
+targets = struct([]);
for i = 1:length(varnames)
- priornames{i} = sprintf('%s_VPguess',varnames{i});
- postenames{i} = sprintf('%s_VPanaly',varnames{i});
+ switch lower(prpo)
+ case {'guess','forecast','prior'}
+ targets{i} = sprintf('%s_VPguess',varnames{i});
+ commondata{i}.phase = 'prior';
+ case {'analy','analysis','posterior'}
+ targets{i} = sprintf('%s_VPanaly',varnames{i});
+ commondata{i}.phase = 'posterior';
+ otherwise
+ error('unknown prpo ... "%s"',prpo)
+ end
end
for i = 1:nexp
- varexist(filenames{i}, {priornames{:}, postenames{:}, 'time', 'time_bounds'})
+ varexist(filenames{i}, {targets{:}, 'time', 'time_bounds'}) %#ok
+
+ commondata{i}.targets = targets;
+ commondata{i}.region_names = strtrim(ncread(filenames{i},'region_names')');
commondata{i}.times = ncread(filenames{i}, 'time');
commondata{i}.time_bnds = ncread(filenames{i}, 'time_bounds');
- commondata{i}.copyindex = get_copy_index(filenames{i},copystring,'copy');
+ commondata{i}.copyindex = get_copy_index(filenames{i},copystring);
commondata{i}.nobstypes = nc_dim_info(filenames{i}, 'obstypes');
commondata{i}.nregions = nc_dim_info(filenames{i}, 'region');
- commondata{i}.time_to_skip = nc_read_att(filenames{i}, '/','time_to_skip');
- commondata{i}.lonlim1 = nc_read_att(filenames{i}, '/','lonlim1');
- commondata{i}.lonlim2 = nc_read_att(filenames{i}, '/','lonlim2');
- commondata{i}.latlim1 = nc_read_att(filenames{i}, '/','latlim1');
- commondata{i}.latlim2 = nc_read_att(filenames{i}, '/','latlim2');
+ commondata{i}.time_to_skip = nc_read_att(filenames{i}, '/', 'time_to_skip');
+ commondata{i}.lonlim1 = nc_read_att(filenames{i}, '/', 'lonlim1');
+ commondata{i}.lonlim2 = nc_read_att(filenames{i}, '/', 'lonlim2');
+ commondata{i}.latlim1 = nc_read_att(filenames{i}, '/', 'latlim1');
+ commondata{i}.latlim2 = nc_read_att(filenames{i}, '/', 'latlim2');
end
% error checking - compare everything to the first experiment
@@ -306,7 +350,6 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
% Coordinate between time types and dates
timeunits = nc_read_att(filenames{1},'time','units');
-calendar = nc_read_att(filenames{1},'time','calendar');
timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
timeorigin = datenum(timebase(1),timebase(2),timebase(3));
timefloats = zeros(size(commondata{1}.time_to_skip)); % stupid int32 type conversion
@@ -326,90 +369,41 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
%=====================================================================
-function plotdat = getvals(fname, varname, copystring, prpo, regionindex, opt )
+function plotdat = getvals(fname, varname, copystring, regionindex, opt )
%% basic function to retrieve plotting data
if (exist(fname,'file') ~= 2)
error('%s does not exist',fname)
end
-plotdat.fname = fname;
-plotdat.varname = varname;
-plotdat.copystring = copystring;
-plotdat.region = regionindex;
-
-plotdat.binseparation = nc_read_att(fname,'/','bin_separation');
-plotdat.binwidth = nc_read_att(fname,'/','bin_width');
-time_to_skip = nc_read_att(fname,'/','time_to_skip');
-plotdat.lonlim1 = nc_read_att(fname,'/','lonlim1');
-plotdat.lonlim2 = nc_read_att(fname,'/','lonlim2');
-plotdat.latlim1 = nc_read_att(fname,'/','latlim1');
-plotdat.latlim2 = nc_read_att(fname,'/','latlim2');
-plotdat.biasconv = nc_read_att(fname,'/','bias_convention');
-
-plotdat.nregions = nc_dim_info(fname,'region');
-plotdat.region_names = strtrim(ncread(fname,'region_names')');
-
-% Coordinate between time types and dates
-
-timeunits = nc_read_att(fname,'time','units');
-calendar = nc_read_att(fname,'time','calendar');
-timebase = sscanf(timeunits,'%*s%*s%d%*c%d%*c%d'); % YYYY MM DD
-timeorigin = datenum(timebase(1),timebase(2),timebase(3));
-timefloats = zeros(size(time_to_skip)); % stupid int32 type conversion
-timefloats(:) = time_to_skip(:);
-skip_seconds = timefloats(4)*3600 + timefloats(5)*60 + timefloats(6);
-iskip = timefloats(3) + skip_seconds/86400;
-
-plotdat.bincenters = ncread(fname,'time');
-plotdat.binedges = ncread(fname,'time_bounds');
-plotdat.bincenters = plotdat.bincenters + timeorigin;
-plotdat.binedges = plotdat.binedges + timeorigin;
-plotdat.Nbins = length(plotdat.bincenters);
-plotdat.toff = plotdat.binedges(1) + iskip;
-
-plotdat.timespan = sprintf('%s through %s', datestr(plotdat.toff), ...
- datestr(max(plotdat.binedges(:))));
-
-% Get the right indices for the intended variable, regardless of the storage order
-
-plotdat.copyindex = get_copy_index(fname, copystring);
-plotdat.Npossindex = get_copy_index(fname, 'Nposs');
-plotdat.Nusedindex = get_copy_index(fname, 'Nused');
-plotdat.NQC4index = get_copy_index(fname, 'N_DARTqc_4');
-plotdat.NQC5index = get_copy_index(fname, 'N_DARTqc_5');
-plotdat.NQC6index = get_copy_index(fname, 'N_DARTqc_6');
-plotdat.NQC7index = get_copy_index(fname, 'N_DARTqc_7');
-plotdat.NQC8index = get_copy_index(fname, 'N_DARTqc_8');
-plotdat.priorvar = sprintf('%s_VPguess',plotdat.varname);
-plotdat.postevar = sprintf('%s_VPanaly',plotdat.varname);
-
-myinfo.diagn_file = fname;
-myinfo.copyindex = plotdat.copyindex;
-myinfo.regionindex = plotdat.region;
-
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
-plotdat.prior = ncread(fname, plotdat.priorvar, start, count)';
-
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.postevar);
-plotdat.poste = ncread(fname, plotdat.postevar, start, count)';
-
-plotdat.trusted = nc_read_att(fname, plotdat.priorvar, 'TRUSTED');
+plotdat = read_obsdiag_staticdata(fname,copystring);
+plotdat.region = regionindex;
+plotdat.varname = varname;
+
+myinfo.diagn_file = fname;
+myinfo.copyindex = plotdat.copyindex;
+myinfo.regionindex = plotdat.region;
+[start, count] = GetNCindices(myinfo,'diagn',plotdat.varname);
+hyperslab = ncread(fname, plotdat.varname, start, count);
+plotdat.data = squeeze(hyperslab);
+plotdat.trusted = nc_read_att(fname, plotdat.varname, 'TRUSTED');
if (isempty(plotdat.trusted)), plotdat.trusted = 'NO'; end
% Now that we know the variable ... get the appropriate vertical information
-priordims = ncinfo(fname,plotdat.priorvar);
-plotdat.levels = ncread(fname,priordims.Dimensions(2).Name);
-plotdat.level_units = nc_read_att(fname,priordims.Dimensions(2).Name,'units');
+varinfo = ncinfo(fname,plotdat.varname);
+plotdat.levels = ncread(fname,varinfo.Dimensions(2).Name);
+plotdat.level_units = nc_read_att(fname,varinfo.Dimensions(2).Name,'units');
plotdat.nlevels = length(plotdat.levels);
-plotdat.level_edges = ncread(fname,sprintf('%s_edges',priordims.Dimensions(2).Name));
+plotdat.level_edges = ncread(fname,sprintf('%s_edges',varinfo.Dimensions(2).Name));
plotdat.YDir = 'normal';
inds = 1:plotdat.nlevels;
+%% Determine data limits
% find the levels of interest for setting the data limits
-switch lower(priordims.Dimensions(2).Name)
+
+switch lower(varinfo.Dimensions(2).Name)
case {'plevel'}
plotdat.YDir = 'reverse';
inds = find((plotdat.levels <= opt.Results.plevel(1)) & ...
@@ -423,30 +417,11 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
otherwise
end
-%% Determine data limits - Do we use prior and/or posterior
-% always make sure we have a zero bias line ...
-
-plotdat.useposterior = 0;
-plotdat.useprior = 0;
-
-switch lower(prpo)
- case {'analy','analysis','posterior'}
- plotdat.useposterior = 1;
- plotdat.prpo = 'analysis';
- bob = plotdat.poste(inds);
- case {'guess','forecast','prior'}
- plotdat.useprior = 1;
- plotdat.prpo = 'forecast';
- bob = plotdat.prior(inds);
- otherwise
- plotdat.useposterior = 1;
- plotdat.useprior = 1;
- plotdat.prpo = 'forecast and analysis';
- bob = [plotdat.prior(inds) ; plotdat.poste(inds)]; % one long array
-end
+bob = plotdat.data(inds);
switch copystring
case {'bias'}
+ % always make sure we have a zero bias line ...
dmin = min( [ min(bob) 0.0 ] );
dmax = max( [ max(bob) 0.0 ] );
plotdat.Drange = [ dmin dmax ];
@@ -459,91 +434,61 @@ function two_experiments_profile(files, titles, obsnames, copy, prpo, varargin)
plotdat.xlabel = copystring;
end
-%% Get the indices for the number of observations possible
-% Get the indices for the number of observations used
-% The number of obs possible is affected by namelist selection of
-% which observations to assimilate, and what incoming QC is 'good'.
-
-myinfo.diagn_file = fname;
-myinfo.copyindex = plotdat.Npossindex;
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
-plotdat.nposs = ncread(fname, plotdat.priorvar, start, count)';
-
-myinfo.copyindex = plotdat.NQC5index;
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
-plotdat.Nqc5 = ncread(fname, plotdat.priorvar, start, count)';
-plotdat.nposs = plotdat.nposs - plotdat.Nqc5;
-
-myinfo.copyindex = plotdat.NQC6index;
-[start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
-plotdat.Nqc6 = ncread(fname, plotdat.priorvar, start, count)';
-plotdat.nposs = plotdat.nposs - plotdat.Nqc6;
-
-if ( plotdat.useprior )
- myinfo.copyindex = get_copy_index(fname, 'Nused');
- [start, count] = GetNCindices(myinfo,'diagn',plotdat.priorvar);
- plotdat.nused = ncread(fname, plotdat.priorvar, start, count)';
-else
- myinfo.copyindex = get_copy_index(fname, 'Nused');
- [start, count] = GetNCindices(myinfo,'diagn',plotdat.postevar);
- plotdat.nused = ncread(fname, plotdat.postevar, start, count)';
-end
-%% Set the last of the ranges
+qcvalues = get_qc_values(fname, plotdat.varname, ...
+ 'regionindex', plotdat.region, ...
+ 'fatal', false, ...
+ 'verbose', false);
-plotdat.Yrange = [min(plotdat.level_edges) max(plotdat.level_edges)];
-plotdat.Nrange = [min(plotdat.nused(:)) max(plotdat.nposs(:))];
+plotdat.nposs = qcvalues.nposs;
+plotdat.nused = qcvalues.nused;
+plotdat.num_evaluated = qcvalues.num_evaluated;
+if sum(plotdat.num_evaluated(:) > 0)
+ plotdat.assim_eval_string = 'evaluated';
+else
+ plotdat.assim_eval_string = 'assimilated';
+end
%=====================================================================
-function myplot( plotdat, Drange, Yrange, figdata)
+function myplot( plotdat, Drange)
%% Create graphic for one region - for all experiments.
+global figuredata
+
Nexp = length(plotdat);
iregion = plotdat{1}.region;
figure(iregion);
-clf(iregion); orient(figdata.orientation); wysiwyg
-ax1 = subplot('position',figdata.position);
+clf(iregion); orient(figuredata.orientation);
+ax1 = subplot('position',figuredata.position);
Stripes(Drange, plotdat{1}.level_edges, plotdat{1}.level_units, Nexp);
set(ax1,'YDir',plotdat{1}.YDir,'YTick',sort(plotdat{1}.levels),'Layer','top')
-set(ax1,'YAxisLocation','left','FontSize',figdata.fontsize)
+set(ax1,'YAxisLocation','left','FontSize',figuredata.fontsize)
-% draw the results of the experiments, priors and posteriors -
-% each with their own line type.
-iexp = 0;
+% draw the results of the experiments - each with their own line type.
hd = []; % handle to an unknown number of data lines
legstr = {[]}; % strings for the legend
-hold on
for i = 1:Nexp
+ hd(i) = line(plotdat{i}.data, plotdat{i}.levels, ...
+ 'Color', figuredata.expcolors{i}, ...
+ 'Marker', figuredata.expsymbols{i}, ...
+ 'MarkerSize', figuredata.MarkerSize, ...
+ 'MarkerFaceColor', figuredata.expcolors{i}, ...
+ 'LineStyle', figuredata.prpolines{1}, ...
+ 'LineWidth', figuredata.linewidth,'Parent',ax1); %#ok
- if ( plotdat{i}.useprior )
- iexp = iexp + 1;
- lty = sprintf('%s%s%s',figdata.expcolors{i},figdata.prpolines{1}, ...
- figdata.expsymbols{i});
- hd(iexp) = plot(plotdat{i}.prior, plotdat{i}.levels, lty,'LineWidth', ...
- figdata.linewidth);
- legstr{iexp} = sprintf('%s Prior',plotdat{i}.title);
- end
+ legstr{i} = sprintf('%s %s',plotdat{i}.title,plotdat{i}.phase);
- if ( plotdat{i}.useposterior )
- iexp = iexp + 1;
- lty = sprintf('%s%s%s',figdata.expcolors{i},figdata.prpolines{2}, ...
- figdata.expsymbols{i});
- hd(iexp) = plot(plotdat{i}.poste, plotdat{i}.levels, lty,'LineWidth', ...
- figdata.linewidth);
- legstr{iexp} = sprintf('%s Posterior',plotdat{i}.title);
- end
end
-hold off;
switch plotdat{1}.copystring
case {'bias','rmse'}
- zeroline = line([0 0],get(ax1,'YLim'),'Color',[0 100 0]/255,'Parent',ax1);
+ zeroline = line([0 0],get(ax1,'YLim'),'Color',[200 200 200]/255,'Parent',ax1);
set(zeroline,'LineWidth',2.5,'LineStyle','-')
otherwise
end
@@ -584,10 +529,18 @@ function myplot( plotdat, Drange, Yrange, figdata)
% Plot the data, which sets the range of the axis
for i = 1:Nexp
- h2 = line(plotdat{i}.nposs, plotdat{i}.levels,'Color',figdata.expcolors{i},'Parent',ax2);
- h3 = line(plotdat{i}.nused, plotdat{i}.levels,'Color',figdata.expcolors{i},'Parent',ax2);
- set(h2,'LineStyle','none','Marker','o','MarkerSize',10);
- set(h3,'LineStyle','none','Marker','*','MarkerSize',10);
+ ax2h1 = line(plotdat{i}.nposs, plotdat{i}.levels, 'Parent', ax2);
+ ax2h2 = line(plotdat{i}.nused, plotdat{i}.levels, 'Parent', ax2);
+
+ set(ax2h1,'LineStyle','none', ...
+ 'Color', figuredata.expcolors{i}, ...
+ 'Marker', figuredata.obs_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
+
+ set(ax2h2,'LineStyle','none', ...
+ 'Color', figuredata.expcolors{i}, ...
+ 'Marker', figuredata.ges_marker, ...
+ 'MarkerSize',figuredata.MarkerSize);
end
% use same Y ticks but no labels
@@ -600,17 +553,18 @@ function myplot( plotdat, Drange, Yrange, figdata)
% regions on one page. Trying to maximize content, minimize clutter.
% Any plot object will do for annotating region,levels,etc
-annotate( ax1, ax2, plotdat{1}, figdata, xscale)
-
-lh = legend(hd,legstr,'Location','Best');
-set(lh,'Interpreter','none','Box','off');
-
-% The legend linesizes should match - 2 is hardwired - suprises me.
+annotate(ax1, ax2, plotdat{1}, xscale)
-set(lh,'FontSize',figdata.fontsize);
-kids = get(lh,'Children');
-set(kids,'LineWidth',figdata.linewidth);
+lh = legend(hd,legstr,'Location','NorthWest');
+set(lh,'Interpreter','none','Box','off','FontSize',figuredata.fontsize);
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+else
+ lh.AutoUpdate = 'off';
+end
%=====================================================================
@@ -650,7 +604,7 @@ function myplot( plotdat, Drange, Yrange, figdata)
hold on;
for i = 1:2:(length(edges)-1)
yc = [ edges(i) edges(i) edges(i+1) edges(i+1) edges(i) ];
- hf = fill(xc,yc,[0.8 0.8 0.8],'EdgeColor','none');
+ fill(xc,yc,[0.8 0.8 0.8],'EdgeColor','none');
end
hold off;
@@ -661,21 +615,25 @@ function myplot( plotdat, Drange, Yrange, figdata)
%=====================================================================
-function annotate(ax1, ax2, plotobj, figdata, xscale)
+function annotate(ax1, ax2, plotobj, xscale)
%% One figure ... everything gets annotated.
-%>@todo FIXME evaluate_only observations should be annotated as 'evaluated',
-%> not 'assimilated' - in ALL matlab scripts.
+
+global figuredata
set(get(ax1,'Ylabel'),'String',plotobj.level_units, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
set(get(ax1,'Xlabel'),'String',{plotobj.xlabel,plotobj.timespan}, ...
- 'Interpreter','none','FontSize',figdata.fontsize)
-set(get(ax2,'Xlabel'),'String', ...
- ['# of obs (o=possible, \ast=assimilated) x' int2str(uint32(xscale))],'FontSize',figdata.fontsize)
+ 'Interpreter','none','FontSize',figuredata.fontsize)
+
+string1 = sprintf('# of obs (o=possible, %s=%s ) x ', '\ast', ...
+ plotobj.assim_eval_string);
+
+set(get(ax2,'Xlabel'),'String', [string1 int2str(uint32(xscale))], ...
+ 'FontSize',figuredata.fontsize)
th = title({deblank(plotobj.region_names(plotobj.region,:)), plotobj.varname});
-set(th,'Interpreter','none','FontSize',figdata.fontsize,'FontWeight','bold');
+set(th,'Interpreter','none','FontSize',figuredata.fontsize,'FontWeight','bold');
%=====================================================================
@@ -737,30 +695,6 @@ function varexist(filename, varnames)
end
-%=====================================================================
-
-
-function figdata = setfigure(nexp)
-%%
-% figure out a page layout
-% extra space at the bottom for the date/file annotation
-% extra space at the top because the titles have multiple lines
-
-ybot = 0.06 + nexp*0.035; % room for dates/files
-ytop = 0.125; % room for title (always 2 lines)
-dy = 1.0 - ytop - ybot;
-orientation = 'tall';
-fontsize = 16;
-position = [0.15 ybot 0.7 dy];
-linewidth = 2.0;
-
-figdata = struct('expcolors', {{'k','r','b','m','g','c','y'}}, ...
- 'expsymbols', {{'o','s','d','p','h','s','*'}}, ...
- 'prpolines', {{'-','--'}}, 'position', position, ...
- 'fontsize',fontsize, 'orientation',orientation, ...
- 'linewidth',linewidth);
-
-
%
% $URL$
% $Revision$
diff --git a/documentation/DART_LAB/matlab/gaussian_product.m b/documentation/DART_LAB/matlab/gaussian_product.m
index 15d938d03e..3f8c4c048c 100644
--- a/documentation/DART_LAB/matlab/gaussian_product.m
+++ b/documentation/DART_LAB/matlab/gaussian_product.m
@@ -237,9 +237,9 @@
'HorizontalAlignment', 'right');
align([handles.ui_text_posterior_mean, ...
- handles.ui_text_posterior_sd, ...
- handles.ui_text_posterior_weight], ...
- 'Distribute','None');
+ handles.ui_text_posterior_sd, ...
+ handles.ui_text_posterior_weight], ...
+ 'Distribute','None');
reset_Posterior();
hlist = [handles.PriorPanel, handles.ObservationPanel, handles.ui_button_Plot, handles.PosteriorPanel];
@@ -255,22 +255,22 @@ function plotGraph_Callback(~,~)
%This function plots the graph using the inputs in the 4 edit boxes. It
%makes changes to handles, so the function must return an update to
%handles. This is done through the function definition.
-
+
[prior_mean, prior_sd, obs_mean, obs_err_sd, is_err] = g_prod_plot(handles);
-
+
% If there is an error, zero out the posterior text values
% don't try to do posterior computation
if(is_err)
reset_Posterior();
return;
end
-
+
% Compute the posterior mean, sd and weight
[post_mean, post_sd, weight] = ...
product_of_gaussians(prior_mean, prior_sd, obs_mean, obs_err_sd);
post_handle = plot_gaussian(post_mean, post_sd, 1);
set(post_handle, 'Color', atts.blue, 'LineWidth', 2);
-
+
%Round post_mean, post_sd and weight to 4 decimal places
post_mean = round(post_mean * 10000);
post_mean = post_mean/10000;
@@ -278,25 +278,25 @@ function plotGraph_Callback(~,~)
post_sd = post_sd/10000;
weight = round(weight * 10000);
weight = weight/10000;
-
+
% Print values
str1 = sprintf('Mean = %.4f',post_mean);
set(handles.ui_text_posterior_mean, 'String', str1);
str1 = sprintf('SD = %.4f',post_sd);
set(handles.ui_text_posterior_sd, 'String', str1);
-
+
% Also plot the weighted posterior as dashed
post_handle = plot_gaussian(post_mean, post_sd, weight);
set(post_handle, 'Color', atts.blue, 'LineStyle', '--');
str1 = sprintf('Weight = %.4f',weight);
set(handles.ui_text_posterior_weight, 'String', str1);
-
+
h = legend('Prior', 'Obs. Likelihood', 'Posterior', 'Weighted Posterior');
set(h, 'box', 'on', 'Location', 'NorthWest')
-
+
end
- % These functions plot the graph immediately after the user edits a text box
+% These functions plot the graph immediately after the user edits a text box
function edit_prior_mean_Callback(~, ~)
g_prod_plot(handles);
diff --git a/documentation/DART_LAB/matlab/oned_ensemble.m b/documentation/DART_LAB/matlab/oned_ensemble.m
index dec57d7f2a..6f2e4daf29 100644
--- a/documentation/DART_LAB/matlab/oned_ensemble.m
+++ b/documentation/DART_LAB/matlab/oned_ensemble.m
@@ -474,62 +474,62 @@
%% -----------------------------------------------------------------------------
function button_create_new_ens_Callback(~,~)
-
+
% Disable the update ensemble button and all other active buttons
set(handles.ui_button_update_ens, 'Enable', 'Off');
set(handles.ui_edit_observation, 'Enable', 'Off');
set(handles.ui_edit_obs_error_sd, 'Enable', 'Off');
set(handles.ui_edit_inflation_label, 'Enable', 'Off');
-
+
% Clear out any old ensemble members if they exist
set(handles.h_ens_member, 'Visible', 'Off');
set(handles.h_inf_ens_member, 'Visible', 'Off');
-
+
set(handles.h_update_lines, 'Visible', 'Off');
set(handles.h_inf_lines, 'Visible', 'Off');
set(handles.h_inf_axis, 'Visible', 'Off');
-
+
% Turn Off any old update points
set(handles.h_update_ens, 'Visible', 'Off');
set(handles.h_inf_up_ens, 'Visible', 'Off');
set(handles.h_inf_ens_member, 'Visible', 'Off');
-
+
clear_ui_labels;
-
+
hold on
-
+
% Set a basic plotting domain range that includes mean +/- 3 obs SDs
xlower = min(handles.observation - 3*handles.obs_error_sd, min(handles.ens_members));
xupper = max(handles.observation + 3*handles.obs_error_sd, max(handles.ens_members));
ylower = -0.4;
yupper = 1.0;
axis([xlower xupper ylower yupper]);
-
+
set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
-
+
% Messages are centered in the middle.
xmid = (xupper + xlower) / 2.0;
h_click = text(xmid, 0.6, {'Click inside graphics box to create member', ...
'(only X value is used)'}, 'FontSize', atts.fontsize, 'HorizontalAlignment', 'center');
-
+
h_err_text = text(xmid, -0.15, 'An ensemble has to have at least 2 members.', ...
'FontSize', atts.fontsize, 'Visible', 'on', 'HorizontalAlignment', 'center','Color', atts.red);
-
+
h_finish = text(xmid, -0.15, 'Click outside of plot to finish', ...
'Fontsize', atts.fontsize, 'Visible', 'Off', 'HorizontalAlignment', 'center');
-
+
ens_size = 0;
-
+
while ens_size < 100
[xt, yt] = ginput(1);
-
+
if(xt >= xlower && xt <= xupper && yt >= ylower && yt <= yupper)
ens_size = ens_size + 1;
x(ens_size) = xt; %#ok
y(ens_size) = 0; %#ok
handles.h_ens_member(ens_size) = ...
plot(x(ens_size), y(ens_size), '*', 'MarkerSize', 16, 'Color', atts.green,'LineWidth',2.0);
-
+
% Display the prior mean and sd
prior_mean = mean(x);
prior_sd = std(x);
@@ -537,46 +537,46 @@ function button_create_new_ens_Callback(~,~)
set(handles.ui_text_prior_mean, 'String', str1);
str1 = sprintf('Prior SD = %.4f', prior_sd);
set(handles.ui_text_prior_sd, 'String', str1);
-
+
elseif (ens_size < 2)
set(h_err_text,'FontWeight','bold')
-
+
else
break;
-
+
end
-
+
% Swap messages once you have a minimal ensemble.
if (ens_size == 2)
set(h_err_text, 'Visible', 'Off');
set(h_finish, 'Visible', 'on');
-
+
end
-
+
end
-
+
% Ensemble created, compute mean and sd, clean up and return
% Set the global gui storage
handles.ens_size = ens_size;
handles.ens_members = x;
-
+
% Turn Off the data entry messages
set(h_click, 'Visible', 'Off');
set(h_finish, 'Visible', 'Off');
-
+
% Enable the update ensemble button
set(handles.ui_button_update_ens, 'Enable', 'On');
set(handles.ui_edit_observation, 'Enable', 'On');
set(handles.ui_edit_obs_error_sd, 'Enable', 'On');
set(handles.ui_edit_inflation_label, 'Enable', 'On');
-
+
end
%% -----------------------------------------------------------------------------
function inflation_toggle_Callback (~, ~)
-
+
enabled = get(handles.ui_checkbox_inflation, 'Value');
if (enabled)
set(handles.ui_slider_inflation, 'Enable', 'On');
@@ -586,7 +586,7 @@ function inflation_toggle_Callback (~, ~)
set(handles.ui_text_inflated_post_mean, 'Visible', 'On');
set(handles.ui_text_inflated_prior_sd, 'Visible', 'On');
set(handles.ui_text_inflated_post_sd, 'Visible', 'On');
-
+
else
set(handles.ui_slider_inflation, 'Enable', 'Off');
set(handles.ui_text_inflation, 'Enable', 'Off');
@@ -601,49 +601,49 @@ function inflation_toggle_Callback (~, ~)
%% -----------------------------------------------------------------------------
function slider_Callback (~, ~)
-
+
handles.inflation = get(handles.ui_slider_inflation, 'Value');
-
+
str1 = sprintf('%.4f',handles.inflation);
set(handles.ui_edit_inflation_label, 'String', str1);
-
+
% Just in case the inflation label was in the error state, reset
set(handles.ui_edit_inflation_label, 'BackgroundColor', 'White', 'FontWeight', 'Normal');
set(handles.ui_text_inf_err_print, 'Visible', 'Off')
-
+
% Disable other input to guarantee only one error at a time!
set(handles.ui_edit_observation, 'Enable', 'On')
set(handles.ui_edit_obs_error_sd, 'Enable', 'On')
set(handles.ui_button_create_new_ens, 'Enable', 'On')
set(handles.ui_button_update_ens, 'Enable', 'On')
-
+
end
%% -----------------------------------------------------------------------------
function button_update_ens_Callback (~, ~)
-
+
% Turn Off any old points
set(handles.h_update_ens, 'Visible', 'Off');
set(handles.h_inf_up_ens, 'Visible', 'Off');
set(handles.h_inf_ens_member, 'Visible', 'Off');
-
+
% Remove mean and sd of old posterior
clear_ui_labels;
-
+
% And the lines in between
set(handles.h_update_lines, 'Visible', 'Off');
set(handles.h_inf_lines, 'Visible', 'Off');
set(handles.h_inf_axis, 'Visible', 'Off');
-
+
ensemble = handles.ens_members;
-
+
% Figure out which filter option is currently selected
val = get(handles.ui_radio_button_group,'SelectedObject');
filter_type = get(val,'String');
-
+
switch filter_type
-
+
case 'EAKF'
[obs_increments, ~] = ...
obs_increment_eakf(ensemble, handles.observation, handles.obs_error_sd^2);
@@ -654,60 +654,60 @@ function button_update_ens_Callback (~, ~)
[obs_increments, ~] = ...
obs_increment_rhf(ensemble, handles.observation, handles.obs_error_sd^2);
end
-
+
% Add on increments to get new ensemble
new_ensemble = ensemble + obs_increments;
-
+
y(1:size(ensemble)) = -0.1;
handles.h_update_ens = plot(new_ensemble, y, '*', 'MarkerSize', 16, 'Color', atts.blue);
-
+
% Plot lines connecting the prior and posterior ensemble members
for i = 1:size(ensemble, 2)
x_line = [handles.ens_members(i), new_ensemble(i)];
y_line = [0, -0.1];
handles.h_update_lines(i) = plot(x_line, y_line, 'k');
end
-
+
% Add in a label of the updated mean and sd
new_mean = mean(new_ensemble);
new_sd = std(new_ensemble);
-
+
% Update mean and sd of old posterior
str1 = sprintf('Posterior Mean = %.4f',new_mean);
set(handles.ui_text_post_mean, 'String', str1, 'Visible', 'on');
-
+
str1 = sprintf('Posterior SD = %.4f',new_sd);
set(handles.ui_text_post_sd, 'String', str1, 'Visible', 'on');
-
+
% If the checkbox isn't set, return now
if(not(get(handles.ui_checkbox_inflation, 'Value')))
return
end
-
+
% Plot the inflated prior ensemble
y = -0.2;
handles.prior_mean = mean(handles.ens_members(1:handles.ens_size));
-
+
inf_ens = zeros(1,handles.ens_size);
-
+
for i = 1: handles.ens_size
inf_ens(i) = (handles.ens_members(i) - handles.prior_mean) * sqrt(handles.inflation) + ...
handles.prior_mean;
handles.h_inf_ens_member(i) = plot(inf_ens(i), y, '*', 'MarkerSize', 16, 'Color', atts.green,'LineWidth',2.0);
-
+
end
-
+
% Update mean and sd of old posterior
handles.inf_prior_sd = std(inf_ens(1:handles.ens_size));
-
+
str1 = sprintf('Inflated = %.4f',handles.prior_mean);
set(handles.ui_text_inflated_prior_mean,'String',str1,'Visible','on');
str1 = sprintf('Inflated = %.4f',handles.inf_prior_sd);
set(handles.ui_text_inflated_prior_sd, 'String',str1,'Visible','on');
-
+
% Get the update for the inflated ensemble
switch filter_type
-
+
case 'EAKF'
[obs_increments, ~] = ...
obs_increment_eakf(inf_ens, handles.observation, handles.obs_error_sd^2);
@@ -718,21 +718,21 @@ function button_update_ens_Callback (~, ~)
[obs_increments, ~] = ...
obs_increment_rhf(inf_ens, handles.observation, handles.obs_error_sd^2);
end
-
+
% Add on increments to get new ensemble
new_ensemble = inf_ens + obs_increments;
-
+
y(1:size(ensemble)) = -0.3;
handles.h_inf_up_ens = plot(new_ensemble, y, '*', 'MarkerSize', 16, 'Color', atts.blue);
-
+
% Plot lines connecting the prior and posterior ensemble members
for i = 1:size(ensemble, 2)
x_line = [inf_ens(i), new_ensemble(i)];
y_line = [-0.2, -0.3];
handles.h_inf_lines(i) = plot(x_line, y_line, 'k');
-
+
end
-
+
% Set a basic plotting domain range that includes mean +/- 3 obs SDs
% Plus all inflated members
xlower = min(handles.observation - 3*handles.obs_error_sd, min(inf_ens));
@@ -740,27 +740,27 @@ function button_update_ens_Callback (~, ~)
ylower = -0.4;
yupper = 1.0;
axis([xlower xupper ylower yupper]);
-
+
% Plot the axes for the two priors
plot([xlower xupper], [0 0], 'k', 'Linewidth', 1.7);
handles.h_inf_axis = plot([xlower xupper], [-0.2 -0.2], 'k', 'Linewidth', 1.7);
-
+
% Update mean and sd of old posterior
handles.update_inf_mean = mean(new_ensemble(1:handles.ens_size));
handles.update_inf_sd = std (new_ensemble(1:handles.ens_size));
-
+
str1 = sprintf('Inflated = %.4f',handles.update_inf_mean);
set(handles.ui_text_inflated_post_mean, 'String', str1, 'Visible','on');
-
+
str1 = sprintf('Inflated = %.4f',handles.update_inf_sd);
set(handles.ui_text_inflated_post_sd, 'String', str1, 'Visible', 'on');
-
+
end
%% -----------------------------------------------------------------------------
function clear_ui_labels()
-
+
% Turns Off all labels except for the prior mean and SD
set(handles.ui_text_post_sd, 'Visible', 'Off');
set(handles.ui_text_post_mean, 'Visible', 'Off');
@@ -768,248 +768,248 @@ function clear_ui_labels()
set(handles.ui_text_inflated_prior_sd, 'Visible', 'Off');
set(handles.ui_text_inflated_post_sd, 'Visible', 'Off');
set(handles.ui_text_inflated_post_mean, 'Visible', 'Off');
-
+
end
%% -----------------------------------------------------------------------------
function edit_inflation_Callback(~, ~)
-
+
% Turn Off any old updated points
set(handles.h_update_ens, 'Visible', 'Off');
set(handles.h_inf_up_ens, 'Visible', 'Off');
set(handles.h_inf_ens_member, 'Visible', 'Off');
-
+
% Remove mean and sd of old posterior
clear_ui_labels;
-
+
% And the lines in between
set(handles.h_update_lines, 'Visible', 'Off');
set(handles.h_inf_lines, 'Visible', 'Off');
set(handles.h_inf_axis, 'Visible', 'Off');
-
+
% Enable things that an error might have turned Off
set(handles.ui_edit_observation, 'Enable', 'on')
set(handles.ui_edit_obs_error_sd, 'Enable', 'on')
set(handles.ui_button_create_new_ens, 'Enable', 'on')
-
+
% Only enable the update ensemble pushbutton if an ensemble has been created
if(handles.ens_size > 0)
set(handles.ui_button_update_ens, 'Enable', 'on');
-
+
end
-
+
% Get the value of the inflation
inf_value = str2double(get(handles.ui_edit_inflation_label, 'String'));
-
+
if( isfinite(inf_value) && (inf_value >= 1) && (inf_value <= 5))
inflation = inf_value;
-
+
else
set(handles.ui_edit_inflation_label, 'String', '??','FontWeight','Bold', ...
'BackgroundColor', atts.red);
set(handles.ui_text_inf_err_print,'Visible','On')
-
+
fprintf('ERROR: Inflation value must be between 1 and 5.\n')
fprintf('ERROR: Inflation value must be between 1 and 5.\n')
-
+
% Disable other input to guarantee only one error at a time!
set(handles.ui_edit_observation, 'Enable', 'Off')
set(handles.ui_edit_obs_error_sd, 'Enable', 'Off')
set(handles.ui_button_create_new_ens, 'Enable', 'Off')
set(handles.ui_button_update_ens, 'Enable', 'Off')
-
+
return
-
+
end
-
+
% Update the value in global storage
handles.inflation = inflation;
set(handles.ui_edit_inflation_label, 'BackgroundColor', 'White', 'FontWeight', 'Normal');
set(handles.ui_slider_inflation,'Value', handles.inflation);
set(handles.ui_text_inf_err_print,'Visible','Off')
-
-
+
+
% Plot the updated distribution
set(handles.h_obs_plot, 'Visible', 'Off');
handles.h_obs_plot = plot_gaussian(handles.observation, handles.obs_error_sd, 1);
set(handles.h_obs_plot, 'Color', atts.red, 'Linestyle', '--', 'Linewidth', 1.7);
-
+
% Set a basic plotting domain range that includes mean +/- 3 obs SDs
xlower = min(handles.observation - 3*handles.obs_error_sd, min(handles.ens_members));
xupper = max(handles.observation + 3*handles.obs_error_sd, max(handles.ens_members));
ylower = -0.4;
yupper = 1.0;
axis([xlower xupper ylower yupper]);
-
+
set(handles.h_obs_plot, 'Color', atts.red, 'Linestyle', '--', 'Linewidth', 1.7);
-
+
set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
-
+
hold on
-
+
plot([xlower xupper], [0 0], 'k', 'Linewidth', 1.7);
-
+
end
%% -----------------------------------------------------------------------------
function edit_observation_Callback(~, ~)
-
+
% Turn Off any old updated points
set(handles.h_update_ens, 'Visible', 'Off');
set(handles.h_inf_up_ens, 'Visible', 'Off');
set(handles.h_inf_ens_member, 'Visible', 'Off');
-
+
% Remove mean and sd of old posterior
clear_ui_labels;
-
+
% And the lines in between
set(handles.h_update_lines, 'Visible', 'Off');
set(handles.h_inf_lines, 'Visible', 'Off');
set(handles.h_inf_axis, 'Visible', 'Off');
-
+
% Enable things that an error might have turned Off
set(handles.ui_edit_obs_error_sd, 'Enable', 'on')
set(handles.ui_edit_inflation_label, 'Enable', 'on')
set(handles.ui_button_create_new_ens, 'Enable', 'on')
-
+
% Only enable the update ensemble pushbutton if an ensemble has been created
if(handles.ens_size > 0)
set(handles.ui_button_update_ens, 'Enable', 'on');
-
+
end
-
+
% Get the value of the observation
if(isfinite( str2double(get(handles.ui_edit_observation, 'String'))))
observation = str2double(get(handles.ui_edit_observation, 'String'));
-
+
else
set(handles.ui_edit_observation, 'String', '??','FontWeight','Bold', ...
'BackgroundColor', atts.red);
set(handles.ui_text_obs_err_print,'Visible','On')
-
+
fprintf('ERROR: Observation value must be numeric.\n')
fprintf('ERROR: Observation value must be numeric.\n')
-
-
+
+
% Disable other input to guarantee only one error at a time!
set(handles.ui_edit_obs_error_sd, 'Enable', 'Off')
set(handles.ui_edit_inflation_label, 'Enable', 'Off')
set(handles.ui_button_create_new_ens, 'Enable', 'Off')
set(handles.ui_button_update_ens, 'Enable', 'Off')
-
+
return
-
+
end
-
+
% Update the global storage
handles.observation = observation;
set(handles.ui_edit_observation, 'BackgroundColor', 'White','FontWeight', 'Normal');
set(handles.ui_text_obs_err_print,'Visible','Off')
-
+
% Plot the updated distribution
set(handles.h_obs_plot, 'Visible', 'Off');
handles.h_obs_plot = plot_gaussian(handles.observation, handles.obs_error_sd, 1);
set(handles.h_obs_plot, 'Color', atts.red, 'Linestyle', '--', 'Linewidth', 1.7);
-
+
% Move the observation asterisk
set(handles.h_obs_ast, 'Visible', 'Off');
handles.h_obs_ast = plot(handles.observation, 0, 'r*', 'MarkerSize', 16,'LineWidth',2.0);
-
+
% Set a basic plotting domain range that includes mean +/- 3 obs SDs
xlower = min(handles.observation - 3*handles.obs_error_sd, min(handles.ens_members));
xupper = max(handles.observation + 3*handles.obs_error_sd, max(handles.ens_members));
ylower = -0.4;
yupper = 1.0;
axis([xlower xupper ylower yupper]);
-
+
set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
-
+
hold on
plot([xlower xupper], [0 0], 'k', 'Linewidth', 1.7);
-
+
end
%% -----------------------------------------------------------------------------
function edit_obs_error_sd_Callback(~, ~)
-
+
% Turn Off any old updated points
set(handles.h_update_ens, 'Visible', 'Off');
set(handles.h_inf_up_ens, 'Visible', 'Off');
set(handles.h_inf_ens_member, 'Visible', 'Off');
-
+
% Remove mean and sd of old posterior
clear_ui_labels;
-
+
% And the lines in between
set(handles.h_update_lines, 'Visible', 'Off');
set(handles.h_inf_lines, 'Visible', 'Off');
set(handles.h_inf_axis, 'Visible', 'Off');
-
+
% Enable things that an error might have turned Off
set(handles.ui_edit_observation, 'Enable', 'on')
set(handles.ui_edit_inflation_label, 'Enable', 'on')
set(handles.ui_button_create_new_ens, 'Enable', 'on')
-
+
% Only enable the update ensemble pushbutton if an ensemble has been created
if(handles.ens_size > 0)
set(handles.ui_button_update_ens, 'Enable', 'on');
end
-
+
% Get the value of the observation error sd
obs_error_value = str2double(get(handles.ui_edit_obs_error_sd, 'String'));
-
+
if(isfinite(obs_error_value) && (obs_error_value > 0))
obs_error_sd = obs_error_value;
-
+
else
-
+
set(handles.ui_edit_obs_error_sd, 'String', '??','FontWeight','Bold', ...
'BackgroundColor', atts.red);
set(handles.ui_text_obs_sd_err_print,'Visible','On')
-
+
fprintf('ERROR: Obs. Error SD value must be numeric.\n')
fprintf('ERROR: Obs. Error SD value must be numeric.\n')
-
-
+
+
% Disable other input to guarantee only one error at a time!
set(handles.ui_edit_observation, 'Enable', 'Off')
set(handles.ui_edit_inflation_label, 'Enable', 'Off')
set(handles.ui_button_create_new_ens, 'Enable', 'Off')
set(handles.ui_button_update_ens, 'Enable', 'Off')
-
+
return
-
+
end
-
+
% Update the value in global storage
handles.obs_error_sd = obs_error_sd;
set(handles.ui_edit_obs_error_sd, 'BackgroundColor', 'White', 'FontWeight', 'Normal');
set(handles.ui_text_obs_sd_err_print,'Visible','Off')
-
-
+
+
% Plot the updated distribution
set(handles.h_obs_plot, 'Visible', 'Off');
handles.h_obs_plot = plot_gaussian(handles.observation, handles.obs_error_sd, 1);
set(handles.h_obs_plot, 'Color', atts.red, 'Linestyle', '--', 'Linewidth', 1.7);
-
+
% Set a basic plotting domain range that includes mean +/- 3 obs SDs
xlower = min(handles.observation - 3*handles.obs_error_sd, min(handles.ens_members));
xupper = max(handles.observation + 3*handles.obs_error_sd, max(handles.ens_members));
ylower = -0.4;
yupper = 1.0;
axis([xlower xupper ylower yupper]);
-
+
set(handles.h_obs_plot, 'Color', atts.red, 'Linestyle', '--', 'Linewidth', 1.7);
-
+
set(gca, 'YTick', [0 0.2 0.4 0.6 0.8]);
-
+
hold on
-
+
plot([xlower xupper], [0 0], 'k', 'Linewidth', 1.7);
-
+
end
%% -----------------------------------------------------------------------------
diff --git a/documentation/DART_LAB/matlab/oned_model.m b/documentation/DART_LAB/matlab/oned_model.m
index 13d086eac6..203b95c3b8 100644
--- a/documentation/DART_LAB/matlab/oned_model.m
+++ b/documentation/DART_LAB/matlab/oned_model.m
@@ -359,81 +359,81 @@
%% -----------------------------------------------------------------------------
function ens_size_Callback(~, ~)
-
+
new_ens_size = str2double(get(handles.ui_edit_ens_size, 'String'));
-
+
% Get a new ensemble size if not valid value
if( ~ isfinite(new_ens_size) || (new_ens_size < 2) )
-
+
fprintf('ERROR: Ens. Size value must be greater or equal to 2.\n')
fprintf('ERROR: Ens. Size value must be greater or equal to 2.\n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_ens_size, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_ens_size_err_print, 'Visible', 'On')
-
+
return
end
-
+
turn_on_controls;
-
+
set(handles.ui_edit_ens_size, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_ens_size_err_print, 'Visible', 'Off')
-
+
% Generate a new ensemble by truncating old ensemble OR adding new
if(new_ens_size == handles.ens_size)
-
+
return
-
+
elseif(new_ens_size < handles.ens_size)
-
+
% Get rid of extra ensemble members, recompute mean, spread and kurtosis
handles.ens = handles.ens(1:new_ens_size);
handles.ens_size = new_ens_size;
-
+
else
% Add new ensemble members drawn from present distribution
handles.ens(handles.ens_size + 1 : new_ens_size) = ...
randn([1 new_ens_size - handles.ens_size]);
handles.ens_size = new_ens_size;
-
+
end
-
+
% Update moments
handles.error = calculate_rmse(handles.ens, 0.0);
handles.spread = std(handles.ens);
handles.kurtosis = kurt(handles.ens);
-
+
% If you change the ensemble size, you also have to reset the
% histograms.
handles.prior_rank = zeros(1, handles.ens_size + 1);
handles.post_rank = zeros(1, handles.ens_size + 1);
-
+
set_prior_histogram();
set_posterior_histogram();
-
+
end
%% -----------------------------------------------------------------------------
function model_bias_Callback(~, ~)
-
+
% Check to make sure the input is a valid number
model_bias_value = str2double(get(handles.ui_edit_model_bias, 'String'));
-
+
if(isfinite(model_bias_value) && (model_bias_value >= 0))
-
+
% If valid, update the value of the model bias.
handles.model_bias = model_bias_value;
turn_on_controls;
set(handles.ui_text_model_bias_err_print,'Visible','Off')
set(handles.ui_edit_model_bias, 'Enable', 'On', ...
'BackgroundColor', 'White');
-
+
else
% If not valid, force user to try again.
% After this, only this edit box will work
@@ -442,10 +442,10 @@ function model_bias_Callback(~, ~)
'Enable', 'On', ...
'BackgroundColor', atts.red);
set(handles.ui_text_model_bias_err_print,'Visible','On')
-
+
fprintf('ERROR: Model Bias value must be greater or equal to 0.\n')
fprintf('ERROR: Model Bias value must be greater or equal to 0.\n')
-
+
return
end
end
@@ -453,231 +453,230 @@ function model_bias_Callback(~, ~)
%% -----------------------------------------------------------------------------
function inflation_Callback(~, ~)
-
+
% Get the value of the inflation
inflation_value = str2double(get(handles.ui_edit_inflation, 'String'));
-
+
if(isfinite(inflation_value) && (inflation_value >= 1) && (inflation_value <= 5))
-
+
handles.inflation = inflation_value;
-
+
turn_on_controls;
-
+
set(handles.ui_edit_inflation, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_inf_err_print,'Visible','Off')
-
+
else
-
+
fprintf('ERROR: Inflation value must be between 1 and 5.\n')
fprintf('ERROR: Inflation value must be between 1 and 5.\n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_inflation, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_inf_err_print,'Visible','On')
-
+
return
-
+
end
-
+
end
%% -----------------------------------------------------------------------------
function nonlin_a_Callback(~, ~)
-
+
% Get the value of the model nonlinearity parameter 'alpha'
-
+
nonlin_value = str2double(get(handles.ui_edit_nonlin_a, 'String'));
-
+
if(isfinite(nonlin_value) && (nonlin_value >= 0))
-
+
handles.alpha = nonlin_value;
turn_on_controls;
-
+
set(handles.ui_edit_nonlin_a, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_nonlin_err_print, 'Visible', 'Off')
-
+
else % ERROR STATE, force them to fix before moving on
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
fprintf('ERROR: Nonlin a must be non-negative.\n')
fprintf('ERROR: Nonlin a must be non-negative.\n')
-
+
set(handles.ui_edit_nonlin_a, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_nonlin_err_print, 'Visible', 'On')
-
+
return
-
+
end
-
+
end
%% -----------------------------------------------------------------------------
function ClearHistograms_Callback(~, ~)
-
+
% An array to keep track of rank histograms
handles.prior_rank( 1 : handles.ens_size + 1) = 0;
handles.post_rank(1 : handles.ens_size + 1) = 0;
-
+
% Clear out the old graphics. The legends remain, which is nice.
cla(handles.h_prior_rank_histogram)
cla(handles.h_post_rank_histogram)
-
+
end
%% -----------------------------------------------------------------------------
function reset_button_Callback(~, ~)
-
+
initialize_data();
reset_graphics();
-
+
end
%% -----------------------------------------------------------------------------
function initialize_data(~, ~)
-
+
% Reset all the figures and the data structures
% Keep the current filter type, ensemble size and obs characteristics
% Reset the time to 1 and be ready to advance
-
+
% set random number seed to same value to generate known sequences
% rng('default') is the Mersenne Twister with seed 0
rng(0,'twister')
-
+
% Set up global storage with initial values
handles.ens_size = 4;
handles.ens = randn(1, handles.ens_size);
handles.model_bias = 0.0;
handles.inflation = 1.0;
-
+
handles.time_step = 1;
handles.ready_to_advance = true;
handles.alpha = 0.0; % aka nonlin a
handles.obs_error_sd = 1;
handles.observation = 0;
-
+
% Compute the initial error (truth is 0.0) and spread (standard deviation)
handles.error = calculate_rmse(handles.ens, 0.0);
handles.spread = std(handles.ens);
handles.kurtosis = kurt(handles.ens);
-
+
% An array to keep track of rank histograms
handles.prior_rank = zeros(1, handles.ens_size + 1);
handles.post_rank = zeros(1, handles.ens_size + 1);
-
+
% Set the ui values/strings to starting values.
set(handles.ui_button_advance_model, 'String', 'Advance Model');
-
+
set(handles.ui_edit_ens_size, 'Value', handles.ens_size);
set(handles.ui_edit_ens_size, 'String', sprintf('%d',handles.ens_size));
-
+
set(handles.ui_edit_model_bias, 'Value', handles.model_bias);
set(handles.ui_edit_model_bias, 'String', sprintf('%.1f',handles.model_bias));
-
+
set(handles.ui_edit_inflation, 'Value', handles.inflation);
set(handles.ui_edit_inflation, 'String', sprintf('%.1f',handles.inflation));
-
+
set(handles.ui_edit_nonlin_a, 'Value', handles.alpha);
set(handles.ui_edit_nonlin_a, 'String', sprintf('%.1f',handles.alpha));
-
+
end
%% -----------------------------------------------------------------------------
function reset_graphics(~, ~)
-
+
set_main_axes();
set_error_spread_evolution();
set_kurtosis_evolution()
set_prior_histogram();
set_posterior_histogram();
set_state_evolution();
-
+
end
%% -----------------------------------------------------------------------------
function auto_run_Callback(~, ~)
-
+
% Turn off all the other controls to avoid a mess
turn_off_controls;
-
+
set(handles.ui_button_start_auto_run, 'Enable', 'On');
-
+
if(strcmp(get(handles.ui_button_start_auto_run, 'String'), 'Pause Auto Run'))
-
+
% Being told to stop; switch to not running status
set(handles.ui_button_start_auto_run, 'String', 'Start Auto Run');
-
+
else
% Being told to start run
% Change the button to 'Pause Auto Run')
set(handles.ui_button_start_auto_run, 'String', 'Pause Auto Run');
-
+
% Loop through advance and assimilate steps until stopped
while(true)
-
+
% Check to see if stop has been pushed
status_string = get(handles.ui_button_start_auto_run, 'String');
-
+
if(strcmp(status_string, 'Start Auto Run'))
-
+
turn_on_controls;
-
+
return
-
+
end
-
+
% Do the next advance or assimilation step
step_ahead;
drawnow
-
+
end
-
+
end
-
+
% Turn all the other controls back on
turn_on_controls;
-
+
end
%% -----------------------------------------------------------------------------
function step_ahead(~, ~)
-
+
% Start out working in ensemble time series plot
axes(handles.h_state_evolution);
-
+
% If this is an advance, get and plot new model state, advance time
if(handles.ready_to_advance)
-
+
% Set to do an assimilation next time
handles.ready_to_advance = false;
-
+
% Advance the model and then inflate
ens_new = advance_oned(handles.ens, handles.alpha, handles.model_bias);
ens_new_mean = mean(ens_new);
ens_new = (ens_new - ens_new_mean) * sqrt(handles.inflation) + ens_new_mean;
-
+
% plot the model evolution
handles.time_step = handles.time_step + 1;
- h_evolution.prior = plot(handles.time_step - 0.1, ens_new, '*', ...
- 'MarkerSize', 6, 'Color', atts.green);
-
+ plot(handles.time_step - 0.1, ens_new, '*', 'MarkerSize', 6, 'Color', atts.green);
+
% Load up to plot all segments at once, more time efficient than previous loop
bx(1:2, 1:handles.ens_size) = 0;
by(1:2, 1:handles.ens_size) = 0;
@@ -686,145 +685,160 @@ function step_ahead(~, ~)
by(1, :) = handles.ens;
by(2, :) = ens_new;
plot(bx, by, 'Color', atts.green);
-
+
%% Plot the segment for the prior error and spread
% Want the lower y limit to stay 0 for error spread
axes(handles.h_err_spread_evolution);
-
+
prior_error = calculate_rmse(ens_new, 0.0);
prior_spread = std(ens_new);
-
+
h_e = line([handles.time_step - 1 + 0.1, handles.time_step - 0.1], ...
[handles.error, prior_error]);
set(h_e, 'Color', atts.blue, 'LineWidth', 2.0);
-
+
h_s = line([handles.time_step - 1 + 0.1, handles.time_step - 0.1], ...
[handles.spread, prior_spread]);
set(h_s, 'Color', atts.red, 'LineWidth', 2.0);
-
+
handles.error = prior_error;
handles.spread = prior_spread;
-
- legend([h_e h_s], 'Error', 'Spread', 'Location', 'NorthEast');
- set(legend,'FontName', atts.fontname, 'FontSize', atts.fontsize);
- legend boxon
-
+
+ L = legend([h_e h_s], 'Error', 'Spread', 'Location', 'NorthEast');
+ set(L,'FontName', atts.fontname, 'FontSize', atts.fontsize,'Box','on');
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+
axlims = axis;
axlims(3) = 0.0;
axis(axlims)
-
+
%% Plot the segment for the prior kurtosis
% Want the lower y limit to stay 0 for kurtosis
-
+
axes(handles.h_kurtosis_evolution);
-
+
prior_kurtosis = kurt(ens_new);
-
+
plot([handles.time_step - 1 + 0.1, handles.time_step - 0.1], ...
[handles.kurtosis, prior_kurtosis], 'Color', atts.red,'LineWidth',2);
-
+
handles.kurtosis = prior_kurtosis;
-
+
%% Update the prior rank histogram figure
axes(handles.h_prior_rank_histogram);
-
+
ens_rank = get_ens_rank(ens_new, 0);
-
+
% Plot the latest rank entry as a different color
temp_rank(:, 1) = handles.prior_rank(1:handles.ens_size + 1);
temp_rank(:, 2) = 0;
temp_rank(ens_rank, 2) = 1;
-
+
hold off
B = bar(temp_rank,'stacked');
B(1).FaceColor= atts.blue ; B(1).EdgeColor= 'k';
B(2).FaceColor= atts.yellow ; B(2).EdgeColor= 'k';
-
+
%% Plot the figure window for this update
axes(handles.axes);
cla;
-
+
% Want axes to encompass likely values for plotted obs_likelihood
% The height of the obs likelihood controls the vertical axis
- % The observed value will be between -4 and 4 with very high probability,
+ % The observed value will be between -4 and 4 with very high probability,
% then +/-3 more for likelihood, then +/- 3 more model bias and inflation
y_max = 1 / (sqrt(2 * pi) * handles.obs_error_sd);
xmin = -7;
xmax = 7;
xmin = min([xmin, min(ens_new)*1.02]);
xmax = max([xmax, max(ens_new)*1.02]);
-
+
% Put on a black axis line using data limits
plot([xmin xmax], [0, 0], 'k', 'Linewidth', 2);
hold on;
ens_axis = [xmin xmax -0.2 y_max + 0.02];
-
+
% Turn off the negative labels, enforce limits (faster than axis())
set(gca, 'YTick', [0 0.1 0.2 0.3 0.4], ...
- 'XLim' , [ens_axis(1) ens_axis(2)], ...
- 'YLim' , [ens_axis(3) ens_axis(4)]);
+ 'XLim' , [ens_axis(1) ens_axis(2)], ...
+ 'YLim' , [ens_axis(3) ens_axis(4)]);
grid on;
-
+
% Plot the prior ensemble members in green
% Plotting ticks instead of asterisks makes bins clearer
tick_half = 0.015;
-
+
for n_tick = 1:handles.ens_size
hg_prior = line([ens_new(n_tick), ens_new(n_tick)], ...
[-tick_half, tick_half]);
set(hg_prior, 'Color', atts.green, 'LineWidth', 2);
end
-
+
% Plot the truth (at 0) as a tick
hg_truth = line([0 0], [-0.02 0.02]);
set(hg_truth, 'Color', 'k', 'LineWidth', 2);
-
+
% Put in some information about the bin, x position tricky
base_x = max(0, ens_axis(3));
text_width = (ens_axis(4) - ens_axis(3)) / 3;
-
+
if((base_x + text_width) > ens_axis(4))
base_x = ens_axis(4) - text_width;
end
-
+
text(base_x, -0.1, ['Truth in Prior Bin ', num2str(ens_rank)], ...
'FontSize', 14, 'FontWeight', 'Bold','FontName', atts.fontname);
-
+
% Draw a line from the label string to the truth
h = line([base_x + text_width / 8, 0], [-0.08, -0.03]);
set(h, 'Color', 'k');
-
+
% Label this plot
xlabel('State' ,'FontName', atts.fontname, 'FontSize', atts.fontsize);
title('Latest Ensemble Prior','FontName', atts.fontname, 'FontSize', atts.fontsize);
-
+
L = legend([hg_prior hg_truth],'Prior','Truth');
set(L, 'FontName', atts.fontname, 'FontSize', atts.fontsize);
-
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+
% Update the permanent storage of the rank values
handles.prior_rank(ens_rank) = handles.prior_rank(ens_rank) + 1;
-
+
% Set the pushbutton to say Assimilate Obs
set(handles.ui_button_advance_model, 'String', 'Assimilate Obs');
-
+
% Update the global storage of the ensemble
handles.ens = ens_new;
-
+
else
% Ready to do an assimilation
% Next step should be an advance
handles.ready_to_advance = true;
-
+
% Generate the observation as a draw Normal(0, 1)
obs_error_sd = handles.obs_error_sd;
observation = obs_error_sd * randn(1);
-
+
% Plot the observation
plot(handles.time_step, observation, 'r*', 'MarkerSize', 10);
-
+
% Set the pushbutton to say Advance Model
set(handles.ui_button_advance_model, 'String', 'Advance Model');
-
+
% Adjust the horizontal range of the plot windows as needed
% Have moved to fixed 10-step wide windows rather than earlier shifting for speed
% Using cla clears out plot buffers and avoids slowdown with time
@@ -835,7 +849,7 @@ function step_ahead(~, ~)
axlims(1) = handles.time_step;
axlims(2) = handles.time_step + 10;
axis(axlims)
-
+
% Want the lower y limit to stay 0 for error spread
axes(handles.h_err_spread_evolution);
cla
@@ -844,7 +858,7 @@ function step_ahead(~, ~)
axlims(2) = handles.time_step + 10;
axlims(3) = 0.0;
axis(axlims)
-
+
% Want the lower y limit to stay 0 for kurtosis
axes(handles.h_kurtosis_evolution);
cla
@@ -853,19 +867,19 @@ function step_ahead(~, ~)
axlims(2) = handles.time_step + 10;
axlims(3) = 0.0;
axis(axlims)
-
+
end
-
+
% Do the assimilation
ens = handles.ens;
obs_error_sd = handles.obs_error_sd;
-
+
% Figure out which filter option is currently selected
val = get(handles.ui_radio_button_group,'SelectedObject');
filter_type = get(val,'String');
-
+
switch filter_type
-
+
case 'EAKF'
[obs_increments, ~] = ...
obs_increment_eakf(ens, observation, obs_error_sd^2);
@@ -876,17 +890,17 @@ function step_ahead(~, ~)
[obs_increments, ~] = ...
obs_increment_rhf(ens, observation, obs_error_sd^2);
end
-
+
%% Plot the evolution of the state
new_ens = ens + obs_increments;
axes(handles.h_state_evolution);
plot(handles.time_step + 0.1, new_ens, 'b*', 'MarkerSize', 6);
handles.ens = new_ens;
-
+
%% Update the rank data
axes(handles.h_post_rank_histogram);
ens_rank = get_ens_rank(handles.ens, 0);
-
+
% Plot the latest rank entry as a different color
temp_rank(:, 1) = handles.post_rank(1:handles.ens_size + 1);
temp_rank(:, 2) = 0;
@@ -896,59 +910,59 @@ function step_ahead(~, ~)
B = bar(temp_rank, 'stacked');
B(1).FaceColor= atts.blue ; B(1).EdgeColor= 'k';
B(2).FaceColor= atts.yellow ; B(2).EdgeColor= 'k';
-
+
% Update the permanent storage of the rank values
handles.post_rank(ens_rank) = handles.post_rank(ens_rank) + 1;
-
+
%% Plot the segment for the updated error
axes(handles.h_err_spread_evolution);
-
+
post_error = calculate_rmse(new_ens, 0.0);
-
+
h = plot([handles.time_step - 0.1, handles.time_step + 0.1], ...
[handles.error, post_error]);
set(h,'Color', atts.blue, 'LineWidth', 2.0);
-
+
handles.error = post_error;
-
+
%% Plot the segment for the updated spread
axes(handles.h_err_spread_evolution);
-
+
post_spread = std(new_ens);
h = plot([handles.time_step - 0.1, handles.time_step + 0.1], ...
[handles.spread, post_spread]);
set(h, 'Color', atts.red, 'LineWidth', 2.0);
-
+
handles.spread = post_spread;
-
+
%% Plot the segment for the updated kurtosis
axes(handles.h_kurtosis_evolution);
-
+
post_kurtosis = kurt(new_ens);
-
+
h = plot([handles.time_step - 0.1, handles.time_step + 0.1], ...
[handles.kurtosis, post_kurtosis]);
set(h, 'Color', atts.red, 'LineWidth', 2.0);
-
+
% Want the lower y limit to stay 0 for kurtosis
-
+
axlims = axis;
axlims(3) = 0.0;
axis(axlims)
-
+
handles.kurtosis= post_kurtosis;
-
+
%% Plot the figure for this update
axes(handles.axes);
cla;
-
+
% Find the limits of the plot
% The height of the obs likelihood controls the vertical axis
% Plot the observation likelihood
[hg_like, ~, ylims] = plot_gaussian(observation, obs_error_sd, 1.0);
set(hg_like, 'Color', atts.red, 'LineWidth', 2, 'LineStyle', '--');
hold on;
-
+
% Want axes to encompass likely values for plotted obs_likelihood
% The observed value will be between -4 and 4 with very high probability, then +/-3 more for likelihood
xmin = -7;
@@ -957,85 +971,94 @@ function step_ahead(~, ~)
% Want some slack if ensemble members are defining limits, too
xmin = min([xmin, min(ens)*1.02, min(new_ens)*1.02]);
xmax = max([xmax, max(ens)*1.02, max(new_ens)*1.02]);
-
+
ens_axis = [xmin xmax -0.2 ylims(2)+0.02];
axis(ens_axis);
-
+
% Put on a black axis line using data limits
plot([xmin xmax], [0, 0], 'k', 'Linewidth', 2);
-
+
% Plot the prior ensemble members in green
% Plotting ticks instead of asterisks makes bins clearer
tick_half = 0.015;
-
+
for n_tick = 1:handles.ens_size
hg_prior = plot([ens(n_tick), ens(n_tick)], ...
[-tick_half, tick_half], 'Color', atts.green, ...
'LineWidth', 2);
end
-
+
% Plot the posterior ensemble members in blue
for n_tick = 1:handles.ens_size
hg_post = plot([new_ens(n_tick), new_ens(n_tick)], ...
[-0.1 - tick_half, -0.1 + tick_half], 'Color', atts.blue, ...
'LineWidth', 2);
end
-
+
% Plot the observation (at 0) as an asterisk
plot(observation, 0, 'r*', 'MarkerSize', 14, 'LineWidth', 2.0);
-
+
% Plot the truth (at -0.1 and 0) as a tick
tick_half = 0.02;
plot([0 0], [-0.1 - tick_half, -0.1 + tick_half], ...
'k', 'LineWidth', 2.0);
-
+
plot([0 0], [- tick_half, tick_half], ...
'k', 'LineWidth', 2.0);
-
+
% Put in some information about the bin, x position tricky
base_x = max(0, ens_axis(1));
text_width = (ens_axis(2) - ens_axis(1)) / 3;
-
+
if((base_x + text_width) > ens_axis(2))
base_x = ens_axis(2) - text_width;
end
-
+
text(base_x, -0.18, ['Truth in Posterior Bin ', num2str(ens_rank)], ...
'FontSize', 14, 'FontWeight', 'Bold','FontName', atts.fontname);
-
+
% Draw a line from the label string to the truth
plot([base_x + text_width/8, 0], [-0.16, -0.13], 'k');
-
+
% Fix up the final axis
def_axis(1:2) = ens_axis(1:2);
def_axis(3) = -0.2;
def_axis(4) = 1 / (sqrt(2 * pi) * handles.obs_error_sd) + 0.02;
-
+
% Turn off the negative labels, enforce limits (faster than axis())
set(gca, 'YTick', [0 0.1 0.2 0.3 0.4], ...
- 'XLim' , [def_axis(1) def_axis(2)], ...
- 'YLim' , [def_axis(3) def_axis(4)]);
+ 'XLim' , [def_axis(1) def_axis(2)], ...
+ 'YLim' , [def_axis(3) def_axis(4)]);
grid on;
-
+
% Plot an additional axis
plot(ens_axis(1:2), [-0.1 -0.1], 'k', 'LineWidth', 2);
-
+
% Label this plot
xlabel('State','FontName', atts.fontname,'FontSize', atts.fontsize);
title('Latest Ensemble Prior, Likelihood, Posterior', ...
'FontName', atts.fontname, 'FontSize', atts.fontsize,'FontWeight', 'Bold');
-
+
% Put on legend
L = legend([hg_prior hg_post hg_like], 'Prior', 'Posterior', 'Likelihood', 'Location','NorthEast');
set(L, 'FontName', atts.fontname, 'FontSize', atts.fontsize);
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+
end
-
+
end
%% -----------------------------------------------------------------------------
function turn_off_controls()
-
+
% Turn off all the other controls to avoid a mess
set(handles.ui_button_advance_model, 'Enable', 'Off');
set(handles.ui_button_start_auto_run, 'Enable', 'Off');
@@ -1047,13 +1070,13 @@ function turn_off_controls()
set(handles.ui_radio_button_eakf, 'Enable', 'Off');
set(handles.ui_radio_button_enkf, 'Enable', 'Off');
set(handles.ui_radio_button_rhf, 'Enable', 'Off');
-
+
end
%% -----------------------------------------------------------------------------
function turn_on_controls ()
-
+
% Turn on all the other controls to avoid a mess
set(handles.ui_button_advance_model, 'Enable', 'On');
set(handles.ui_button_start_auto_run, 'Enable', 'On');
@@ -1065,23 +1088,23 @@ function turn_on_controls ()
set(handles.ui_radio_button_eakf, 'Enable', 'On');
set(handles.ui_radio_button_enkf, 'Enable', 'On');
set(handles.ui_radio_button_rhf, 'Enable', 'On');
-
+
end
%% -----------------------------------------------------------------------------
function y = calculate_rmse(x, truth)
-
+
squared_error = (x - truth).^2;
y = sqrt(mean(squared_error));
-
+
end
%% -----------------------------------------------------------------------------
function set_main_axes
-
+
if (isfield(handles,'axes'))
% 'cla reset' resets all properties of the axes except for the
% Position and Units properties.
@@ -1093,35 +1116,42 @@ function turn_on_controls ()
'Position' , [0.050 0.382 0.333 0.400], ...
'Color' , 'White');
end
-
+
% plot some bogus items to create handles for legend
hg_prior = plot([0 1],[0 0.1]);
set(hg_prior, 'LineWidth', 2, 'Color', atts.green, 'Visible', 'off');
-
+
hg_post = line([0 1], [0 0.1]);
set(hg_post, 'LineWidth', 2, 'Color', atts.blue, 'Visible', 'off');
-
+
hg_like = line([0 1], [0 0.1]);
set(hg_like, 'LineWidth', 2, 'Color', atts.red, 'LineStyle','--', 'Visible', 'off');
-
- legend([hg_prior hg_post hg_like],'Prior','Posterior','Likelihood');
- set(legend,'FontName', atts.fontname, 'FontSize', atts.fontsize);
- legend boxon
-
+
+ L = legend([hg_prior hg_post hg_like],'Prior','Posterior','Likelihood');
+ set(L, 'FontName', atts.fontname, 'FontSize', atts.fontsize,'Box','on');
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+
hold on;
% Set original horizontal axes
axis([-7 7 -Inf Inf])
-
+
end
%% -----------------------------------------------------------------------------
function set_state_evolution
-
+
% axes for ensemble time series
% plot some items invisible just to be able to create a legend with all the
% potential elements.
-
+
if (isfield(handles,'h_state_evolution'))
cla( handles.h_state_evolution,'reset');
axes(handles.h_state_evolution);
@@ -1131,36 +1161,46 @@ function turn_on_controls ()
'Position',[0.430 0.748 0.333 0.164], ...
'Color', 'White');
end
-
+
x(1:handles.ens_size) = handles.time_step + 0.1;
-
+
plot(x, handles.ens, 'b*', 'MarkerSize', 6);
hold on
str1 = '$x_{t+1} = x_t + (x_t+$model bias$) + a{\cdot}x_t{\cdot}{\mid}x_t{\mid}$';
str2 = '\hspace{1.5mm} observation is a draw from $\mathcal{N}(0,1)$';
TITLE = title( {str1,str2} );
set( TITLE, 'interpreter', 'latex', 'FontSize', 20, 'FontWeight', 'bold' );
-
+
% Include the 0 line as the truth for all times
plot([1 100000], [0 0], 'k--');
-
+
% plot the invisible stuff and capture a nice handle array for later.
h_truth = plot(1, 0, 'k--', 'Visible', 'on');
h_obs = plot(1, 0, 'r*' , 'Visible', 'on', 'MarkerSize', 10);
h_prior = plot(1, 0, 'g*-', 'Visible', 'on', 'MarkerSize', 6, 'Color', atts.green);
h_posterior = plot(1, 0, 'b*' , 'Visible', 'on', 'MarkerSize', 6);
h_evolution_handles = [h_truth h_obs h_prior h_posterior];
-
+
% Want the y axis limits to take care of themselves
set(gca, 'YLimMode', 'Auto','XTickLabel',[],'XGrid','on');
ylabel('State','FontName', atts.fontname,'FontSize', atts.fontsize);
-
- legend(h_evolution_handles, 'Truth', 'Observation', 'Prior', 'Posterior');
- set(legend,'FontName', atts.fontname, 'FontSize', 12, ...
+
+ L = legend(h_evolution_handles, 'Truth', 'Observation', 'Prior', 'Posterior');
+ set(L,'FontName', atts.fontname, ...
+ 'FontSize', 12, ...
+ 'Box', 'on', ...
'Position',[0.821 0.770 0.118 0.148])
- legend boxon
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+
axis([1 10 -Inf Inf]);
-
+
end
%% -----------------------------------------------------------------------------
@@ -1169,7 +1209,7 @@ function turn_on_controls ()
% axes for mean and spread
% calculate rmse and spread ... expectation over a long time is
% that they would be the same.
-
+
if (isfield(handles,'h_err_spread_evolution'))
cla( handles.h_err_spread_evolution,'reset');
axes(handles.h_err_spread_evolution);
@@ -1179,18 +1219,18 @@ function turn_on_controls ()
'Position',[0.430 0.557 0.333 0.164], ...
'Color', 'White');
end
-
+
ylabel('Error, Spread','FontName', atts.fontname,'FontSize', atts.fontsize);
axis([1 10 0 Inf]);
set(gca,'XTickLabel',[],'XGrid','on')
hold on;
-
+
end
%% -----------------------------------------------------------------------------
function set_kurtosis_evolution
-
+
% axes for kurtosis
if (isfield(handles,'h_kurtosis_evolution'))
cla( handles.h_kurtosis_evolution,'reset');
@@ -1202,19 +1242,19 @@ function turn_on_controls ()
'Color', 'White', ...
'XAxisLocation','bottom');
end
-
+
axis([1 10 0 Inf]);
ylabel('Kurtosis', 'FontName', atts.fontname, 'FontSize', atts.fontsize);
xlabel('Timestep', 'FontName', atts.fontname, 'FontSize', atts.fontsize);
set(gca,'XGrid', 'on')
hold on;
-
+
end
%% -------------------------------------------------------------------------
function set_prior_histogram()
-
+
% axes for prior rank histogram
if (isfield(handles,'h_prior_rank_histogram'))
cla( handles.h_prior_rank_histogram,'reset');
@@ -1223,20 +1263,20 @@ function set_prior_histogram()
else
handles.h_prior_rank_histogram = axes('Position',[0.050 0.075 0.333 0.208]);
end
-
+
ylabel('Frequency' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
xlabel('Rank' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
title ('Prior Rank Histogram','FontName', atts.fontname,'FontSize', atts.fontsize);
axis([0 handles.ens_size+2 -Inf Inf])
set(handles.h_prior_rank_histogram,'XTick',1:(handles.ens_size+1));
hold on
-
+
end
%% -----------------------------------------------------------------------------
function set_posterior_histogram()
-
+
% axes for posterior rank histogram
if (isfield(handles,'h_post_rank_histogram'))
cla(handles.h_post_rank_histogram,'reset');
@@ -1245,14 +1285,14 @@ function set_posterior_histogram()
else
handles.h_post_rank_histogram = axes('Position',[0.43 0.075 0.333 0.208]);
end
-
+
ylabel('Frequency' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
xlabel('Rank' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
title ('Posterior Rank Histogram','FontName', atts.fontname,'FontSize', atts.fontsize);
axis([0 handles.ens_size+2 -Inf Inf])
set(handles.h_post_rank_histogram,'XTick',1:(handles.ens_size+1));
hold on;
-
+
end
%% -----------------------------------------------------------------------------
diff --git a/documentation/DART_LAB/matlab/oned_model_inf.m b/documentation/DART_LAB/matlab/oned_model_inf.m
index 8668332695..68f7692530 100644
--- a/documentation/DART_LAB/matlab/oned_model_inf.m
+++ b/documentation/DART_LAB/matlab/oned_model_inf.m
@@ -187,7 +187,6 @@
handles.nonlin_a = str2double(get(handles.ui_edit_nonlin_a,'String'));
-
%% -------------------------t---------------------------------------------------
% Set up another parent container so we can move the one container around instead of
% trying to manipulate the positions of all the components.
@@ -552,8 +551,8 @@
%% -----------------------------------------------------------------------------
-% Initiate log file
-if exist(LOG_FILE, 'file') == 2
+% Initiate log file
+if exist(LOG_FILE, 'file') == 2
logfileid = fopen(LOG_FILE, 'a');
else
logfileid = fopen(LOG_FILE, 'w');
@@ -563,7 +562,7 @@
fprintf(logfileid, '*********************** %s ************************\n\n', mfilename);
end
-fprintf(logfileid, '\n\nNEW RUN: Starting date and time %s\n', datetime);
+fprintf(logfileid, '\n\nNEW RUN: Starting date and time %s\n', datestr(datetime));
fprintf(logfileid, '========\n\n');
fprintf(logfileid, '# Time step: %d (Initial configuration)\n', handles.time_step);
@@ -582,91 +581,91 @@
%% -----------------------------------------------------------------------------
function ens_size_Callback(~, ~)
-
+
new_ens_size = str2double(get(handles.ui_edit_ens_size, 'String'));
old_ens_size = handles.ens_size;
% Get a new ensemble size if not valid value
if( ~ isfinite(new_ens_size) || (new_ens_size < 2) )
-
+
fprintf('ERROR: Ens. Size value must be greater or equal to 2.\n')
fprintf('ERROR: Ens. Size value must be greater or equal to 2.\n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_ens_size, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_ens_size_err_print, 'Visible', 'On')
-
+
return
end
-
+
turn_on_controls;
-
+
set(handles.ui_edit_ens_size, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_ens_size_err_print, 'Visible', 'Off')
-
+
% Generate a new ensemble by truncating old ensemble OR adding new
if(new_ens_size == handles.ens_size)
-
+
return
-
+
elseif(new_ens_size < handles.ens_size)
-
+
% Get rid of extra ensemble members, recompute mean and spread
handles.ens = handles.ens(1:new_ens_size);
handles.ens_size = new_ens_size;
-
+
else
% Add new ensemble members drawn from present distribution
handles.ens(handles.ens_size + 1 : new_ens_size) = ...
randn([1 new_ens_size - handles.ens_size]);
handles.ens_size = new_ens_size;
-
+
end
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, ...
- 'Ensemble size', old_ens_size, handles.ens_size);
-
+ 'Ensemble size', old_ens_size, handles.ens_size);
+
% Update moments
handles.error = calculate_rmse(handles.ens, 0.0);
handles.spread = std(handles.ens);
-
+
% If you change the ensemble size, you also have to reset the
% histograms.
handles.prior_rank = zeros(1, handles.ens_size + 1);
handles.post_rank = zeros(1, handles.ens_size + 1);
-
+
set_prior_histogram();
set_posterior_histogram();
-
+
end
%% -----------------------------------------------------------------------------
function model_bias_Callback(~, ~)
-
+
% Check to make sure the input is a valid number
model_bias_value = str2double(get(handles.ui_edit_model_bias, 'String'));
- old_model_bias_value = handles.model_bias;
-
+ old_model_bias_value = handles.model_bias;
+
if(isfinite(model_bias_value) && (model_bias_value >= 0))
-
+
% If valid, update the value of the model bias.
handles.model_bias = model_bias_value;
turn_on_controls;
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, ...
- 'Model bias', old_model_bias_value, handles.model_bias);
+ 'Model bias', old_model_bias_value, handles.model_bias);
set(handles.ui_text_model_bias_err_print,'Visible','Off')
set(handles.ui_edit_model_bias, 'Enable', 'On', ...
'BackgroundColor', 'White');
-
+
else
% If not valid, force user to try again.
% After this, only this edit box will work
@@ -675,10 +674,10 @@ function model_bias_Callback(~, ~)
'Enable', 'On', ...
'BackgroundColor', atts.red);
set(handles.ui_text_model_bias_err_print,'Visible','On')
-
+
fprintf('ERROR: Model Bias value must be greater or equal to 0.\n')
fprintf('ERROR: Model Bias value must be greater or equal to 0.\n')
-
+
return
end
end
@@ -686,257 +685,257 @@ function model_bias_Callback(~, ~)
%% -----------------------------------------------------------------------------
function fixed_inflation_Callback(~, ~)
-
+
% Get the value of the inflation
inflation_value = str2double(get(handles.ui_edit_fixed_inflation, 'String'));
- old_inflation_value = handles.inflation;
-
+ old_inflation_value = handles.inflation;
+
if(isfinite(inflation_value) && (inflation_value >= 1) && (inflation_value <= 5))
-
+
handles.inflation = inflation_value;
turn_on_controls;
-
+
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, ...
- 'Fixed inflation value', old_inflation_value, handles.inflation);
+ 'Fixed inflation value', old_inflation_value, handles.inflation);
set(handles.ui_edit_fixed_inflation, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_inf_err_print,'Visible','Off')
-
+
else
-
+
fprintf('ERROR: Fixed Inflation value must be between 1 and 5.\n')
fprintf('ERROR: Fixed Inflation value must be between 1 and 5.\n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_fixed_inflation, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_inf_err_print, 'Visible','On')
-
+
return
-
+
end
-
+
end
%% -----------------------------------------------------------------------------
function adap_inf_Damp_Callback(~, ~)
-
+
% Get the value of the inflation
inf_Damp_value = str2double(get(handles.ui_edit_adap_inf_Damp, 'String'));
- old_inf_Damp_value = handles.adap_inf_Damp;
-
+ old_inf_Damp_value = handles.adap_inf_Damp;
+
if(isfinite(inf_Damp_value) && (inf_Damp_value >= .1) && (inf_Damp_value <= 1) )
-
+
handles.adap_inf_Damp = inf_Damp_value;
turn_on_controls;
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, ...
- 'Inflation damping factor', old_inf_Damp_value, handles.adap_inf_Damp);
-
+ 'Inflation damping factor', old_inf_Damp_value, handles.adap_inf_Damp);
+
set(handles.ui_edit_adap_inf_Damp, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_inf_damp_err_print,'Visible','Off')
-
+
else
-
+
fprintf('ERROR: Inf. Damp value must be between 0.1 and 1. \n')
fprintf('ERROR: Inf. Damp value must be between 0.1 and 1. \n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_adap_inf_Damp, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_inf_damp_err_print, 'Visible','On')
-
+
return
-
+
end
-
+
end
%% -----------------------------------------------------------------------------
function adap_inf_Min_Callback(~, ~)
-
+
% Get the value of the inflation
inf_Min_value = str2double(get(handles.ui_edit_adap_inf_Min, 'String'));
old_inf_Min_value = handles.adap_inf_Min;
-
+
if(isfinite(inf_Min_value) && (inf_Min_value >= 0.) )
-
+
handles.adap_inf_Min = inf_Min_value;
turn_on_controls;
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, ...
- 'Inflation lower bound', old_inf_Min_value, handles.adap_inf_Min);
-
+ 'Inflation lower bound', old_inf_Min_value, handles.adap_inf_Min);
+
set(handles.ui_edit_adap_inf_Min, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_inf_min_err_print,'Visible','Off')
-
+
else
-
+
fprintf('ERROR: Inf. Min value must be greater or equal to 0. \n')
fprintf('ERROR: Inf. Min value must be greater or equal to 0. \n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_adap_inf_Min, 'Enable', 'On', ...
'String', '?' , ...
'BackgroundColor', atts.red);
set(handles.ui_text_inf_min_err_print, 'Visible','On')
-
+
return
-
+
end
-
+
end
%% -----------------------------------------------------------------------------
function adap_inf_Max_Callback(~, ~)
-
+
% Get the value of the inflation
inf_Max_value = str2double(get(handles.ui_edit_adap_inf_Max, 'String'));
inf_Min_tmpor = str2double(get(handles.ui_edit_adap_inf_Min, 'String'));
old_inf_Max_value = handles.adap_inf_Max;
-
+
if(isfinite(inf_Max_value) && (inf_Max_value >= inf_Min_tmpor) && (inf_Max_value <= 5.) )
-
+
handles.adap_inf_Max = inf_Max_value;
turn_on_controls;
-
+
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, ...
- 'Inflation upper bound', old_inf_Max_value, handles.adap_inf_Max);
+ 'Inflation upper bound', old_inf_Max_value, handles.adap_inf_Max);
set(handles.ui_edit_adap_inf_Max, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_inf_max_err_print,'Visible','Off')
-
+
else
-
+
fprintf('ERROR: Inf. Max value must be greater than or equal Inf. Min and less than or equal 5. \n')
fprintf('ERROR: Inf. Max value must be greater than or equal Inf. Min and less than or equal 5. \n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_adap_inf_Max, 'Enable', 'On', ...
'String', '?' , ...
'BackgroundColor', atts.red);
set(handles.ui_text_inf_max_err_print, 'Visible','On')
-
+
return
-
+
end
-
+
end
%% -----------------------------------------------------------------------------
function adap_inf_Std_Callback(~, ~)
-
+
% Get the value of the inflation
inf_Std_value = str2double(get(handles.ui_edit_adap_inf_Std, 'String'));
int_std_min_val = str2double(get(handles.ui_edit_adap_inf_Std_Min, 'String'));
- old_inf_Std_value = handles.adap_inf_Std;
-
+ old_inf_Std_value = handles.adap_inf_Std;
+
if(isfinite(inf_Std_value) && (inf_Std_value > 0) && (inf_Std_value >= int_std_min_val))
-
+
handles.adap_inf_Std = inf_Std_value;
turn_on_controls;
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, ...
- 'Inflation S.D.', old_inf_Std_value, handles.adap_inf_Std);
-
+ 'Inflation S.D.', old_inf_Std_value, handles.adap_inf_Std);
+
set(handles.ui_edit_adap_inf_Std, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_inf_std_err_print,'Visible','Off')
-
+
elseif (inf_Std_value < int_std_min_val)
-
+
fprintf('ERROR: Initial Inf. Std value must be greater than the lower bound.\n')
fprintf('ERROR: Initial Inf. Std value must be greater than the lower bound.\n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_adap_inf_Std, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_inf_std_err_print, 'Visible','On')
-
+
return
-
+
else
-
+
fprintf('ERROR: Initial Inf. Std value must be greater than 0.\n')
fprintf('ERROR: Initial Inf. Std value must be greater than 0.\n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_adap_inf_Std, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_inf_std_err_print, 'Visible','On')
-
+
return
-
+
end
-
+
end
%% -----------------------------------------------------------------------------
function adap_inf_Std_Min_Callback(~, ~)
-
+
% Get the value of the inflation
inf_Std_Min_value = str2double(get(handles.ui_edit_adap_inf_Std_Min, 'String'));
old_inf_Std_Min_value = handles.adap_inf_Std_Min;
-
+
if(isfinite(inf_Std_Min_value) && (inf_Std_Min_value > 0) && (inf_Std_Min_value < handles.adap_inf_Std))
-
+
handles.adap_inf_Std_Min = inf_Std_Min_value;
turn_on_controls;
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, ...
- 'Inflation S.D. lower bound', old_inf_Std_Min_value, handles.adap_inf_Std_Min);
-
+ 'Inflation S.D. lower bound', old_inf_Std_Min_value, handles.adap_inf_Std_Min);
+
set(handles.ui_edit_adap_inf_Std_Min, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_inf_std_min_err_print,'Visible','Off')
-
+
elseif (inf_Std_Min_value > handles.adap_inf_Std)
% if the new value for the lower-bound is larger than the
% current SD, set the current SD value to the new Minimum.
handles.adap_inf_Std = inf_Std_Min_value;
-
+
else
-
+
fprintf('ERROR: Lower bound of Inf. Std must be greater than 0.\n')
fprintf('ERROR: Lower bound of Inf. Std must be greater than 0.\n')
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
set(handles.ui_edit_adap_inf_Std_Min, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_inf_std_min_err_print, 'Visible','On')
-
+
return
-
+
end
-
+
end
%% -----------------------------------------------------------------------------
@@ -946,36 +945,36 @@ function nonlin_a_Callback(~, ~)
% Get the value of the model nonlinearity parameter 'alpha'
nonlin_value = str2double(get(handles.ui_edit_nonlin_a, 'String'));
old_nonlin_value = handles.alpha;
-
+
if(isfinite(nonlin_value) && (nonlin_value >= 0))
-
+
handles.alpha = nonlin_value;
turn_on_controls;
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, ...
- 'Nonlinear `a` parameter', old_nonlin_value, handles.alpha);
-
+ 'Nonlinear `a` parameter', old_nonlin_value, handles.alpha);
+
set(handles.ui_edit_nonlin_a, 'Enable', 'On', 'BackgroundColor', 'White');
set(handles.ui_text_nonlin_err_print, 'Visible', 'Off')
-
+
else % ERROR STATE, force them to fix before moving on
-
+
% After this, only this edit box will work
turn_off_controls;
-
+
fprintf('ERROR: Nonlin a must be non-negative.\n')
fprintf('ERROR: Nonlin a must be non-negative.\n')
-
+
set(handles.ui_edit_nonlin_a, 'Enable', 'On', ...
'String', '?', ...
'BackgroundColor', atts.red);
set(handles.ui_text_nonlin_err_print, 'Visible', 'On')
-
+
return
-
+
end
-
+
end
@@ -985,9 +984,9 @@ function Update_log_file(t1, t2, RMS, AES, info, p1, p2)
logfileid = fopen(LOG_FILE, 'a');
- fprintf(logfileid, '# Time step: %d\n', t2);
+ fprintf(logfileid, '# Time step: %d\n', t2);
fprintf(logfileid, ' >> Statistics over period (%d:%d): avg. RMSE = %.2f, avg. Spread = %.2f\n', ...
- t1, t2, mean(RMS(t1:t2)), mean(AES(t1:t2)));
+ t1, t2, mean(RMS(t1:t2)), mean(AES(t1:t2)));
if strcmp(info, 'Ensemble size') == 1
fprintf(logfileid, ' $$ User input: %s has been changed from %d to %d\n\n', info, p1, p2);
@@ -1024,41 +1023,47 @@ function ClearStats_Callback(~, ~)
% Update log file
Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, 'Statistics cleared');
-
+
% An array to keep track of rank histograms
handles.prior_rank( 1 : handles.ens_size + 1) = 0;
handles.post_rank(1 : handles.ens_size + 1) = 0;
-
+
% Clear out the old graphics. The legends remain, which is nice.
cla(handles.h_prior_rank_histogram)
cla(handles.h_post_rank_histogram)
- % Cearing Error/Spread Stats
+ % Clearing Error/Spread Stats
handles.time_last_change = handles.time_step;
axes(handles.h_err_spread_evolution);
-
- L = legend('Error','Spread','Location', 'NorthWest');
- L_title = get(L, 'Title');
- set(L_title, 'String', [ 'Averaging Over Steps (' num2str(handles.time_last_change) ':n)' ], ...
- 'FontSize', atts.fontsize, 'FontWeight', 'normal')
-
+ L = legend('Error','Spread','Location', 'NorthWest');
set(L,'FontName', atts.fontname, 'FontSize', atts.fontsize, 'EdgeColor', 'w');
-
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+ title(sprintf('Averaging Over Steps (%d:n)', handles.time_last_change), ...
+ 'FontSize', atts.fontsize, 'FontWeight', 'normal');
+
end
%% -----------------------------------------------------------------------------
function reset_button_Callback(~, ~)
-
+
initialize_data();
reset_graphics();
-
+
% Update log file
if handles.time_step > 1
- Update_log_file(handles.time_last_change, handles.time_step, handles.error_hist, handles.spread_hist, 'RESET');
+ Update_log_file(handles.time_last_change, handles.time_step, ...
+ handles.error_hist, handles.spread_hist, 'RESET');
end
end
@@ -1066,15 +1071,15 @@ function reset_button_Callback(~, ~)
function initialize_data(~, ~)
-
+
% Reset all the figures and the data structures
% Keep the current filter type, ensemble size and obs characteristics
% Reset the time to 1 and be ready to advance
-
+
% set random number seed to same value to generate known sequences
% rng('default') is the Mersenne Twister with seed 0
rng(0,'twister')
-
+
% Set up global storage with initial values
handles.ens_size = 4;
handles.ens = randn(1, handles.ens_size);
@@ -1085,7 +1090,7 @@ function initialize_data(~, ~)
handles.adap_inf_Max = 100.0;
handles.adap_inf_Std = 0.6;
handles.adap_inf_Std_Min = 0.6;
-
+
handles.time_step = 1;
handles.ready_to_advance = true;
handles.alpha = 0.0; % aka nonlin a
@@ -1094,129 +1099,129 @@ function initialize_data(~, ~)
handles.error_hist = 0;
handles.spread_hist = 0;
handles.time_last_change = 1;
-
+
% Compute the initial error (truth is 0.0) and spread (standard deviation)
handles.error = calculate_rmse(handles.ens, 0.0);
handles.spread = std(handles.ens);
-
+
% An array to keep track of rank histograms
handles.prior_rank = zeros(1, handles.ens_size + 1);
handles.post_rank = zeros(1, handles.ens_size + 1);
-
+
% Set the ui values/strings to starting values.
set(handles.ui_button_advance_model, 'String' , 'Advance Model');
-
+
set(handles.ui_edit_ens_size, 'Value' , handles.ens_size);
set(handles.ui_edit_ens_size, 'String' , sprintf('%d',handles.ens_size));
-
+
set(handles.ui_edit_model_bias, 'Value' , handles.model_bias);
set(handles.ui_edit_model_bias, 'String' , sprintf('%.1f',handles.model_bias));
-
+
set(handles.ui_edit_nonlin_a, 'Value' , handles.alpha);
set(handles.ui_edit_nonlin_a, 'String' , sprintf('%.1f',handles.alpha));
-
+
set(handles.ui_edit_fixed_inflation, 'Value' , handles.inflation);
set(handles.ui_edit_fixed_inflation, 'String' , sprintf('%.2f',handles.inflation));
-
+
set(handles.ui_edit_adap_inf_Min, 'Value' , handles.adap_inf_Min);
set(handles.ui_edit_adap_inf_Min, 'String' , sprintf('%.1f',handles.adap_inf_Min));
-
+
set(handles.ui_edit_adap_inf_Damp, 'Value' , handles.adap_inf_Damp);
set(handles.ui_edit_adap_inf_Damp, 'String' , sprintf('%.1f',handles.adap_inf_Damp));
-
+
set(handles.ui_edit_adap_inf_Max, 'Value' , handles.adap_inf_Max);
set(handles.ui_edit_adap_inf_Max, 'String' , sprintf('%.1f',handles.adap_inf_Max));
-
+
set(handles.ui_edit_adap_inf_Std, 'Value' , handles.adap_inf_Std);
set(handles.ui_edit_adap_inf_Std, 'String' , sprintf('%.1f',handles.adap_inf_Std));
-
+
set(handles.ui_edit_adap_inf_Std_Min, 'Value' , handles.adap_inf_Std_Min);
set(handles.ui_edit_adap_inf_Std_Min, 'String' , sprintf('%.1f',handles.adap_inf_Std_Min));
-
+
end
%% -----------------------------------------------------------------------------
function reset_graphics(~, ~)
-
+
set_main_axes();
set_error_spread_evolution();
set_inflation_evolution()
set_prior_histogram();
set_posterior_histogram();
set_state_evolution();
-
+
end
%% -----------------------------------------------------------------------------
function auto_run_Callback(~, ~)
-
+
% Turn off all the other controls to avoid a mess
turn_off_controls;
-
+
set(handles.ui_button_start_auto_run, 'Enable', 'On');
-
+
if(strcmp(get(handles.ui_button_start_auto_run, 'String'), 'Pause Auto Run'))
-
+
% Being told to stop; switch to not running status
set(handles.ui_button_start_auto_run, 'String', 'Start Auto Run');
-
+
else
% Being told to start run
% Change the button to 'Pause Auto Run')
set(handles.ui_button_start_auto_run, 'String', 'Pause Auto Run');
-
+
% Loop through advance and assimilate steps until stopped
while(true)
-
+
% Check to see if stop has been pushed
status_string = get(handles.ui_button_start_auto_run, 'String');
-
+
if(strcmp(status_string, 'Start Auto Run'))
-
+
turn_on_controls;
-
+
return
-
+
end
-
+
% Do the next advance or assimilation step
step_ahead;
drawnow
-
+
end
-
+
end
-
+
% Turn all the other controls back on
turn_on_controls;
-
+
end
%% -----------------------------------------------------------------------------
function step_ahead(~, ~)
-
+
% Start out working in ensemble time series plot
axes(handles.h_state_evolution);
-
+
% If this is an advance, get and plot new model state, advance time
if(handles.ready_to_advance)
-
+
% Set to do an assimilation next time
handles.ready_to_advance = false;
-
+
% Advance the model and then inflate
ens_new = advance_oned(handles.ens, handles.alpha, handles.model_bias);
ens_new_mean = mean(ens_new);
ens_new = (ens_new - ens_new_mean) * sqrt(handles.inflation) + ens_new_mean;
-
+
% plot the model evolution
handles.time_step = handles.time_step + 1;
h_evolution.prior = plot(handles.time_step - 0.1, ens_new, '*', ...
'MarkerSize', 6, 'Color', atts.green);
-
+
% Load up to plot all segments at once, more time efficient than previous loop
bx(1:2, 1:handles.ens_size) = 0;
by(1:2, 1:handles.ens_size) = 0;
@@ -1225,38 +1230,38 @@ function step_ahead(~, ~)
by(1, :) = handles.ens;
by(2, :) = ens_new;
plot(bx, by, 'Color', atts.green);
-
+
%% Plot the segment for the prior error and spread
% Want the lower y limit to stay 0 for error spread
axes(handles.h_err_spread_evolution);
-
+
prior_error = calculate_rmse(ens_new, 0.0);
prior_spread = std(ens_new);
-
+
h_e = line([handles.time_step - 1 + 0.1, handles.time_step - 0.1], ...
[handles.error, prior_error]);
set(h_e, 'Color', atts.blue, 'LineWidth', 2.0);
-
+
h_s = line([handles.time_step - 1 + 0.1, handles.time_step - 0.1], ...
[handles.spread, prior_spread]);
set(h_s, 'Color', atts.red, 'LineWidth', 2.0);
-
+
handles.error = prior_error;
handles.spread = prior_spread;
handles.error_hist(handles.time_step) = handles.error;
handles.spread_hist(handles.time_step) = handles.spread;
-
+
% Update the prior rank histogram figure
axes(handles.h_prior_rank_histogram);
-
+
ens_rank = get_ens_rank(ens_new, 0);
-
+
% Plot the latest rank entry as a different color
temp_rank(:, 1) = handles.prior_rank(1:handles.ens_size + 1);
temp_rank(:, 2) = 0;
temp_rank(ens_rank, 2) = 1;
-
+
hold off
B = bar(temp_rank,'stacked');
B(1).FaceColor= atts.blue ; B(1).EdgeColor= 'k';
@@ -1264,79 +1269,79 @@ function step_ahead(~, ~)
ylabel('Frequency' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
xlabel('Rank' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
title ('Prior Rank Histogram','FontName', atts.fontname,'FontSize', atts.fontsize);
-
+
% Plot the figure window for this update
axes(handles.axes);
cla;
-
+
% Want axes to encompass likely values for plotted obs_likelihood
% The height of the obs likelihood controls the vertical axis
- % The observed value will be between -4 and 4 with very high probability,
+ % The observed value will be between -4 and 4 with very high probability,
% then +/-3 more for likelihood, then +/- 3 more model bias and inflation
y_max = 1 / (sqrt(2 * pi) * handles.obs_error_sd);
xmin = -10;
xmax = 10;
-
+
% Put on a black axis line using data limits
plot([xmin xmax], [0, 0], 'k', 'Linewidth', 2);
hold on
ens_axis = [xmin xmax -0.2 y_max + 0.02];
grid on
-
+
% Plot the prior ensemble members in green
% Plotting ticks instead of asterisks makes bins clearer
tick_half = 0.015;
-
+
for n_tick = 1:handles.ens_size
hg_prior = line([ens_new(n_tick), ens_new(n_tick)], ...
[-tick_half, tick_half]);
set(hg_prior, 'Color', atts.green, 'LineWidth', 2);
end
-
+
% Plot the truth (at 0) as a tick
hg_truth = line([0 0], [-0.02 0.02]);
set(hg_truth, 'Color', 'k', 'LineWidth', 2);
-
+
% Put in some information about the bin, x position tricky
base_x = max(0, ens_axis(3));
text_width = (ens_axis(4) - ens_axis(3)) / 3;
-
+
if((base_x + text_width) > ens_axis(4))
base_x = ens_axis(4) - text_width;
end
-
+
text(base_x, -0.1, ['Truth in Prior Bin ', num2str(ens_rank)], ...
'FontSize', 14, 'FontWeight', 'Bold','FontName', atts.fontname);
-
+
% Draw a line from the label string to the truth
h = line([base_x + text_width / 8, 0], [-0.08, -0.03]);
set(h, 'Color', 'k');
-
+
% Update the permanent storage of the rank values
handles.prior_rank(ens_rank) = handles.prior_rank(ens_rank) + 1;
-
+
% Set the pushbutton to say Assimilate Obs
set(handles.ui_button_advance_model, 'String', 'Assimilate Obs');
-
+
% Update the global storage of the ensemble
handles.ens = ens_new;
-
+
else
% Ready to do an assimilation
% Next step should be an advance
handles.ready_to_advance = true;
-
+
% Generate the observation as a draw Normal(0, 1)
obs_error_sd = handles.obs_error_sd;
observation = obs_error_sd * randn(1);
inf_prior = handles.inflation;
-
+
% Plot the observation
plot(handles.time_step, observation, 'r*', 'MarkerSize', 10);
-
+
% Set the pushbutton to say Advance Model
set(handles.ui_button_advance_model, 'String', 'Advance Model');
-
+
% Adjust the horizontal range of the plot windows as needed
% Have moved to fixed 10-step wide windows rather than earlier shifting for speed
% Using cla clears out plot buffers and avoids slowdown with time
@@ -1347,7 +1352,7 @@ function step_ahead(~, ~)
axlims(1) = handles.time_step;
axlims(2) = handles.time_step + 10;
axis(axlims)
-
+
% Want the lower y limit to stay 0 for error spread
axes(handles.h_err_spread_evolution);
cla
@@ -1356,7 +1361,7 @@ function step_ahead(~, ~)
axlims(2) = handles.time_step + 10;
axlims(3) = 0.0;
axis(axlims)
-
+
% Want the lower y limit to stay 0 for inflation
axes(handles.h_inflation_evolution);
cla
@@ -1364,22 +1369,22 @@ function step_ahead(~, ~)
axlims(1) = handles.time_step;
axlims(2) = handles.time_step + 10;
axis(axlims)
-
+
end
-
+
% Do the assimilation
ens = handles.ens;
obs_error_sd = handles.obs_error_sd;
-
+
% Figure out which inflation option is currently selected
val = get(handles.ui_Inflate_Panel,'SelectedObject');
inflation_type = get(val,'String');
-
+
switch inflation_type
-
+
case 'Fixed Inflation'
handles.inflation = str2double(get(handles.ui_edit_fixed_inflation,'String'));
-
+
case 'Adaptive Inflation'
[lambda, handles.adap_inf_Std] = ...
update_inflate(mean(ens), var(ens), observation, obs_error_sd^2, inf_prior, ...
@@ -1389,13 +1394,13 @@ function step_ahead(~, ~)
% It won't matter because it's a single variable case!
handles.inflation = 1.0 + handles.adap_inf_Damp * ( lambda - 1.0 );
end
-
+
% Figure out which filter option is currently selected
val = get(handles.ui_radio_button_group,'SelectedObject');
filter_type = get(val,'String');
-
+
switch filter_type
-
+
case 'EAKF'
[obs_increments, ~] = ...
obs_increment_eakf(ens, observation, obs_error_sd^2);
@@ -1406,21 +1411,21 @@ function step_ahead(~, ~)
[obs_increments, ~] = ...
obs_increment_rhf(ens, observation, obs_error_sd^2);
end
-
+
new_ens = ens + obs_increments;
axes(handles.h_state_evolution);
plot(handles.time_step + 0.1, new_ens, 'b*', 'MarkerSize', 6);
handles.ens = new_ens;
-
+
% Update the rank data
axes(handles.h_post_rank_histogram);
ens_rank = get_ens_rank(handles.ens, 0);
-
+
% Plot the latest rank entry as a different color
temp_rank(:, 1) = handles.post_rank(1:handles.ens_size + 1);
temp_rank(:, 2) = 0;
temp_rank(ens_rank, 2) = 1;
-
+
hold off
B = bar(temp_rank, 'stacked');
B(1).FaceColor= atts.blue ; B(1).EdgeColor= 'k';
@@ -1428,30 +1433,30 @@ function step_ahead(~, ~)
ylabel('Frequency' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
xlabel('Rank' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
title ('Posterior Rank Histogram','FontName', atts.fontname,'FontSize', atts.fontsize);
-
+
% Update the permanent storage of the rank values
handles.post_rank(ens_rank) = handles.post_rank(ens_rank) + 1;
-
+
%% Plot the segment for the updated error
axes(handles.h_err_spread_evolution);
-
+
post_error = calculate_rmse(new_ens, 0.0);
-
+
h = plot([handles.time_step - 0.1, handles.time_step + 0.1], ...
[handles.error, post_error]);
set(h,'Color', atts.blue, 'LineWidth', 2.0);
-
+
handles.error = post_error;
-
+
% Plot the segment for the updated spread
post_spread = std(new_ens);
-
+
axes(handles.h_err_spread_evolution);
-
+
h = plot([handles.time_step - 0.1, handles.time_step + 0.1], ...
[handles.spread, post_spread]);
set(h, 'Color', atts.red, 'LineWidth', 2.0);
-
+
handles.spread = post_spread;
time_range = [ handles.time_last_change, handles.time_step ];
@@ -1460,31 +1465,38 @@ function step_ahead(~, ~)
%% Plot the segment for the updated inflation
axes(handles.h_inflation_evolution);
-
+
post_inflation = handles.inflation;
-
+
plot([handles.time_step - 1 + 0.1, handles.time_step + 0.1], ...
[inf_prior, handles.inflation], 'Linestyle', '-.', 'Color', atts.blue);
g = errorbar(handles.time_step + 0.1, post_inflation, handles.adap_inf_Std,'-.ob','MarkerSize',8,...
'MarkerEdgeColor',atts.blue,'MarkerFaceColor',atts.blue);
-
+
L = legend( g, [ '\lambda= ' sprintf('%.4f', post_inflation) ...
', \sigma= ' sprintf('%.4f', handles.adap_inf_Std) ], ...
'Location', 'NorthWest');
set(L, 'FontName', atts.fontname, 'FontSize', 14, 'EdgeColor', 'w');
-
-
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+
%% Plot the figure for this update
axes(handles.axes);
cla;
-
+
% Find the limits of the plot
% The height of the obs likelihood controls the vertical axis
% Plot the observation likelihood
[hg_like, ~, ylims] = plot_gaussian(observation, obs_error_sd, 1.0);
set(hg_like, 'Color', atts.red, 'LineWidth', 2, 'LineStyle', '--');
hold on
-
+
% Want axes to encompass likely values for plotted obs_likelihood
% The observed value will be between -4 and 4 with very high probability,
% then +/-3 more for likelihood
@@ -1492,74 +1504,74 @@ function step_ahead(~, ~)
xmin = -10;
xmax = 10;
ens_axis = [xmin xmax -0.2 ylims(2)+0.02];
-
+
% Put on a black axis line using data limits
plot([xmin xmax], [0, 0], 'k', 'Linewidth', 2);
-
+
% Plot the prior ensemble members in green
% Plotting ticks instead of asterisks makes bins clearer
tick_half = 0.015;
-
+
for n_tick = 1:handles.ens_size
plot([ens(n_tick), ens(n_tick)], ...
[-tick_half, tick_half], 'Color', atts.green, ...
'LineWidth', 2);
end
-
+
% Plot the posterior ensemble members in blue
for n_tick = 1:handles.ens_size
plot([new_ens(n_tick), new_ens(n_tick)], ...
[-0.1 - tick_half, -0.1 + tick_half], 'Color', atts.blue, ...
'LineWidth', 2);
end
-
+
% Plot the observation (at 0) as an asterisk
plot(observation, 0, 'r*', 'MarkerSize', 14, 'LineWidth', 2.0);
-
+
% Plot the truth (at -0.1 and 0) as a tick
tick_half = 0.02;
plot([0 0], [-0.1 - tick_half, -0.1 + tick_half], ...
'k', 'LineWidth', 2.0);
-
+
plot([0 0], [- tick_half, tick_half], ...
'k', 'LineWidth', 2.0);
-
+
% Put in some information about the bin, x position tricky
base_x = max(0, ens_axis(1));
text_width = (ens_axis(2) - ens_axis(1)) / 3;
-
+
if((base_x + text_width) > ens_axis(2))
base_x = ens_axis(2) - text_width;
end
-
+
text(base_x, -0.18, ['Truth in Posterior Bin ', num2str(ens_rank)], ...
'FontSize', 14, 'FontWeight', 'Bold','FontName', atts.fontname);
-
+
% Draw a line from the label string to the truth
plot([base_x + text_width/8, 0], [-0.16, -0.13], 'k');
-
+
% Fix up the final axis
def_axis(1:2) = ens_axis(1:2);
def_axis(3) = -0.2;
def_axis(4) = 1 / (sqrt(2 * pi) * handles.obs_error_sd) + 0.02;
-
+
% Turn off the negative labels, enforce limits (faster than axis())
set(gca, 'YTick', [0 0.1 0.2 0.3 0.4], ...
- 'XLim' , [def_axis(1) def_axis(2)], ...
- 'YLim' , [def_axis(3) def_axis(4)]);
+ 'XLim' , [def_axis(1) def_axis(2)], ...
+ 'YLim' , [def_axis(3) def_axis(4)]);
grid on
-
+
% Plot an additional axis
plot(ens_axis(1:2), [-0.1 -0.1], 'k', 'LineWidth', 2);
-
+
end
-
+
end
%% -----------------------------------------------------------------------------
function turn_off_controls()
-
+
% Turn off all the other controls to avoid a mess
set(handles.ui_button_advance_model, 'Enable', 'Off');
set(handles.ui_button_start_auto_run, 'Enable', 'Off');
@@ -1587,13 +1599,13 @@ function turn_off_controls()
set(handles.ui_radio_button_enkf, 'Enable', 'Off');
set(handles.ui_radio_button_rhf, 'Enable', 'Off');
set(handles.ClearStats, 'Enable', 'Off');
-
+
end
%% -----------------------------------------------------------------------------
function turn_on_controls ()
-
+
% Turn on all the other controls to avoid a mess
set(handles.ui_button_advance_model, 'Enable', 'On');
set(handles.ui_button_start_auto_run, 'Enable', 'On');
@@ -1619,16 +1631,16 @@ function turn_on_controls ()
set(handles.ui_radio_button_enkf, 'Enable', 'On');
set(handles.ui_radio_button_rhf, 'Enable', 'On');
set(handles.ClearStats, 'Enable', 'On');
-
+
end
%% -----------------------------------------------------------------------------
function y = calculate_rmse(x, truth)
-
+
squared_error = (x - truth).^2;
y = sqrt(mean(squared_error));
-
+
end
@@ -1640,26 +1652,29 @@ function show_rms_on_plot(prior_rms_vals, prior_aes_vals, ranges)
prior_rms_vals_new = prior_rms_vals(ranges(1) : ranges(2));
prior_aes_vals_new = prior_aes_vals(ranges(1) : ranges(2));
-
- str1 = sprintf('%.2f', mean(prior_rms_vals_new) );
- str2 = sprintf('%.2f', mean(prior_aes_vals_new) );
-
- str3 = [ 'Averaging Over Steps (' num2str(ranges(1)) ':' num2str(ranges(2)) ')' ];
- L = legend( [ 'Error: ' str1 ], [ 'Spread: ', str2 ] );
-
- L_title = get(L, 'Title');
- set(L_title, 'String', str3, 'FontSize', atts.fontsize, 'FontWeight', 'normal')
+ str1 = sprintf('Error : %.2f', mean(prior_rms_vals_new) );
+ str2 = sprintf('Spread: %.2f', mean(prior_aes_vals_new) );
+ L = legend( str1, str2, 'Location', 'NorthWest');
set(L, 'EdgeColor', 'w', 'FontSize', atts.fontsize)
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+ title(sprintf('Averaging Over Steps (%d:%d)', ranges(1), ranges(2)));
+
end
%% -----------------------------------------------------------------------------
function set_main_axes
-
+
if (isfield(handles,'axes'))
% 'cla reset' resets all properties of the axes except for the
% Position and Units properties.
@@ -1671,43 +1686,49 @@ function show_rms_on_plot(prior_rms_vals, prior_aes_vals, ranges)
'Position' , [0.050 0.382 0.333 0.400], ...
'Color' , 'White');
end
-
+
% plot some bogus items to create handles for legend
hg_prior = plot([0 0],[0 0]);
set(hg_prior, 'LineWidth', 2, 'Color', atts.green, 'Visible', 'on');
-
+
hg_post = line([0 0], [0 0]);
set(hg_post, 'LineWidth', 2, 'Color', atts.blue, 'Visible', 'on');
-
+
hg_like = line([0 0], [0 0]);
set(hg_like, 'LineWidth', 2, 'Color', atts.red, 'LineStyle','--', 'Visible', 'on');
-
- legend([hg_prior hg_post hg_like],'Prior','Posterior','Likelihood');
- set(legend,'FontName', atts.fontname, 'FontSize', atts.fontsize);
- legend boxon
+ L = legend([hg_prior hg_post hg_like],'Prior','Posterior','Likelihood');
+ set(L,'FontName', atts.fontname, 'FontSize', atts.fontsize, 'Box', 'on');
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
xlabel('State', 'FontName', atts.fontname, 'FontSize', atts.fontsize);
title('Latest Ensemble Prior, Likelihood, Posterior', ...
- 'FontName', atts.fontname, 'FontSize', atts.fontsize,'FontWeight', 'Bold');
-
- % Axis Limits
+ 'FontName', atts.fontname, 'FontSize', atts.fontsize,'FontWeight', 'Bold');
+
+ % Axis Limits
y_max = 1 / (sqrt(2 * pi) * handles.obs_error_sd);
xmin = -10;
xmax = 10;
-
+
hold on;
axis([xmin xmax -0.2 y_max + 0.02])
-
+
end
%% -----------------------------------------------------------------------------
function set_state_evolution
-
+
% axes for ensemble time series
% plot some items invisible just to be able to create a legend with all the
% potential elements.
-
+
if (isfield(handles,'h_state_evolution'))
cla( handles.h_state_evolution,'reset');
axes(handles.h_state_evolution);
@@ -1717,36 +1738,45 @@ function show_rms_on_plot(prior_rms_vals, prior_aes_vals, ranges)
'Position',[0.430 0.748 0.333 0.164], ...
'Color', 'White');
end
-
+
x(1:handles.ens_size) = handles.time_step + 0.1;
-
+
plot(x, handles.ens, 'b*', 'MarkerSize', 6);
hold on
str1 = '$x_{t+1} = x_t + (x_t+$model bias$) + a{\cdot}x_t{\cdot}{\mid}x_t{\mid}$';
str2 = '\hspace{1.5mm} observation is a draw from $\mathcal{N}(0,1)$';
TITLE = title( {str1,str2} );
set( TITLE, 'interpreter', 'latex', 'FontSize', 20, 'FontWeight', 'bold' );
-
+
% Include the 0 line as the truth for all times
plot([1 100000], [0 0], 'k--');
-
+
% plot the invisible stuff and capture a nice handle array for later.
h_truth = plot(1, 0, 'k--', 'Visible', 'on');
h_obs = plot(1, 0, 'r*' , 'Visible', 'on', 'MarkerSize', 10);
h_prior = plot(1, 0, 'g*-', 'Visible', 'on', 'MarkerSize', 6, 'Color', atts.green);
h_posterior = plot(1, 0, 'b*' , 'Visible', 'on', 'MarkerSize', 6);
h_evolution_handles = [h_truth h_obs h_prior h_posterior];
-
+
% Want the y axis limits to take care of themselves
set(gca, 'YLimMode', 'Auto','XTickLabel',[],'XGrid','on');
ylabel('State','FontName', atts.fontname,'FontSize', atts.fontsize);
-
- legend(h_evolution_handles, 'Truth', 'Observation', 'Prior', 'Posterior');
- set(legend,'FontName', atts.fontname, 'FontSize', 14, ...
+
+ L = legend(h_evolution_handles, 'Truth', 'Observation', 'Prior', 'Posterior');
+ set(L, 'FontName', atts.fontname, ...
+ 'FontSize', 14, ...
+ 'Box', 'on', ...
'Position',[0.821 0.770 0.118 0.148])
- legend boxon
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
axis([1 10 -10 10]);
-
+
end
%% -----------------------------------------------------------------------------
@@ -1755,7 +1785,7 @@ function show_rms_on_plot(prior_rms_vals, prior_aes_vals, ranges)
% axes for mean and spread
% calculate rmse and spread ... expectation over a long time is
% that they would be the same.
-
+
if (isfield(handles,'h_err_spread_evolution'))
cla( handles.h_err_spread_evolution,'reset');
axes(handles.h_err_spread_evolution);
@@ -1765,31 +1795,37 @@ function show_rms_on_plot(prior_rms_vals, prior_aes_vals, ranges)
'Position',[0.430 0.557 0.333 0.164], ...
'Color', 'White');
end
-
+
h_e = plot([0 0],[0 0]);
set(h_e, 'LineWidth', 2, 'Color', atts.blue, 'Visible', 'on');
-
+
h_s = line([0 0], [0 0]);
set(h_s, 'LineWidth', 2, 'Color', atts.red, 'Visible', 'on');
-
- L = legend([h_e h_s],'Error','Spread','Location', 'NorthWest');
-
- L_title = get(L, 'Title');
- set(L_title, 'String', 'Averaging Over Steps (1:n)', 'FontSize', atts.fontsize, 'FontWeight', 'normal')
-
- set(L,'FontName', atts.fontname, 'FontSize', atts.fontsize, 'EdgeColor', 'w');
ylabel('Error, Spread','FontName', atts.fontname,'FontSize', atts.fontsize);
axis([1 10 0 10]);
set(gca,'XTickLabel',[],'XGrid','on')
hold on
-
+
+ L = legend([h_e h_s], 'Error', 'Spread', 'Location', 'NorthWest');
+ set(L, 'FontName', atts.fontname, 'FontSize', atts.fontsize, 'EdgeColor', 'w');
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+
+ title('Averaging Over Steps(1:n)');
+
end
%% -----------------------------------------------------------------------------
function set_inflation_evolution
-
+
% axes for inflation
if (isfield(handles,'h_inflation_evolution'))
cla( handles.h_inflation_evolution,'reset');
@@ -1801,21 +1837,21 @@ function show_rms_on_plot(prior_rms_vals, prior_aes_vals, ranges)
'Color', 'White', ...
'XAxisLocation','bottom');
end
-
+
plot([1 100000], [1 1], 'k:');
- axis([1 10 0. 3]);
+ axis([1 10 0. 3]);
ylabel('Inflation', 'FontName', atts.fontname, 'FontSize', atts.fontsize);
xlabel('Timestep', 'FontName', atts.fontname, 'FontSize', atts.fontsize);
set(gca,'XGrid', 'on')
hold on
-
+
end
%% -------------------------------------------------------------------------
function set_prior_histogram()
-
+
% axes for prior rank histogram
if (isfield(handles,'h_prior_rank_histogram'))
cla( handles.h_prior_rank_histogram,'reset');
@@ -1824,20 +1860,20 @@ function set_prior_histogram()
else
handles.h_prior_rank_histogram = axes('Position',[0.050 0.075 0.333 0.208]);
end
-
+
ylabel('Frequency' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
xlabel('Rank' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
title ('Prior Rank Histogram','FontName', atts.fontname,'FontSize', atts.fontsize);
axis([0 handles.ens_size+2 -Inf Inf])
set(handles.h_prior_rank_histogram,'XTick',1:(handles.ens_size+1));
hold on
-
+
end
%% -----------------------------------------------------------------------------
function set_posterior_histogram()
-
+
% axes for posterior rank histogram
if (isfield(handles,'h_post_rank_histogram'))
cla(handles.h_post_rank_histogram,'reset');
@@ -1846,14 +1882,14 @@ function set_posterior_histogram()
else
handles.h_post_rank_histogram = axes('Position',[0.43 0.075 0.333 0.208]);
end
-
+
ylabel('Frequency' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
xlabel('Rank' ,'FontName', atts.fontname,'FontSize', atts.fontsize);
title ('Posterior Rank Histogram','FontName', atts.fontname,'FontSize', atts.fontsize);
axis([0 handles.ens_size+2 -Inf Inf])
set(handles.h_post_rank_histogram,'XTick',1:(handles.ens_size+1));
hold on
-
+
end
%% -----------------------------------------------------------------------------
diff --git a/documentation/DART_LAB/matlab/run_lorenz_63.m b/documentation/DART_LAB/matlab/run_lorenz_63.m
index 331b836938..ff8ba2b42b 100644
--- a/documentation/DART_LAB/matlab/run_lorenz_63.m
+++ b/documentation/DART_LAB/matlab/run_lorenz_63.m
@@ -345,7 +345,7 @@ function SingleStep(~,~)
%This Function is called whenever the button_Single_Step is
%pressed. It disables all the buttons, calls step ahead, then re-enables
%all the buttons
-
+
%Disable all the buttons
set(handles.ui_button_Single_Step, 'Enable', 'Off');
set(handles.ui_radio_noAssimilation, 'Enable', 'Off');
@@ -354,18 +354,18 @@ function SingleStep(~,~)
set(handles.ui_radio_RHF, 'Enable', 'Off');
set(handles.ui_button_Auto_Run, 'Enable', 'Off');
set(handles.ui_button_Reset, 'Enable', 'Off');
-
+
%Advance the model one time.
step_ahead;
-
+
%If the menu has a value of 'No Assimilation' then go ahead and
%call step ahead one more time as there are no observations to
%assimilate
if (strcmp(handles.filter_kind, 'No Assimilation') && ...
- strcmp(get(handles.ui_button_Single_Step, 'String'), 'Assimilate Obs'))
+ strcmp(get(handles.ui_button_Single_Step, 'String'), 'Assimilate Obs'))
step_ahead();
end
-
+
%Re-Enable All the buttons
set(handles.ui_button_Auto_Run, 'Enable', 'On');
set(handles.ui_button_Single_Step, 'Enable', 'On');
@@ -374,17 +374,17 @@ function SingleStep(~,~)
set(handles.ui_radio_EnKF, 'Enable', 'On');
set(handles.ui_radio_RHF, 'Enable', 'On');
set(handles.ui_button_Reset, 'Enable', 'On');
-
+
end
%% ----------------------------------------------------------------------
function AutoRun(~,~)
-
+
% This function is called when the ui_button_Auto_Run is pressed. It
% continuously calls the step_ahead function until the ui_button_Auto_Run is
% pressed again.
-
+
% Turn off all the other model status controls to avoid a mess
% MAKE SURE TO INCLUDE OTHER CONTROLS HERE
set(handles.ui_button_Single_Step, 'Enable', 'Off');
@@ -396,27 +396,27 @@ function AutoRun(~,~)
set(handles.ui_radio_EnKF, 'Enable', 'Off');
set(handles.ui_radio_RHF, 'Enable', 'Off');
set(handles.ui_button_Reset, 'Enable', 'Off');
-
+
% Check the label to see if we are starting or stopping a free run
if(strcmp(get(handles.ui_button_Auto_Run, 'String'), 'Pause Auto Run'))
-
+
% Being told to stop; switch to not running status
set(handles.ui_button_Auto_Run, 'Enable', 'Off');
set(handles.ui_button_Auto_Run, 'String', 'Start Auto Run');
-
+
else
% Being told to start free run
-
+
set(handles.ui_button_Auto_Run, 'String', 'Pause Auto Run');
-
+
% Loop through advance and assimilate steps until stopped
while(true)
-
+
% Check to see if stop has been pushed
status_string = get(handles.ui_button_Auto_Run, 'String');
-
+
if(strcmp(status_string, 'Start Auto Run'))
-
+
% Turn all the other model status controls back on
% MAKE SURE TO INCLUDE OTHER CONTROLS HERE
set(handles.ui_button_Single_Step, 'Enable', 'On');
@@ -427,7 +427,7 @@ function AutoRun(~,~)
set(handles.ui_button_Reset, 'Enable', 'On');
% Very last, turn on the start free run button
set(handles.ui_button_Auto_Run, 'Enable', 'On');
-
+
return
end
% Do the next advance or assimilation step
@@ -441,20 +441,20 @@ function AutoRun(~,~)
function step_ahead()
% Moves the model ahead or assimilates next observations
-
+
% Test on semaphore, either advance or assimilate
if(handles.ready_to_advance)
% Set semaphore to indicate that next step is an assimilation
handles.ready_to_advance = false;
-
+
% Set the text to indicate that next step is an assimilate
set(handles.ui_button_Single_Step, 'String', 'Assimilate Obs');
-
+
% Turn off the recent observation plot if it exists
if(handles.global_init)
set(handles.h_global_obs, 'Visible', 'off');
end
-
+
% Advance a number of steps in between each assimilation
num_steps_to_advance = 20;
for i = 1:num_steps_to_advance
@@ -463,20 +463,20 @@ function step_ahead()
[new_truth, new_time] = lorenz_63_adv_1step(handles.true_state(time, :), time);
handles.time = new_time;
handles.true_state(new_time, :) = new_truth;
-
+
% Advance the ensemble members; posterior -> new prior
for imem = 1:handles.ens_size
[new_ens, new_time] = lorenz_63_adv_1step(handles.post(time, :, imem), time);
handles.prior(new_time, :, imem) = new_ens;
end
-
+
% Plot a long trajectory of truth in small window for reference
- axes(handles.global_view);
+ axes(handles.global_view); %#ok
hold on;
plot3(handles.true_state(new_time-1:new_time, 1), ...
handles.true_state(new_time-1:new_time, 2), ...
handles.true_state(new_time-1:new_time, 3), 'k');
-
+
% Also plot an asterisk on the leading edge
if(new_time > 2)
set(handles.h_star, 'Visible', 'Off');
@@ -488,99 +488,99 @@ function step_ahead()
'k*', 'MarkerSize', 16, 'LineWidth', 2);
view([2 -1 1]);
axis([-25 25 -25 25 5 45]);
-
+
% Plot the close-up view of the ensemble
- axes(handles.local_view)
-
+ axes(handles.local_view) %#ok
+
% Plot the truth trajectory for the last 8 steps
hold off;
-
+
btime = new_time - 7;
if(btime < 1), btime = 1; end
plot3(handles.true_state(btime:new_time, 1), ...
handles.true_state(btime:new_time, 2), ...
handles.true_state(btime:new_time, 3), 'k', 'linewidth', 2);
-
+
hold on
% Set an appropriate consistent view angle
view([2, -1 1]);
-
+
% Plot an asterisk at the head of the trajectory
plot3(handles.true_state(new_time, 1), ...
handles.true_state(new_time, 2), ...
handles.true_state(new_time, 3), 'k*', 'MarkerSize', 16, 'LineWidth', 2);
-
+
% Adjust the axes to follow the truth
xb = handles.true_state(new_time, 1);
yb = handles.true_state(new_time, 2);
zb = handles.true_state(new_time, 3);
limits = [xb - 3, xb + 3, yb - 3, yb + 3, zb - 3, zb + 3];
axis(limits);
-
+
% Plot the ensemble members advance trajectories, too
for imem = 1:handles.ens_size
%Axes continually changes, so reset grid to on
grid on;
plot3(handles.prior(btime:new_time, 1, imem), ...
- handles.prior(btime:new_time, 2, imem), ...
- handles.prior(btime:new_time, 3, imem), '-', 'Color', atts.green)
+ handles.prior(btime:new_time, 2, imem), ...
+ handles.prior(btime:new_time, 3, imem), '-', 'Color', atts.green)
end
-
+
% Update the time label
set(handles.ui_text_time, 'String', ['Time = ', num2str(new_time)]);
-
+
% Force the buffers to flush and plot the advance
drawnow
-
+
% Last prior update will get overwritten when assimilation is done
handles.post(new_time, :, :) = handles.prior(new_time, :, :);
end
-
+
% Compute the observations for this time and save
for i = 1:3
handles.obs(i) = handles.true_state(new_time, i) + ...
- handles.obs_sd * randn;
+ handles.obs_sd * randn;
end
-
+
% Plot the observation as a red asterisk in both axes
h = plot3(handles.obs(1), handles.obs(2), handles.obs(3), ...
- 'r*', 'MarkerSize', 20);
+ 'r*', 'MarkerSize', 20);
set(h,'Color',atts.red);
-
+
axes(handles.global_view);
handles.h_global_obs = ...
- plot3(handles.obs(1), handles.obs(2), handles.obs(3), ...
- 'r*', 'MarkerSize', 20);
+ plot3(handles.obs(1), handles.obs(2), handles.obs(3), ...
+ 'r*', 'MarkerSize', 20);
set(handles.h_global_obs,'Color',atts.red);
handles.global_init = true;
axes(handles.local_view);
-
+
else
% Set semaphore to indicate that next step is a model advance
handles.ready_to_advance = true;
-
+
% Set the pushbutton text to indicate that the next step is a model advance
set(handles.ui_button_Single_Step, 'String', 'Advance Model');
-
+
% Get current time step
time = handles.time;
-
+
% Determine what type of assimilation is being done (none, EAKF, EnKF, RHF)
if(strcmp(handles.filter_kind, 'No Assimilation'))
% Just copy prior to posterior
handles.post(time, :, :) = handles.prior(time, :, :);
else
% Code for doing the assimilation comes here
-
+
% Do fully sequential assimilation algorithm
temp_ens = squeeze(handles.prior(time, :, :));
-
+
% Observe each state variable independently
obs = zeros(1,3);
for i = 1:3
obs_prior = temp_ens(i, :);
obs(i) = handles.obs(i);
-
+
% Compute the increments for observed variable
switch handles.filter_kind
case 'EAKF'
@@ -593,7 +593,7 @@ function step_ahead()
[obs_increments, ~] = ...
obs_increment_rhf(obs_prior, obs(i), handles.obs_error_var);
end
-
+
% Regress the increments onto each of the three state variables
for j = 1:3
state_incs = get_state_increments(temp_ens(j, :), ...
@@ -601,10 +601,10 @@ function step_ahead()
temp_ens(j, :) = temp_ens(j, :) + state_incs;
end
end
-
+
% Update the posterior
handles.post(time, :, :) = temp_ens;
-
+
% Plot a segment showing the impact of the observation
for imem = 1:handles.ens_size
xup = [handles.prior(time, 1, imem), handles.post(time, 1, imem)];
@@ -615,7 +615,7 @@ function step_ahead()
end
end
end
-
+
end
%% ----------------------------------------------------------------------
@@ -623,14 +623,14 @@ function step_ahead()
function reset(~,~)
%This function resets handles to it's original values and clears the graphs
% Also, called at the beginning to initialize the variables
-
+
% set random number seed to same value to generate known sequences
% rng('default') is the Mersenne Twister with seed 0
rng(0,'twister')
-
+
% Global semaphore; ready to advance or assimilate?
handles.ready_to_advance = true;
-
+
%Set handles to original values
ens_size = 20;
handles.ens_size = ens_size;
@@ -644,29 +644,29 @@ function reset(~,~)
handles.h_global_obs = [];
handles.global_init = false;
handles.filter_kind = 'No Assimilation';
-
+
handles.post = zeros(1, MODEL_SIZE, ens_size);
for n = 1:handles.ens_size
handles.post(1, :, n) = handles.true_state(1, :) + ...
0.1 * randn(1, MODEL_SIZE);
end
-
+
% Make first prior identical to the first posterior
handles.prior = handles.post;
-
+
%clears the two graphs
fontsize = get(handles.local_view,'FontSize');
cla(handles.local_view); set(handles.local_view,'FontSize',fontsize)
cla(handles.global_view); set(handles.global_view,'FontSize',fontsize)
-
+
set(handles.ui_text_time , 'String', 'Time = 0');
set(handles.ui_button_Single_Step, 'String', 'Advance Model');
set(handles.ui_button_group_assimilation,'SelectedObject',handles.ui_radio_noAssimilation);
-
+
% Plot the initial state
initial_plot(handles.local_view);
initial_plot(handles.global_view);
-
+
end
%% ----------------------------------------------------------------------
@@ -677,14 +677,14 @@ function initial_plot(hax)
axes(hax)
hold off;
FontSize = get(hax,'FontSize');
-
+
% Plot an asterisk
handles.initial_ob = plot3(handles.true_state(1, 1), ...
handles.true_state(1, 2), ...
handles.true_state(1, 3), 'k*', 'MarkerSize', 16, 'LineWidth', 2);
-
+
view([2, -1 1]); % Set an appropriate consistent view angle
-
+
% Adjust the axes to follow the truth
xb = handles.true_state(1, 1);
yb = handles.true_state(1, 2);
@@ -692,12 +692,12 @@ function initial_plot(hax)
limits = [xb - 3, xb + 3, yb - 3, yb + 3, zb - 3, zb + 3];
axis(limits);
hold on
-
+
% Plot the ensemble members
for imem = 1:handles.ens_size
plot3(handles.prior(1, 1, imem), ...
- handles.prior(1, 2, imem), ...
- handles.prior(1, 3, imem), 'k.', 'Color', atts.green);
+ handles.prior(1, 2, imem), ...
+ handles.prior(1, 3, imem), 'k.', 'Color', atts.green);
end
grid on;
set(gca, 'FontSize', FontSize)
@@ -708,10 +708,10 @@ function initial_plot(hax)
function Assimilation_selection(~, eventdata)
% Function is called whenever a radio button has been selected, it sets
% the global filter variable
-
+
% eventdata refers to the data in the GUI when a radio button in the
% group is changed
-
+
% Set the filter_type_string to newest radiobutton Value
handles.filter_kind = get(eventdata.NewValue,'String');
end
diff --git a/documentation/DART_LAB/matlab/run_lorenz_96.m b/documentation/DART_LAB/matlab/run_lorenz_96.m
index 2057f0f833..c06ce2cc7b 100644
--- a/documentation/DART_LAB/matlab/run_lorenz_96.m
+++ b/documentation/DART_LAB/matlab/run_lorenz_96.m
@@ -53,9 +53,9 @@
%% Create figure Layout
figure('position', [100 50 figWidth figHeight], ...
- 'Units', 'pixels', ...
- 'Name', 'run_lorenz_96', ...
- 'Color', atts.background);
+ 'Units', 'pixels', ...
+ 'Name', 'run_lorenz_96', ...
+ 'Color', atts.background);
%% Create text in the top right corner with the elapsed model time
handles.time = 1;
@@ -382,9 +382,17 @@
h_prior_spread = plot(handles.prior_spread , '-.' , 'LineWidth',2.0, 'Color', atts.green);
h_posterior_spread = plot(handles.posterior_spread, 'b-.', 'LineWidth',2.0);
-h = legend('Prior RMSE', 'Posterior RMSE', 'Prior Spread', 'Posterior Spread', ...
+L = legend('Prior RMSE', 'Posterior RMSE', 'Prior Spread', 'Posterior Spread', ...
'Location', 'NorthWest');
-set(h, 'FontSize', atts.fontsize); % Sadly, these dont seem to scale - even when normalized.
+set(L, 'FontSize', atts.fontsize); % Sadly, these dont seem to scale - even when normalized.
+
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+else
+ L.AutoUpdate = 'off';
+end
ylabel('RMSE & Spread', 'FontSize', atts.fontsize);
xlabel('Time', 'FontSize', atts.fontsize);
@@ -432,10 +440,10 @@
function SingleStep_Callback(~, ~)
% Called whenever [Advance Model/Assimilate Obs] is pressed.
% If Assimilation is turned off ... we are always ready to advance.
-
+
% Signal that something has happened.
set(handles.ui_button_Single_Step, 'Enable', 'Off');
-
+
if(strcmp(handles.filter_type_string, 'No Assimilation'))
if (strcmp(get(handles.ui_button_Single_Step, 'String') , 'Assimilate Obs'))
%If it says Assimilate Obs, that means another assimilation
@@ -444,9 +452,9 @@ function SingleStep_Callback(~, ~)
end
handles.ready_to_advance = true;
end
-
+
step_ahead();
-
+
set(handles.ui_button_Single_Step, 'Enable', 'On');
end
@@ -454,35 +462,35 @@ function SingleStep_Callback(~, ~)
function AutoRun_Callback(~, ~)
% Specifies action for the 'Start/Pause Auto Run' button.
-
+
% Turn off all the other model status controls to avoid a mess
turn_off_controls();
set(handles.ui_button_Auto_Run, 'Enable', 'On');
-
+
% Check the button label to see if we are starting or stopping a Auto run
if(strcmp(get(handles.ui_button_Auto_Run, 'String'), 'Pause Auto Run'))
-
+
% Turn off the Auto run pushbutton until everything has completely stopped
set(handles.ui_button_Auto_Run, 'Enable', 'Off');
-
+
% Being told to stop; switch to not running status
set(handles.ui_button_Auto_Run, 'String', 'Start Auto Run');
-
+
else
% Being told to start Auto run
% Change the pushbutton to stop
set(handles.ui_button_Auto_Run, 'String', 'Pause Auto Run');
-
+
% Loop through advance and assimilate steps until stopped
while(true)
-
+
% Check to see if stop has been pushed
status_string = get(handles.ui_button_Auto_Run, 'String');
if(strcmp(status_string, 'Start Auto Run'))
turn_on_controls();
return
end
-
+
% Do the next advance or assimilation step
step_ahead();
drawnow
@@ -494,13 +502,13 @@ function AutoRun_Callback(~, ~)
function Forcing_Callback(~, ~)
%Called when the slider has been changed
-
+
err = get(handles.ui_slider_error, 'Value');
-
+
% Round the Value of the slider to the nearest integer
% Set the Value of the slider to the rounded number. This will
% Create a snap into place effect
-
+
FORCING = round(err);
set(handles.ui_slider_error, 'Value' , FORCING);
set(handles.ui_edit_forcing, 'String' , sprintf('%d',FORCING));
@@ -510,57 +518,57 @@ function Forcing_Callback(~, ~)
function edit_inflation_Callback(~, ~)
% Is called when the edit_inflation field is changed
-
+
% Set the inflation value to the update
handles.inflation = str2double(get(handles.ui_edit_inflation, 'String'));
if(not(isfinite(handles.inflation)) || handles.inflation < 1)
-
+
% After this, only this edit box will work
turn_off_controls();
set(handles.ui_edit_inflation, 'Enable', 'On');
set(handles.ui_edit_inflation, 'String', '?','FontWeight','Bold','BackgroundColor', atts.red);
set(handles.ui_text_inf_err_print, 'Visible','On')
-
+
fprintf('\nERROR: inflation must be greater than or equal to 1.\n')
fprintf('ERROR: unable to interpret inflation value, please try again.\n')
-
+
return
end
-
+
% Enable all controls
turn_on_controls();
set(handles.ui_edit_inflation, 'BackgroundColor', 'White','FontWeight','Normal');
set(handles.ui_text_inf_err_print, 'Visible','Off')
-
+
end
%% ----------------------------------------------------------------------
function edit_localization_Callback(~, ~)
% Specifies the action for the 'Localization' text box
-
+
% Set the localization value to the update
handles.localization= str2double(get(handles.ui_edit_localization, 'String'));
-
+
if(not(isfinite(handles.localization)) || handles.localization <= 0)
-
+
% After this, only this edit box will work
turn_off_controls();
set(handles.ui_edit_localization, 'Enable', 'On');
set(handles.ui_edit_localization, 'String', '?','FontWeight','Bold','BackgroundColor', atts.red );
set(handles.ui_text_localization_err_print, 'Visible','On')
-
+
fprintf('\nERROR: localization must be greater than 0.\n')
fprintf('ERROR: localization must be greater than 0.\n')
-
+
return
end
-
+
% Enable all controls
turn_on_controls();
set(handles.ui_edit_localization, 'BackgroundColor', 'White','FontWeight','Normal');
set(handles.ui_text_localization_err_print, 'Visible','Off')
-
+
% Update the localization plot
cla(handles.polar_plot);
plot_localization();
@@ -569,107 +577,107 @@ function edit_localization_Callback(~, ~)
%% ----------------------------------------------------------------------
function edit_ens_size_Callback(~, ~)
-
+
% Check to see if the new ensemble size is valid
new_ens_size = str2double(get(handles.ui_edit_ens_size, 'String'));
-
+
if(not(isfinite(new_ens_size)) || new_ens_size < 2 || new_ens_size > 40)
-
+
% After this, only this edit box will work
turn_off_controls();
set(handles.ui_edit_ens_size, 'Enable', 'On');
-
+
set(handles.ui_edit_ens_size, 'String', '?','FontWeight','Bold','BackgroundColor', atts.red );
set(handles.ui_text_ens_size_err_print, 'Visible','On')
-
+
fprintf('\nERROR: Must input an integer Ens. Size greater than 1 and less than 40\n');
fprintf('ERROR: Must input an integer Ens. Size greater than 1 and less than 40\n');
-
+
return
-
+
end
-
+
% Enable all controls
turn_on_controls();
-
+
% clear out the old graphics
cla(handles.polar_plot)
cla(handles.timeseries)
cla(handles.prior_rank_histogram)
cla(handles.post_rank_histogram)
-
+
set(handles.ui_edit_ens_size, 'BackgroundColor', 'White','FontWeight','Normal');
-
+
% Set the ensemble size global value to the update
handles.ens_size = new_ens_size;
-
+
% Need to reset the ensemble and the time
clear handles.true_state
handles.true_state(1, 1:handles.model_size) = TRUE_FORCING;
handles.true_state(1, 1) = 1.001 * TRUE_FORCING;
handles.time = 1;
-
+
% Generate set of ensemble perturbations
handles.posterior = zeros(1, handles.model_size, handles.ens_size);
for imem = 1:handles.ens_size
handles.posterior(1, 1:handles.model_size, imem) = ...
handles.true_state(1, :) + 0.001 * randn(1, handles.model_size);
end
-
+
% For convenience make the first prior identical to the first posterior
handles.prior = handles.posterior;
handles.prior_rms = 0;
handles.prior_spread = 0;
handles.posterior_rms = 0;
handles.posterior_spread = 0;
-
+
% An array to keep track of rank histograms
handles.prior_rank( 1 : handles.ens_size + 1) = 0;
handles.posterior_rank(1 : handles.ens_size + 1) = 0;
-
+
%Reset button to 'Advance Model'
set(handles.ui_button_Single_Step, 'String' , 'Advance Model');
handles.ready_to_advance = true;
-
+
%Reset the time text
set(handles.ui_text_time,'String', 'Time = 1');
-
+
end
%% ----------------------------------------------------------------------
function reset_Callback(~, ~)
% Sets the graphs and the values to original values
-
+
% set random number seed to same value to generate known sequences
% rng('default') is the Mersenne Twister with seed 0
rng(0,'twister')
-
+
% Initialize the L96 model
L96 = lorenz_96_static_init_model;
TRUE_FORCING = L96.forcing;
FORCING = L96.forcing;
MODEL_SIZE = L96.model_size;
DELTA_T = L96.delta_t;
-
+
% Set the edit fields
-
+
set(handles.ui_edit_localization, 'String', '1.0');
set(handles.ui_edit_inflation , 'String', '1.0');
set(handles.ui_edit_ens_size , 'String', '20');
set(handles.ui_button_group_assimilation,'SelectedObject',handles.ui_radio_noAssimilation);
handles.filter_type_string = 'No Assimilation';
set(handles.ui_button_Single_Step, 'String' , 'Advance Model');
-
+
set(handles.ui_slider_error , 'Value', 8);
set(handles.ui_edit_forcing , 'String' , 8);
-
+
handles.localization = str2double(get(handles.ui_edit_localization, 'String'));
handles.inflation = str2double(get(handles.ui_edit_inflation, 'String'));
handles.ens_size = str2double(get(handles.ui_edit_ens_size, 'String'));
-
+
clear handles.true_state
-
+
handles.model_size = MODEL_SIZE;
handles.true_state(1, 1:MODEL_SIZE) = TRUE_FORCING;
handles.true_state(1, 1) = 1.001 * TRUE_FORCING;
@@ -680,72 +688,72 @@ function reset_Callback(~, ~)
handles.posterior = 0;
handles.posterior_rms = 0;
handles.posterior_spread = 0;
-
+
%str = get(handles.menu_assimilation,'String');
%handles.filter_type_string = str{get(handles.menu_assimilation,'Value')};
-
+
set(handles.ui_text_time,'String', sprintf('Time = %d',handles.time))
-
+
% Used to normalize the polar plotting
handles.mean_dist = 35;
-
+
handles.h_ens = [];
handles.h_truth = [];
-
+
% Global semaphore; ready to advance or assimilate?
handles.ready_to_advance = true;
-
+
% Generate set of ensemble perturbations
handles.posterior = zeros(1, handles.model_size, handles.ens_size);
for imem = 1:handles.ens_size
handles.posterior(1, 1:handles.model_size, imem) = ...
handles.true_state(1, :) + 0.001 * randn(1, handles.model_size);
end
-
+
% For convenience make the first prior identical to the first posterior
handles.prior = handles.posterior;
-
+
% An array to keep track of rank histograms
handles.prior_rank( 1 : handles.ens_size + 1) = 0;
handles.posterior_rank(1 : handles.ens_size + 1) = 0;
-
+
% Clear out the old graphics. The legends remain, which is nice.
cla(handles.polar_plot)
cla(handles.timeseries)
cla(handles.prior_rank_histogram)
cla(handles.post_rank_histogram)
-
+
% Put back the localization if this is not the initial setup of the graphics
if(first_call_to_reset)
- first_call_to_reset = false;
+ first_call_to_reset = false;
else
- plot_localization();
+ plot_localization();
end
-
+
end
%% ----------------------------------------------------------------------
function ClearHistograms_Callback(~, ~)
-
+
% An array to keep track of rank histograms
handles.prior_rank( 1 : handles.ens_size + 1) = 0;
handles.posterior_rank(1 : handles.ens_size + 1) = 0;
-
+
% Clear out the old graphics. The legends remain, which is nice.
cla(handles.prior_rank_histogram)
cla(handles.post_rank_histogram)
-
+
end
%% ----------------------------------------------------------------------
function step_ahead()
% Specifies the action for the [Assimilate Obs/Advance Model] button.
-
+
% Test on semaphore, either advance or assimilate
if(handles.ready_to_advance)
-
+
% Set semaphore to indicate that next step may be an assimilation
% Set the pushbutton text to indicate that next step is an assimilate
% only if we have selected a filter algorithm
@@ -756,32 +764,32 @@ function step_ahead()
handles.ready_to_advance = false;
set(handles.ui_button_Single_Step, 'String', 'Assimilate Obs');
end
-
+
% Code for advancing model comes next
time = handles.time;
[new_truth, new_time] = lorenz_96_adv_1step(handles.true_state(time, :), time, TRUE_FORCING);
handles.time = new_time;
handles.true_state(new_time, :) = new_truth;
-
+
% Advance the ensemble members; posterior -> new prior
for imem = 1:handles.ens_size
[new_ens, new_time] = lorenz_96_adv_1step(handles.posterior(time, :, imem), time, FORCING);
handles.prior(new_time, :, imem) = new_ens;
end
-
+
% Inflate ensemble
for i = 1:MODEL_SIZE
ens_mean = mean(handles.prior(new_time, i, :));
handles.prior(new_time, i, :) = ens_mean + ...
sqrt(handles.inflation) * (handles.prior(new_time, i, :) - ens_mean);
end
-
+
if(strcmp(handles.filter_type_string, 'No Assimilation'))
% we are not assimilating
% just copy prior to posterior
handles.posterior(new_time, :, :) = handles.prior(new_time, :, :);
end
-
+
% Plot a single invisible point to wipe out the previous plot
% and maintain axis limits of polar plot.
axes(handles.polar_plot);
@@ -791,7 +799,7 @@ function step_ahead()
h_obs = plot_polar(y_2, x, handles.mean_dist, 'r*', 1);
hold on
set(h_obs, 'Visible', 'Off');
-
+
% Plot the ensemble members (green) and the truth (black)
for imem = 1:handles.ens_size
handles.h_ens = plot_polar(polar_y, handles.prior(new_time, :, imem), ...
@@ -801,78 +809,86 @@ function step_ahead()
handles.h_truth = plot_polar(polar_y, new_truth, handles.mean_dist, 'k', MODEL_SIZE);
% Make truth wider so it is easier to distinguish
set(handles.h_truth, 'linewidth', 3);
-
+
% Plot a graphical indication of the localization halfwidth; Is expense of this a problem.
plot_localization();
-
+
% Get a legend shifted outside the plot
- h_leg = legend([handles.h_truth handles.h_ens, h_obs], ...
+ L = legend([handles.h_truth handles.h_ens, h_obs], ...
'True State', 'Ensemble', 'Observations', 'Location', 'NorthEast');
% Following replacement pair of lines puts localization into legend.
- %h_leg = legend([handles.h_truth handles.h_ens, h_obs, h_loc], ...
- %'True State', 'Ensemble', 'Observations', 'Localization', 'Location', 'NorthEast');
- pos = get(h_leg, 'Position')+ [0.046 -0.002 0.021 0.012];
- set(h_leg, 'Position', pos, ...
+ %L = legend([handles.h_truth handles.h_ens, h_obs, h_loc], ...
+ %'True State', 'Ensemble', 'Observations', 'Localization', 'Location', 'NorthEast');
+ pos = get(L, 'Position')+ [0.046 -0.002 0.021 0.012];
+ set(L, 'Position', pos, ...
'FontSize', atts.fontsize, ...
'EdgeColor', 'w');
-
+
+ if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+ else
+ L.AutoUpdate = 'off';
+ end
+
% Update the time label
set(handles.ui_text_time, 'String', sprintf('Time = %d', handles.time));
-
+
% Compute the prior RMS error of ensemble mean
handles.prior_rms(new_time) = rms_error(new_truth, handles.prior(new_time, :, :));
handles.prior_spread(new_time) = ens_spread(handles.prior(new_time, :, :));
-
+
% Save the information about the histograms from before
temp_rank(:, 1) = handles.prior_rank(1:handles.ens_size + 1);
temp_rank(:, 2) = 0;
-
+
% Compute the prior rank histograms
for i = 1:handles.ens_size
ens_rank = get_ens_rank(squeeze(handles.prior(new_time, i, :)), squeeze(new_truth(i)));
handles.prior_rank(ens_rank) = handles.prior_rank(ens_rank) + 1;
temp_rank(ens_rank, 2) = temp_rank(ens_rank, 2) + 1;
end
-
+
% Plot the prior_rms error time series
-
+
% Change Focus to time evolution of rmse & spread
% axes(handles.timeseries)
subplot(handles.timeseries);
-
+
hold on % FIXME ... do we need this ...
plot(handles.prior_rms, 'Color',atts.green,'LineWidth',2.0);
plot(handles.prior_spread, '-.','Color',atts.green,'LineWidth',2.0);
set(handles.timeseries,'YGrid','on')
-
+
% Plot the rank histogram for the prior
subplot(handles.prior_rank_histogram);
B = bar(temp_rank, 'stacked');
B(1).FaceColor= atts.blue ; B(1).EdgeColor= 'k';
B(2).FaceColor= atts.yellow ; B(2).EdgeColor= 'k';
axis tight
-
+
else % We need to do an assimilation.
-
+
% Get current time step
time = handles.time;
-
+
% Generate noisy observations of the truth
obs_sd = 4;
obs_error_var = obs_sd^2;
-
+
% Do fully sequential assimilation algorithm
temp_ens = squeeze(handles.prior(time, :, :));
-
+
% Select the first plotting box
axes(handles.polar_plot);
-
+
% Observe each state variable independently
obs = zeros(1,MODEL_SIZE);
for i = 1:MODEL_SIZE
obs_prior = temp_ens(i, :);
obs(i) = handles.true_state(time, i) + obs_sd * randn;
-
+
% Compute the increments for observed variable
switch handles.filter_type_string
case 'EAKF'
@@ -888,38 +904,38 @@ function step_ahead()
%No Incrementation
obs_increments = 0;
end
-
+
% Regress the increments onto each of the state variables
for j = 1:MODEL_SIZE
state_incs = get_state_increments(temp_ens(j, :), ...
obs_prior, obs_increments);
-
+
% Compute distance between obs and state for localization
dist = abs(i - j) / MODEL_SIZE;
if(dist > 0.5), dist = 1 - dist; end
-
+
% Compute the localization factor
cov_factor = comp_cov_factor(dist, handles.localization);
-
+
temp_ens(j, :) = temp_ens(j, :) + state_incs * cov_factor;
end
end
-
+
% Plot the observations
subplot(handles.polar_plot)
plot_polar(polar_y, obs, handles.mean_dist, 'r*', MODEL_SIZE);
-
+
% Update the posterior
handles.posterior(time, :, :) = temp_ens;
-
+
% Compute the posterior rms, spread
handles.posterior_rms(time) = rms_error(handles.true_state(time, :), handles.posterior(time, :, :));
handles.posterior_spread(time) = ens_spread(handles.posterior(time, :, :));
-
+
% Save the information about the histograms from before
temp_rank(:, 1) = handles.posterior_rank(1:handles.ens_size + 1);
temp_rank(:, 2) = 0;
-
+
% Compute the posterior rank histograms
for i = 1:handles.ens_size
ens_rank = get_ens_rank(squeeze(handles.posterior(time, i, :)), ...
@@ -927,37 +943,37 @@ function step_ahead()
handles.posterior_rank(ens_rank) = handles.posterior_rank(ens_rank) + 1;
temp_rank(ens_rank, 2) = temp_rank(ens_rank, 2) + 1;
end
-
+
% Plot the posterior_rms error time series
subplot(handles.timeseries);
set(handles.timeseries,'YGrid','on')
hold on
plot(handles.posterior_rms, 'b', 'LineWidth', 2.0);
plot(handles.posterior_spread, 'b-.','LineWidth', 2.0);
-
+
% Plot the rank histogram for the prior
subplot(handles.post_rank_histogram);
B = bar(temp_rank, 'stacked');
B(1).FaceColor= atts.blue ; B(1).EdgeColor= 'k';
B(2).FaceColor= atts.yellow ; B(2).EdgeColor= 'k';
axis tight
-
+
% Set semaphore to indicate that next step is a model advance
handles.ready_to_advance = true;
-
+
% Set the pushbutton text to indicate that the next step is a model advance
set(handles.ui_button_Single_Step, 'String', 'Advance Model');
-
+
end
-
-
+
+
end
%% ----------------------------------------------------------------------
function ens_mean_rms = rms_error(truth, ens)
% Calculates the rms_error
-
+
ens_mean = mean(squeeze(ens),2)';
ens_mean_rms = sqrt(sum((truth - ens_mean).^2) / size(truth, 2));
end
@@ -968,7 +984,7 @@ function step_ahead()
% Calculates the ens_spread
% Remove the mean of each of the 40 model variables (40 locations).
% resulting matrix is 40x20 ... each row/location is centered (zero mean).
-
+
[~, model_size, ens_size] = size(ens);
datmat = detrend(squeeze(ens)','constant'); % remove the mean of each location.
denom = (model_size - 1)*ens_size;
@@ -979,10 +995,10 @@ function step_ahead()
function turn_off_controls()
% Disables all the buttons,menus, and edit fields
-
+
set(handles.ui_button_Single_Step, 'Enable', 'Off');
set(handles.ui_button_Auto_Run, 'Enable', 'Off');
-
+
% In 2015, there is a way to disable the button group, but it is not
% compatible with 2014, so we must enable/disable each radio button
% seperately
@@ -990,7 +1006,7 @@ function turn_off_controls()
set(handles.ui_radio_EAKF, 'Enable', 'Off');
set(handles.ui_radio_EnKF, 'Enable', 'Off');
set(handles.ui_radio_RHF, 'Enable', 'Off');
-
+
set(handles.ui_slider_error, 'Enable', 'Off');
set(handles.ui_edit_forcing, 'Enable', 'Off');
set(handles.ui_edit_localization, 'Enable', 'Off');
@@ -1004,10 +1020,10 @@ function turn_off_controls()
function turn_on_controls()
% Enables all the buttons,menus, and edit fields
-
+
set(handles.ui_button_Single_Step, 'Enable', 'On');
set(handles.ui_button_Auto_Run, 'Enable', 'On');
-
+
% In 2015, there is a way to disable the button group,
% but it is not compatible with 2014, so we must enable/disable
% each radio button seperately
@@ -1015,7 +1031,7 @@ function turn_on_controls()
set(handles.ui_radio_EAKF, 'Enable', 'On');
set(handles.ui_radio_EnKF, 'Enable', 'On');
set(handles.ui_radio_RHF, 'Enable', 'On');
-
+
set(handles.ui_slider_error, 'Enable', 'On');
set(handles.ui_edit_forcing, 'Enable', 'On');
set(handles.ui_edit_localization, 'Enable', 'On');
@@ -1041,18 +1057,18 @@ function edit_forcing_Callback(~,~)
% slider is changed, the slider and the edit field are connected,
% the edit field is simply used to allow for more precise forcing
% values
-
+
% Undo any changes that could have been made by erros
turn_on_controls();
set(handles.ui_edit_forcing, 'BackgroundColor' , 'White');
set(handles.ui_edit_forcing, 'FontWeight' , 'Normal');
-
+
if(isfinite(str2double(get(handles.ui_edit_forcing, 'String'))))
if (str2double(get(handles.ui_edit_forcing, 'String')) >= 4 && ...
str2double(get(handles.ui_edit_forcing, 'String')) <= 12)
FORCING = str2double(get(handles.ui_edit_forcing, 'String'));
set(handles.ui_slider_error, 'Value' , FORCING);
-
+
% Fix everything created by a potential previous error
turn_on_controls();
set(handles.ui_edit_forcing, 'BackgroundColor' , 'White');
@@ -1086,7 +1102,7 @@ function edit_forcing_Callback(~,~)
set(handles.ui_edit_forcing, 'String' , '?');
set(handles.ui_edit_forcing, 'BackgroundColor' , atts.red);
set(handles.ui_edit_forcing, 'FontWeight' , 'Bold');
-
+
fprintf('ERROR: Must enter a number between 4 and 12\n');
return;
end
@@ -1094,36 +1110,36 @@ function edit_forcing_Callback(~,~)
%% -----------------------------------------------------------------------
- function h_loc = plot_localization()
- % Plot a graphical indication of the localization halfwidth
- subplot(handles.polar_plot);
-
- % Localization is in halfwidth, fraction of domain (NOT RADIANS AS IN 3D MODELS).
- % Convert to halfwidth in radians for plotting
- half_radians = handles.localization * 2 * pi;
-
- % Plot 4 ranges
- my_h_loc = zeros(1, 4);
- my_col_loc = atts.colors4loc;
- for ipl = 1:4
- ymax = min([half_radians * (5.-ipl) / 2., pi]);
- ymin = -ymax;
- % Use 40 points for each range
- y = ymin:ymax/20:ymax;
- my_h_loc(ipl) = polar(y, 15*ones(size(y)));
- hold on
- % Lines get wider for larger localization
- set(my_h_loc(ipl), 'linewidth', 2*ipl, 'Color', my_col_loc(ipl, :));
- end
- h_loc = my_h_loc(1);
-
- % Plot a label for the localization graphic
- h_loc_text = text(-13, 0, 'Localization');
- set(h_loc_text, 'color', 'k', 'fontsize', 15, 'fontweight', 'bold');
-
- % Plot an observation asterisk
- plot(15, 0, '*', 'MarkerSize', 12, 'MarkerFaceColor', atts.red, 'MarkerEdgeColor', atts.red);
- end
+ function h_loc = plot_localization()
+ % Plot a graphical indication of the localization halfwidth
+ subplot(handles.polar_plot);
+
+ % Localization is in halfwidth, fraction of domain (NOT RADIANS AS IN 3D MODELS).
+ % Convert to halfwidth in radians for plotting
+ half_radians = handles.localization * 2 * pi;
+
+ % Plot 4 ranges
+ my_h_loc = zeros(1, 4);
+ my_col_loc = atts.colors4loc;
+ for ipl = 1:4
+ ymax = min([half_radians * (5.-ipl) / 2., pi]);
+ ymin = -ymax;
+ % Use 40 points for each range
+ y = ymin:ymax/20:ymax;
+ my_h_loc(ipl) = polar(y, 15*ones(size(y)));
+ hold on
+ % Lines get wider for larger localization
+ set(my_h_loc(ipl), 'linewidth', 2*ipl, 'Color', my_col_loc(ipl, :));
+ end
+ h_loc = my_h_loc(1);
+
+ % Plot a label for the localization graphic
+ h_loc_text = text(-13, 0, 'Localization');
+ set(h_loc_text, 'color', 'k', 'fontsize', 15, 'fontweight', 'bold');
+
+ % Plot an observation asterisk
+ plot(15, 0, '*', 'MarkerSize', 12, 'MarkerFaceColor', atts.red, 'MarkerEdgeColor', atts.red);
+ end
end
diff --git a/documentation/DART_LAB/matlab/run_lorenz_96_inf.m b/documentation/DART_LAB/matlab/run_lorenz_96_inf.m
index 24f10ccbf0..37217152fb 100644
--- a/documentation/DART_LAB/matlab/run_lorenz_96_inf.m
+++ b/documentation/DART_LAB/matlab/run_lorenz_96_inf.m
@@ -55,9 +55,9 @@
%% Create figure Layout
figure('position', [400 100 figWidth figHeight], ...
- 'Units', 'pixels', ...
- 'Name', 'run_lorenz_96_inf', ...
- 'Color', atts.background);
+ 'Units', 'pixels', ...
+ 'Name', 'run_lorenz_96_inf', ...
+ 'Color', atts.background);
%% Create text in the top right corner with the elapsed model time
handles.time = 1;
@@ -278,7 +278,7 @@
handles.ui_text_inflation = uicontrol(handles.InfPanel, ...
'Style', 'text', ...
'Units', 'Normalized', ...
- 'Position', [0.12 0.8 0.800 0.270], ...
+ 'Position', [0.1 0.7 0.800 0.270], ...
'String', 'Adaptive Inflation', ...
'HorizontalAlignment', 'center', ...
'BackgroundColor', atts.background, ...
@@ -310,17 +310,6 @@
'FontSize', 0.7, ...
'Callback', @edit_inflation_Std_Callback);
-handles.ui_edit_inflation_Damp = uicontrol(handles.InfPanel, ...
- 'Style', 'edit', ...
- 'Units', 'Normalized', ....
- 'Position', [0.40 0.21 0.210 0.270], ...
- 'String', '1.0', ...
- 'BackgroundColor', 'White', ...
- 'FontName', atts.fontname, ...
- 'FontUnits', 'normalized', ...
- 'FontSize', 0.7, ...
- 'Callback', @edit_inflation_Damp_Callback);
-
handles.ui_text_inflation_Damp = uicontrol(handles.InfPanel, ...
'Style', 'text', ...
'Units', 'Normalized', ....
@@ -333,16 +322,16 @@
'FontWeight','normal', ...
'FontSize', 0.60);
-handles.ui_edit_inflation_Min = uicontrol(handles.InfPanel, ...
+handles.ui_edit_inflation_Damp = uicontrol(handles.InfPanel, ...
'Style', 'edit', ...
'Units', 'Normalized', ....
- 'Position', [0.75 0.21 0.210 0.270], ...
- 'String', '0.0', ...
+ 'Position', [0.40 0.21 0.210 0.270], ...
+ 'String', '1.0', ...
'BackgroundColor', 'White', ...
'FontName', atts.fontname, ...
'FontUnits', 'normalized', ...
'FontSize', 0.7, ...
- 'Callback', @edit_inflation_Min_Callback);
+ 'Callback', @edit_inflation_Damp_Callback);
handles.ui_text_inflation_Min = uicontrol(handles.InfPanel, ...
'Style', 'text', ...
@@ -356,6 +345,17 @@
'FontWeight','normal', ...
'FontSize', 0.60);
+handles.ui_edit_inflation_Min = uicontrol(handles.InfPanel, ...
+ 'Style', 'edit', ...
+ 'Units', 'Normalized', ....
+ 'Position', [0.75 0.21 0.210 0.270], ...
+ 'String', '0.0', ...
+ 'BackgroundColor', 'White', ...
+ 'FontName', atts.fontname, ...
+ 'FontUnits', 'normalized', ...
+ 'FontSize', 0.7, ...
+ 'Callback', @edit_inflation_Min_Callback);
+
%% Reset button - clear the whole thing
@@ -490,6 +490,14 @@
h = legend('Prior RMSE', 'Posterior RMSE', 'Prior Spread', 'Posterior Spread');
set(h, 'FontSize', atts.fontsize, 'Position',[0.46 0.62 0.118 0.148], 'EdgeColor', 'w'); % Sadly, these dont seem to scale - even when normalized.
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+else
+ h.AutoUpdate = 'off';
+end
+
ylabel('RMSE & Spread', 'FontSize', atts.fontsize);
xlabel('Time', 'FontSize', atts.fontsize);
@@ -539,26 +547,34 @@
% Unclear if these can be set more cleanly with polar
% This also gets the observations into the legend
- h_obs = plot_polar([0, 2*pi], 14.9, handles.mean_dist, 'r*', 1); hold on
-handles.h_ens = plot_polar([0, 2*pi], 1000, handles.mean_dist, '-g', 1);
+h_obs = plot_polar([0, 2*pi], 14.9, handles.mean_dist, 'r*', 1); hold on
+handles.h_ens = plot_polar([0, 2*pi], 1000, handles.mean_dist, '-g', 1);
handles.h_truth = plot_polar([0, 2*pi], 1000, handles.mean_dist, '-k', 1);
-set(handles.h_truth, 'linewidth', 3);
-set(handles.h_ens , 'linewidth', 1, 'Color', atts.green);
-set( h_obs , 'linewidth', 1, 'Color', atts.red, 'Visible', 'off');
+set(handles.h_truth, 'linewidth', 3);
+set(handles.h_ens , 'linewidth', 1, 'Color', atts.green);
+set( h_obs , 'linewidth', 1, 'Color', atts.red, 'Visible', 'off');
-h_leg = legend( [handles.h_truth, handles.h_ens, h_obs], 'True State', ...
- 'Ensemble', 'Observations', 'Location', 'NorthEast');
-pos = get(h_leg, 'Position') + [0.09 0.01 0.021 0.012];
-set(h_leg, 'Position', pos, 'FontSize', atts.fontsize, 'EdgeColor', 'w');
+L = legend( [handles.h_truth, handles.h_ens, h_obs], 'True State', ...
+ 'Ensemble', 'Observations', 'Location', 'NorthEast');
+pos = get(L, 'Position') + [0.09 0.01 0.021 0.012];
+set(L, 'Position', pos, 'FontSize', atts.fontsize, 'EdgeColor', 'w');
+
+if verLessThan('matlab','R2017a')
+ % Convince Matlab to not autoupdate the legend with each new line.
+ % Before 2017a, this was the default behavior, so do nothing.
+ % We do not want to add the bias line to the legend, for example.
+else
+ L.AutoUpdate = 'off';
+end
% Plot the localization width
plot_localization;
%% -----------------------------------------------------------------------------
-% Initiate log file
-if exist(LOG_FILE, 'file') == 2
+% Initiate log file
+if exist(LOG_FILE, 'file') == 2
logfileid = fopen(LOG_FILE, 'a');
else
logfileid = fopen(LOG_FILE, 'w');
@@ -568,7 +584,7 @@
fprintf(logfileid, '*********************** %s ************************\n\n', mfilename);
end
-fprintf(logfileid, '\n\nNEW RUN: Starting date and time %s\n', datetime);
+fprintf(logfileid, '\n\nNEW RUN: Starting date and time %s\n', datestr(datetime));
fprintf(logfileid, '========\n\n');
fprintf(logfileid, '# Time step: %.2f (Initial configuration)\n', DELTA_T);
@@ -592,10 +608,10 @@
function SingleStep_Callback(~, ~)
% Called whenever [Advance Model/Assimilate Obs] is pressed.
% If Assimilation is turned off ... we are always ready to advance.
-
+
% Signal that something has happened.
set(handles.ui_button_Single_Step, 'Enable', 'Off');
-
+
if(strcmp(handles.filter_type_string, 'No Assimilation'))
if (strcmp(get(handles.ui_button_Single_Step, 'String') , 'Assimilate Obs'))
%If it says Assimilate Obs, that means another assimilation
@@ -604,9 +620,9 @@ function SingleStep_Callback(~, ~)
end
handles.ready_to_advance = true;
end
-
+
step_ahead();
-
+
set(handles.ui_button_Single_Step, 'Enable', 'On');
end
@@ -614,35 +630,35 @@ function SingleStep_Callback(~, ~)
function AutoRun_Callback(~, ~)
% Specifies action for the 'Start/Pause Auto Run' button.
-
+
% Turn off all the other model status controls to avoid a mess
turn_off_controls();
set(handles.ui_button_Auto_Run, 'Enable', 'On');
-
+
% Check the button label to see if we are starting or stopping a Auto run
if(strcmp(get(handles.ui_button_Auto_Run, 'String'), 'Pause Auto Run'))
-
+
% Turn off the Auto run pushbutton until everything has completely stopped
set(handles.ui_button_Auto_Run, 'Enable', 'Off');
-
+
% Being told to stop; switch to not running status
set(handles.ui_button_Auto_Run, 'String', 'Start Auto Run');
-
+
else
% Being told to start Auto run
% Change the pushbutton to stop
set(handles.ui_button_Auto_Run, 'String', 'Pause Auto Run');
-
+
% Loop through advance and assimilate steps until stopped
while(true)
-
+
% Check to see if stop has been pushed
status_string = get(handles.ui_button_Auto_Run, 'String');
if(strcmp(status_string, 'Start Auto Run'))
turn_on_controls();
return
end
-
+
% Do the next advance or assimilation step
step_ahead();
drawnow
@@ -654,14 +670,14 @@ function AutoRun_Callback(~, ~)
function Forcing_Callback(~, ~)
%Called when the slider has been changed
-
+
err = get(handles.ui_slider_error, 'Value');
old_forcing = FORCING;
-
+
% Round the Value of the slider to the nearest integer
% Set the Value of the slider to the rounded number. This will
% Create a snap into place effect
-
+
FORCING = round(err);
set(handles.ui_slider_error, 'Value' , FORCING);
set(handles.ui_edit_forcing, 'String' , sprintf('%d',FORCING));
@@ -678,7 +694,7 @@ function edit_inflation_Std_Callback(~, ~)
inflate_std_new = str2double(get(handles.ui_edit_inflation_Std, 'String'));
old_inflate_std = handles.inflation_Std;
-
+
% Set the inflation value to the update
handles.inflation_Std = inflate_std_new;
handles.inflation_Std_Min = handles.inflation_Std;
@@ -687,20 +703,20 @@ function edit_inflation_Std_Callback(~, ~)
% After this, only this edit box will work
turn_off_controls();
set(handles.ui_edit_inflation_Std, 'Enable', 'On');
-
+
set(handles.ui_edit_inflation_Std, 'String', '?','FontWeight','Bold','BackgroundColor', atts.red);
set(handles.ui_text_inf_std_err_print, 'Visible','On')
-
+
fprintf('ERROR: inflation std must be greater than 0.\n')
fprintf('ERROR: unable to interpret inflation std value, please try again.\n')
-
+
return
end
% Update log file
Update_log_file(rms_time, handles.time, handles.prior_rms, handles.prior_spread, ...
'Inflation Std', old_inflate_std, handles.inflation_Std);
-
+
% Enable all controls
turn_on_controls();
set(handles.ui_edit_inflation_Std, 'BackgroundColor', 'White','FontWeight','Normal');
@@ -710,34 +726,34 @@ function edit_inflation_Std_Callback(~, ~)
function edit_inflation_Damp_Callback(~, ~)
% Is called when the edit_inflation field is changed
-
+
set(handles.ui_text_inf_damp_warn_print, 'Visible','Off')
inflate_damp_new = str2double(get(handles.ui_edit_inflation_Damp, 'String'));
- old_damping = handles.inflation_Damp;
-
+ old_damping = handles.inflation_Damp;
+
% Set the inflation value to the update
handles.inflation_Damp = inflate_damp_new;
-
+
if( not(isfinite(handles.inflation_Damp)) || handles.inflation_Damp > 1. )
% After this, only this edit box will work
turn_off_controls();
set(handles.ui_edit_inflation_Damp, 'Enable', 'On');
-
+
set(handles.ui_edit_inflation_Damp, 'String', '?','FontWeight','Bold','BackgroundColor', atts.red);
set(handles.ui_text_inf_damp_err_print, 'Visible','On')
-
+
fprintf('ERROR: inflation damping must be between 0.1 and 1.\n')
fprintf('ERROR: unable to interpret inflation damp value, please try again.\n')
-
+
return
-
+
end
% Update log file
Update_log_file(rms_time, handles.time, handles.prior_rms, handles.prior_spread, ...
'Inflation Damping', old_damping, handles.inflation_Damp);
-
+
% Enable all controls
turn_on_controls();
set(handles.ui_edit_inflation_Damp, 'BackgroundColor', 'White','FontWeight','Normal');
@@ -750,7 +766,7 @@ function edit_inflation_Min_Callback(~, ~)
inflate_Min_new = str2double(get(handles.ui_edit_inflation_Min, 'String'));
old_if_min = handles.inflation_Min;
-
+
% Set the inflation value to the update
handles.inflation_Min = inflate_Min_new;
@@ -758,20 +774,20 @@ function edit_inflation_Min_Callback(~, ~)
% After this, only this edit box will work
turn_off_controls();
set(handles.ui_edit_inflation_Min, 'Enable', 'On');
-
+
set(handles.ui_edit_inflation_Min, 'String', '?','FontWeight','Bold','BackgroundColor', atts.red);
set(handles.ui_text_inf_min_err_print, 'Visible','On')
-
+
fprintf('ERROR: inflation lower bound must be greater than or equal 0.\n')
fprintf('ERROR: unable to interpret inflation min value, please try again.\n')
-
+
return
end
% Update log file
Update_log_file(rms_time, handles.time, handles.prior_rms, handles.prior_spread, ...
'Inflation Min', old_if_min, handles.inflation_Min);
-
+
% Enable all controls
turn_on_controls();
set(handles.ui_edit_inflation_Min, 'BackgroundColor', 'White','FontWeight','Normal');
@@ -784,33 +800,33 @@ function edit_localization_Callback(~, ~)
localization_new = str2double(get(handles.ui_edit_localization, 'String'));
old_localization = handles.localization;
-
+
% Set the localization value to the update
handles.localization= localization_new;
-
+
if(not(isfinite(handles.localization)) || handles.localization <= 0)
-
+
% After this, only this edit box will work
turn_off_controls();
set(handles.ui_edit_localization, 'Enable', 'On');
set(handles.ui_edit_localization, 'String', '?','FontWeight','Bold','BackgroundColor', atts.red );
set(handles.ui_text_localization_err_print, 'Visible','On')
-
+
fprintf('\nERROR: localization must be greater than 0.\n')
fprintf('ERROR: localization must be greater than 0.\n')
-
+
return
end
% Update log file
Update_log_file(rms_time, handles.time, handles.prior_rms, handles.prior_spread, ...
'Localization', old_localization, handles.localization);
-
+
% Enable all controls
turn_on_controls();
set(handles.ui_edit_localization, 'BackgroundColor', 'White','FontWeight','Normal');
set(handles.ui_text_localization_err_print, 'Visible','Off')
-
+
% Update the localization plot
cla(handles.polar_plot);
plot_localization;
@@ -819,59 +835,59 @@ function edit_localization_Callback(~, ~)
%% ----------------------------------------------------------------------
function edit_ens_size_Callback(~, ~)
-
+
% Check to see if the new ensemble size is valid
new_ens_size = str2double(get(handles.ui_edit_ens_size, 'String'));
old_ens_size = handles.ens_size;
-
+
if(not(isfinite(new_ens_size)) || new_ens_size < 2 || new_ens_size > 40)
-
+
% After this, only this edit box will work
turn_off_controls();
set(handles.ui_edit_ens_size, 'Enable', 'On');
-
+
set(handles.ui_edit_ens_size, 'String', '?','FontWeight','Bold','BackgroundColor', atts.red );
set(handles.ui_text_ens_size_err_print, 'Visible','On')
-
+
fprintf('\nERROR: Must input an integer Ens. Size greater than 1 and less than 40\n');
fprintf('ERROR: Must input an integer Ens. Size greater than 1 and less than 40\n');
-
+
return
-
+
end
% Enable all controls
turn_on_controls();
-
+
% clear out the old graphics
cla(handles.polar_plot)
cla(handles.timeseries)
cla(handles.infseries)
cla(handles.prior_rank_histogram)
cla(handles.post_rank_histogram)
-
+
set(handles.ui_edit_ens_size, 'BackgroundColor', 'White','FontWeight','Normal');
-
+
% Set the ensemble size global value to the update
handles.ens_size = new_ens_size;
% Update log file
Update_log_file(rms_time, handles.time, handles.prior_rms, handles.prior_spread, ...
'Ensemble size', old_ens_size, handles.ens_size);
-
+
% Need to reset the ensemble and the time
clear handles.true_state
handles.true_state(1, 1:handles.model_size) = TRUE_FORCING;
handles.true_state(1, 1) = 1.001 * TRUE_FORCING;
handles.time = 1;
-
+
% Generate set of ensemble perturbations
handles.posterior = zeros(1, handles.model_size, handles.ens_size);
for imem = 1:handles.ens_size
handles.posterior(1, 1:handles.model_size, imem) = ...
handles.true_state(1, :) + 0.001 * randn(1, handles.model_size);
end
-
+
% For convenience make the first prior identical to the first posterior
handles.prior = handles.posterior;
handles.prior_inf = ones(1, MODEL_SIZE);
@@ -879,65 +895,65 @@ function edit_ens_size_Callback(~, ~)
handles.prior_spread = 0;
handles.posterior_rms = 0;
handles.posterior_spread = 0;
-
+
% An array to keep track of rank histograms
handles.prior_rank( 1 : handles.ens_size + 1) = 0;
handles.posterior_rank(1 : handles.ens_size + 1) = 0;
-
+
%Reset button to 'Advance Model'
set(handles.ui_button_Single_Step, 'String' , 'Advance Model');
handles.ready_to_advance = true;
-
+
%Reset the time text
set(handles.ui_text_time,'String', 'Time = 1');
%Reset the text annotation for RMS
rms_time = 1;
-
+
end
%% ----------------------------------------------------------------------
function reset_Callback(~, ~)
% Sets the graphs and the values to original values
-
+
% set random number seed to same value to generate known sequences
% rng('default') is the Mersenne Twister with seed 0
rng(0,'twister')
-
+
% Initialize the L96 model
L96 = lorenz_96_static_init_model;
TRUE_FORCING = L96.forcing;
FORCING = L96.forcing;
MODEL_SIZE = L96.model_size;
DELTA_T = L96.delta_t;
-
+
% Set the edit fields
-
+
set(handles.ui_edit_localization , 'String', '0.3');
set(handles.ui_edit_ens_size , 'String', '20');
set(handles.ui_edit_inflation_Std , 'String', '0.6');
set(handles.ui_edit_inflation_Damp , 'String', '0.9');
set(handles.ui_edit_inflation_Min , 'String', '1.0');
-
+
set(handles.ui_button_group_assimilation,'SelectedObject',handles.ui_radio_noAssimilation);
handles.filter_type_string = 'No Assimilation';
set(handles.ui_button_Single_Step, 'String' , 'Advance Model');
-
+
set(handles.ui_slider_error , 'Value' , 10);
set(handles.ui_edit_forcing , 'String', 10);
-
+
handles.localization = str2double(get(handles.ui_edit_localization, 'String'));
handles.ens_size = str2double(get(handles.ui_edit_ens_size, 'String'));
-
+
handles.inflation_Std = str2double(get(handles.ui_edit_inflation_Std, 'String'));
handles.inflation_Damp = str2double(get(handles.ui_edit_inflation_Damp, 'String'));
handles.inflation_Min = str2double(get(handles.ui_edit_inflation_Min, 'String'));
handles.inflation_Max = 5;
handles.inflation_Std_Min = handles.inflation_Std;
-
+
clear handles.true_state
-
+
handles.model_size = MODEL_SIZE;
handles.true_state(1, 1:MODEL_SIZE) = TRUE_FORCING;
handles.true_state(1, 1) = 1.001 * TRUE_FORCING;
@@ -949,49 +965,49 @@ function reset_Callback(~, ~)
handles.posterior = 0;
handles.posterior_rms = 0;
handles.posterior_spread = 0;
-
+
%str = get(handles.menu_assimilation,'String');
%handles.filter_type_string = str{get(handles.menu_assimilation,'Value')};
-
+
set(handles.ui_text_time,'String', sprintf('Time = %d',handles.time))
-
+
% Used to normalize the polar plotting
handles.mean_dist = 35;
-
+
handles.h_ens = [];
handles.h_truth = [];
-
+
% Global semaphore; ready to advance or assimilate?
handles.ready_to_advance = true;
-
+
% Generate set of ensemble perturbations
handles.posterior = zeros(1, handles.model_size, handles.ens_size);
for imem = 1:handles.ens_size
handles.posterior(1, 1:handles.model_size, imem) = ...
handles.true_state(1, :) + 0.001 * randn(1, handles.model_size);
end
-
+
% For convenience make the first prior identical to the first posterior
handles.prior = handles.posterior;
-
+
% An array to keep track of rank histograms
handles.prior_rank( 1 : handles.ens_size + 1) = 0;
handles.posterior_rank(1 : handles.ens_size + 1) = 0;
-
+
% Clear out the old graphics. The legends remain, which is nice.
cla(handles.polar_plot)
cla(handles.timeseries)
cla(handles.infseries)
cla(handles.prior_rank_histogram)
cla(handles.post_rank_histogram)
-
+
% Put back the localization if this is not the initial setup of the graphics
if(first_call_to_reset)
- first_call_to_reset = false;
+ first_call_to_reset = false;
else
- plot_localization;
+ plot_localization;
end
-
+
% Reset the RMS avaregaing:
rms_time = 1;
subplot(handles.timeseries); title( ' ' );
@@ -1022,11 +1038,11 @@ function ClearStats_Callback(~, ~)
% An array to keep track of rank histograms
handles.prior_rank( 1 : handles.ens_size + 1) = 0;
handles.posterior_rank(1 : handles.ens_size + 1) = 0;
-
+
% Clear out the old graphics. The legends remain, which is nice.
cla(handles.prior_rank_histogram)
cla(handles.post_rank_histogram)
-
+
end
@@ -1036,9 +1052,9 @@ function Update_log_file(t1, t2, RMS, AES, info, p1, p2)
logfileid = fopen(LOG_FILE, 'a');
- fprintf(logfileid, '# Time step: %d\n', t2);
+ fprintf(logfileid, '# Time step: %d\n', t2);
fprintf(logfileid, ' >> Statistics over period (%d:%d): avg. Prior RMSE = %.2f, avg. Prior Spread = %.2f\n', ...
- t1, t2, mean(RMS(t1:t2)), mean(AES(t1:t2)));
+ t1, t2, mean(RMS(t1:t2)), mean(AES(t1:t2)));
if strcmp(info, 'Ensemble size') == 1
fprintf(logfileid, ' $$ User input: %s has been changed from %d to %d\n\n', info, p1, p2);
@@ -1051,7 +1067,7 @@ function Update_log_file(t1, t2, RMS, AES, info, p1, p2)
else
fprintf(logfileid, ' $$ User input: %s has been changed from %.2f to %.2f\n\n', info, p1, p2);
end
-
+
fprintf(logfileid, ' Current values of the parameters:\n');
fprintf(logfileid, ' - Forcing `F` parameter = %.2f\n', TRUE_FORCING);
fprintf(logfileid, ' - Assimilation type is `%s`\n', handles.filter_type_string);
@@ -1071,10 +1087,10 @@ function Update_log_file(t1, t2, RMS, AES, info, p1, p2)
function step_ahead()
% Specifies the action for the [Assimilate Obs/Advance Model] button.
-
+
% Test on semaphore, either advance or assimilate
if(handles.ready_to_advance)
-
+
% Set semaphore to indicate that next step may be an assimilation
% Set the pushbutton text to indicate that next step is an assimilate
% only if we have selected a filter algorithm
@@ -1085,13 +1101,13 @@ function step_ahead()
handles.ready_to_advance = false;
set(handles.ui_button_Single_Step, 'String', 'Assimilate Obs');
end
-
+
% Code for advancing model comes next
time = handles.time;
[new_truth, new_time] = lorenz_96_adv_1step(handles.true_state(time, :), time, TRUE_FORCING);
handles.time = new_time;
handles.true_state(new_time, :) = new_truth;
-
+
% Advance the ensemble members; posterior -> new prior
for imem = 1:handles.ens_size
[new_ens, new_time] = lorenz_96_adv_1step(handles.posterior(time, :, imem), time, FORCING);
@@ -1105,19 +1121,19 @@ function step_ahead()
handles.prior(new_time, i, :) = ens_mean + ...
sqrt(handles.prior_inf(1, i)) * (handles.prior(new_time, i, :) - ens_mean);
end
-
+
if(strcmp(handles.filter_type_string, 'No Assimilation'))
% we are not assimilating
% just copy prior to posterior
handles.posterior(new_time, :, :) = handles.prior(new_time, :, :);
end
-
+
% Plot a single invisible point to wipe out the previous plot
% and maintain axis limits of polar plot.
axes(handles.polar_plot); cla;
h_obs = plot_polar([0, 2*pi], 14.9, handles.mean_dist, 'r*', 1);
set(h_obs, 'Visible', 'Off', 'Color', atts.red)
-
+
% Plot the ensemble members (green) and the truth (black)
for imem = 1:handles.ens_size
handles.h_ens = plot_polar(polar_y, handles.prior(new_time, :, imem), ...
@@ -1127,30 +1143,30 @@ function step_ahead()
handles.h_truth = plot_polar(polar_y, new_truth, handles.mean_dist, 'k', MODEL_SIZE);
% Make truth wider so it is easier to distinguish
set(handles.h_truth, 'linewidth', 3);
-
+
% Plot a graphical indication of the localization halfwidth; Is expense of this a problem.
plot_localization;
-
+
% Update the time label
set(handles.ui_text_time, 'String', sprintf('Time = %d', handles.time));
-
+
% Compute the prior RMS error of ensemble mean
handles.prior_rms(new_time) = rms_error(new_truth, handles.prior(new_time, :, :));
handles.prior_spread(new_time) = ens_spread(handles.prior(new_time, :, :));
-
+
% Save the information about the histograms from before
temp_rank(:, 1) = handles.prior_rank(1:handles.ens_size + 1);
temp_rank(:, 2) = 0;
-
+
% Compute the prior rank histograms
for i = 1:handles.ens_size
ens_rank = get_ens_rank(squeeze(handles.prior(new_time, i, :)), squeeze(new_truth(i)));
handles.prior_rank(ens_rank) = handles.prior_rank(ens_rank) + 1;
temp_rank(ens_rank, 2) = temp_rank(ens_rank, 2) + 1;
end
-
+
% Plot the prior_rms error time series
-
+
% Change Focus to time evolution of rmse & spread
subplot(handles.timeseries)
plot(handles.prior_rms, '-' ,'Color',atts.green,'LineWidth',2.0);
@@ -1159,48 +1175,48 @@ function step_ahead()
% Display average RMS of previous run!
show_rms_on_plot(handles.prior_rms, handles.prior_spread, [ rms_time, handles.time ]);
-
+
% Plot inflation
subplot(handles.infseries)
h_inflation = plot( cartes_y, handles.prior_inf, '-x', 'Color', atts.red ); hold on
set(handles.infseries, 'YGrid', 'on', 'XLim', [ cartes_y(1)-cartes_s, cartes_y(end)+cartes_s], ...
- 'YLim', [0, 3], 'XTick', cartes_t, 'YTick', [1, 2])
+ 'YLim', [0, 3], 'XTick', cartes_t, 'YTick', [1, 2])
ylabel('Inflation | Deflation', 'FontSize', atts.fontsize);
xlabel('Location', 'FontSize', atts.fontsize);
text( 97, .5, [ 'Overall mean= ' sprintf( '%.4f', mean(handles.prior_inf) ) ], 'FontSize', atts.fontsize );
hold off
-
+
% Plot the rank histogram for the prior
subplot(handles.prior_rank_histogram);
B = bar(temp_rank, 0.7, 'stacked');
B(1).FaceColor= atts.blue ; B(1).EdgeColor= 'k';
B(2).FaceColor= atts.yellow ; B(2).EdgeColor= 'k';
axis tight
-
+
else % We need to do an assimilation.
-
+
% Get current time step
time = handles.time;
-
+
% Generate noisy observations of the truth
obs_sd = 4;
obs_error_var = obs_sd^2;
-
+
% Get current (prior) inflation
pior_inf = handles.prior_inf;
-
+
% Do fully sequential assimilation algorithm
temp_ens = squeeze(handles.prior(time, :, :));
-
+
% Select the first plotting box
axes(handles.polar_plot);
-
+
% Observe each state variable independently
obs = zeros(1,MODEL_SIZE);
for i = 1:MODEL_SIZE
obs_prior = temp_ens(i, :);
obs(i) = handles.true_state(time, i) + obs_sd * randn;
-
+
% Compute the increments for observed variable
switch handles.filter_type_string
case 'EAKF'
@@ -1213,49 +1229,49 @@ function step_ahead()
%No Incrementation
obs_increments = 0;
end
-
+
% Regress the increments onto each of the state variables +
% update inflation values
for j = 1:MODEL_SIZE
[state_incs, r_xy] = get_state_increments(temp_ens(j, :), ...
obs_prior, obs_increments);
-
+
% Compute distance between obs and state for localization
dist = abs(i - j) / MODEL_SIZE;
if(dist > 0.5), dist = 1 - dist; end
-
+
% Compute the localization factor
cov_factor = comp_cov_factor(dist, handles.localization);
-
+
temp_ens(j, :) = temp_ens(j, :) + state_incs * cov_factor;
-
+
% Get the correlation factor between the observation
% and the state variables:
gamma = cov_factor * abs(r_xy);
-
+
% Bayesian update of the inflation
handles.prior_inf(j) = update_inflate( mean(obs_prior), var(obs_prior), obs(i), obs_error_var, ...
- pior_inf(j), handles.prior_inf(j), handles.inflation_Min, handles.inflation_Max, ...
- gamma, handles.inflation_Std, handles.inflation_Std_Min);
+ pior_inf(j), handles.prior_inf(j), handles.inflation_Min, handles.inflation_Max, ...
+ gamma, handles.inflation_Std, handles.inflation_Std_Min);
end
end
-
+
% Plot the observations
subplot(handles.polar_plot)
h_obs = plot_polar(polar_y, obs, handles.mean_dist, 'r*', MODEL_SIZE);
set(h_obs, 'Color', atts.red)
-
+
% Update the posterior
handles.posterior(time, :, :) = temp_ens;
-
+
% Compute the posterior rms, spread
handles.posterior_rms(time) = rms_error(handles.true_state(time, :), handles.posterior(time, :, :));
handles.posterior_spread(time) = ens_spread(handles.posterior(time, :, :));
-
+
% Save the information about the histograms from before
temp_rank(:, 1) = handles.posterior_rank(1:handles.ens_size + 1);
temp_rank(:, 2) = 0;
-
+
% Compute the posterior rank histograms
for i = 1:handles.ens_size
ens_rank = get_ens_rank(squeeze(handles.posterior(time, i, :)), ...
@@ -1263,35 +1279,35 @@ function step_ahead()
handles.posterior_rank(ens_rank) = handles.posterior_rank(ens_rank) + 1;
temp_rank(ens_rank, 2) = temp_rank(ens_rank, 2) + 1;
end
-
+
% Plot the posterior_rms error time series
subplot(handles.timeseries);
plot(handles.posterior_rms, '-' , 'Color', atts.blue, 'LineWidth', 2.0);
plot(handles.posterior_spread, '-.', 'Color', atts.blue, 'LineWidth', 2.0);
-
+
% Plot the rank histogram for the prior
subplot(handles.post_rank_histogram);
B = bar(temp_rank, 0.7, 'stacked');
B(1).FaceColor= atts.blue ; B(1).EdgeColor= 'k';
B(2).FaceColor= atts.yellow ; B(2).EdgeColor= 'k';
axis tight
-
+
% Set semaphore to indicate that next step is a model advance
handles.ready_to_advance = true;
-
+
% Set the pushbutton text to indicate that the next step is a model advance
set(handles.ui_button_Single_Step, 'String', 'Advance Model');
-
+
end
-
-
+
+
end
%% ----------------------------------------------------------------------
function ens_mean_rms = rms_error(truth, ens)
% Calculates the rms_error
-
+
ens_mean = mean(squeeze(ens),2)';
ens_mean_rms = sqrt(sum((truth - ens_mean).^2) / size(truth, 2));
end
@@ -1302,7 +1318,7 @@ function step_ahead()
% Calculates the ens_spread
% Remove the mean of each of the 40 model variables (40 locations).
% resulting matrix is 40x20 ... each row/location is centered (zero mean).
-
+
[~, model_size, ens_size] = size(ens);
datmat = detrend(squeeze(ens)','constant'); % remove the mean of each location.
denom = (model_size - 1)*ens_size;
@@ -1317,11 +1333,11 @@ function show_rms_on_plot(prior_rms_vals, prior_aes_vals, ranges)
prior_rms_vals_new = prior_rms_vals(ranges(1): ranges(2));
prior_aes_vals_new = prior_aes_vals(ranges(2): ranges(2));
-
+
str1 = ['Averaging over steps: (' num2str(ranges(1)) ':' num2str(ranges(2)) ')'];
str2 = ['Prior: error = ' ...
- sprintf('%.2f', mean(prior_rms_vals_new) ) ', spread = ' ...
- sprintf('%.2f', mean(prior_aes_vals_new) )];
+ sprintf('%.2f', mean(prior_rms_vals_new) ) ', spread = ' ...
+ sprintf('%.2f', mean(prior_aes_vals_new) )];
show_old_rms = title( {str1, str2});
set(show_old_rms, 'FontSize', 16)
@@ -1331,10 +1347,10 @@ function show_rms_on_plot(prior_rms_vals, prior_aes_vals, ranges)
function turn_off_controls()
% Disables all the buttons,menus, and edit fields
-
+
set(handles.ui_button_Single_Step, 'Enable', 'Off');
set(handles.ui_button_Auto_Run, 'Enable', 'Off');
-
+
% In 2015, there is a way to disable the button group, but it is not
% compatible with 2014, so we must enable/disable each radio button
% seperately
@@ -1342,16 +1358,16 @@ function turn_off_controls()
set(handles.ui_radio_EAKF, 'Enable', 'Off');
set(handles.ui_radio_EnKF, 'Enable', 'Off');
set(handles.ui_radio_RHF, 'Enable', 'Off');
-
+
set(handles.ui_slider_error, 'Enable', 'Off');
set(handles.ui_edit_forcing, 'Enable', 'Off');
set(handles.ui_edit_localization, 'Enable', 'Off');
set(handles.ui_edit_ens_size, 'Enable', 'Off');
-
+
set(handles.ui_edit_inflation_Std, 'Enable', 'Off');
set(handles.ui_edit_inflation_Damp, 'Enable', 'Off');
set(handles.ui_edit_inflation_Min, 'Enable', 'Off');
-
+
set(handles.ResetButton, 'Enable', 'Off');
set(handles.ClearStats, 'Enable', 'Off');
end
@@ -1360,10 +1376,10 @@ function turn_off_controls()
function turn_on_controls()
% Enables all the buttons,menus, and edit fields
-
+
set(handles.ui_button_Single_Step, 'Enable', 'On');
set(handles.ui_button_Auto_Run, 'Enable', 'On');
-
+
% In 2015, there is a way to disable the button group,
% but it is not compatible with 2014, so we must enable/disable
% each radio button seperately
@@ -1371,16 +1387,16 @@ function turn_on_controls()
set(handles.ui_radio_EAKF, 'Enable', 'On');
set(handles.ui_radio_EnKF, 'Enable', 'On');
set(handles.ui_radio_RHF, 'Enable', 'On');
-
+
set(handles.ui_slider_error, 'Enable', 'On');
set(handles.ui_edit_forcing, 'Enable', 'On');
set(handles.ui_edit_localization, 'Enable', 'On');
set(handles.ui_edit_ens_size, 'Enable', 'On');
-
+
set(handles.ui_edit_inflation_Std, 'Enable', 'On');
set(handles.ui_edit_inflation_Damp, 'Enable', 'On');
set(handles.ui_edit_inflation_Min, 'Enable', 'On');
-
+
set(handles.ResetButton, 'Enable', 'On');
set(handles.ClearStats, 'Enable', 'On');
end
@@ -1393,10 +1409,10 @@ function Assimilation_selection(~, eventdata)
%Set the filter_type_string to newest radiobutton Value
filter_new = get(eventdata.NewValue,'String');
- old_filter = handles.filter_type_string;
+ old_filter = handles.filter_type_string;
handles.filter_type_string = filter_new;
-
+
% Update log file
Update_log_file(rms_time, handles.time, handles.prior_rms, handles.prior_spread, ...
'Assimilation Type', old_filter, handles.filter_type_string);
@@ -1409,18 +1425,18 @@ function edit_forcing_Callback(~,~)
% slider is changed, the slider and the edit field are connected,
% the edit field is simply used to allow for more precise forcing
% values
-
+
% Undo any changes that could have been made by erros
turn_on_controls();
set(handles.ui_edit_forcing, 'BackgroundColor' , 'White');
set(handles.ui_edit_forcing, 'FontWeight' , 'Normal');
-
+
if(isfinite(str2double(get(handles.ui_edit_forcing, 'String'))))
if (str2double(get(handles.ui_edit_forcing, 'String')) >= 4 && ...
str2double(get(handles.ui_edit_forcing, 'String')) <= 12)
FORCING = str2double(get(handles.ui_edit_forcing, 'String'));
set(handles.ui_slider_error, 'Value' , FORCING);
-
+
% Fix everything created by a potential previous error
turn_on_controls();
set(handles.ui_edit_forcing, 'BackgroundColor' , 'White');
@@ -1454,7 +1470,7 @@ function edit_forcing_Callback(~,~)
set(handles.ui_edit_forcing, 'String' , '?');
set(handles.ui_edit_forcing, 'BackgroundColor' , atts.red);
set(handles.ui_edit_forcing, 'FontWeight' , 'Bold');
-
+
fprintf('ERROR: Must enter a number between 4 and 12\n');
return;
end
@@ -1462,36 +1478,36 @@ function edit_forcing_Callback(~,~)
%% -----------------------------------------------------------------------
- function my_h_loc = plot_localization
- % Plot a graphical indication of the localization halfwidth
- subplot(handles.polar_plot);
- dist = 16;
-
- % Localization is in halfwidth, fraction of domain (NOT RADIANS AS IN 3D MODELS).
- % Convert to halfwidth in radians for plotting
- half_radians = handles.localization * 2 * pi;
-
- % Plot 4 ranges
- my_h_loc = zeros(1, 4);
- my_col_loc = atts.colors4loc;
- for ipl = 1:4
- ymax = min([half_radians * (5.-ipl) / 2., pi]);
- ymin = -ymax;
- % Use 40 points for each range
- y = ymin:ymax/20:ymax;
- my_h_loc = polar_dares(y, dist*ones(size(y)));
- hold on
- % Lines get wider for larger localization
- set(my_h_loc, 'linewidth', 2*ipl, 'Color', my_col_loc(ipl, :));
- end
-
- % Plot a label for the localization graphic
- h_loc_text = text(-12, 0, 'Localization');
- set(h_loc_text, 'color', 'k', 'fontsize', 15, 'fontweight', 'bold');
-
- % Plot an observation asterisk
- plot(dist, 0, '*', 'MarkerSize', 12, 'MarkerFaceColor', atts.red, 'MarkerEdgeColor', atts.red);
- end
+ function my_h_loc = plot_localization
+ % Plot a graphical indication of the localization halfwidth
+ subplot(handles.polar_plot);
+ dist = 16;
+
+ % Localization is in halfwidth, fraction of domain (NOT RADIANS AS IN 3D MODELS).
+ % Convert to halfwidth in radians for plotting
+ half_radians = handles.localization * 2 * pi;
+
+ % Plot 4 ranges
+ my_h_loc = zeros(1, 4);
+ my_col_loc = atts.colors4loc;
+ for ipl = 1:4
+ ymax = min([half_radians * (5.-ipl) / 2., pi]);
+ ymin = -ymax;
+ % Use 40 points for each range
+ y = ymin:ymax/20:ymax;
+ my_h_loc = polar_dares(y, dist*ones(size(y)));
+ hold on
+ % Lines get wider for larger localization
+ set(my_h_loc, 'linewidth', 2*ipl, 'Color', my_col_loc(ipl, :));
+ end
+
+ % Plot a label for the localization graphic
+ h_loc_text = text(-12, 0, 'Localization');
+ set(h_loc_text, 'color', 'k', 'fontsize', 15, 'fontweight', 'bold');
+
+ % Plot an observation asterisk
+ plot(dist, 0, '*', 'MarkerSize', 12, 'MarkerFaceColor', atts.red, 'MarkerEdgeColor', atts.red);
+ end
end
diff --git a/documentation/DART_LAB/matlab/run_template.m b/documentation/DART_LAB/matlab/run_template.m
index 44486167a5..4037fc195d 100644
--- a/documentation/DART_LAB/matlab/run_template.m
+++ b/documentation/DART_LAB/matlab/run_template.m
@@ -31,11 +31,11 @@
% Begin initialization code - DO NOT EDIT
gui_Singleton = 1;
gui_State = struct('gui_Name', mfilename, ...
- 'gui_Singleton', gui_Singleton, ...
- 'gui_OpeningFcn', @run_template_OpeningFcn, ...
- 'gui_OutputFcn', @run_template_OutputFcn, ...
- 'gui_LayoutFcn', [] , ...
- 'gui_Callback', []);
+ 'gui_Singleton', gui_Singleton, ...
+ 'gui_OpeningFcn', @run_template_OpeningFcn, ...
+ 'gui_OutputFcn', @run_template_OutputFcn, ...
+ 'gui_LayoutFcn', [] , ...
+ 'gui_Callback', []);
if nargin && ischar(varargin{1})
gui_State.gui_Callback = str2func(varargin{1});
end
@@ -123,43 +123,43 @@ function pushbutton_free_run_Callback(hObject, ~, handles)
% Check the button label to see if we are starting or stopping a free run
if(strcmp(get(hObject, 'String'), 'Stop Free Run'))
-
- % Turn off the free run pushbutton until everything has completely stopped
- set(hObject, 'Enable', 'Off');
-
- % Being told to stop; switch to not running status
- set(hObject, 'String', 'Start Free Run');
-
- % Update the handles global structure
- guidata(hObject, handles);
-
+
+ % Turn off the free run pushbutton until everything has completely stopped
+ set(hObject, 'Enable', 'Off');
+
+ % Being told to stop; switch to not running status
+ set(hObject, 'String', 'Start Free Run');
+
+ % Update the handles global structure
+ guidata(hObject, handles);
+
else
- % Being told to start free run
- % Change the pushbutton to stop
- set(hObject, 'String', 'Stop Free Run');
- % Update the handles global structure
- guidata(hObject, handles);
-
- % Loop through advance and assimilate steps until stopped
- while(true)
- % Check to see if stop has been pushed; get latest copy of global data
- my_data = guidata(gcbo);
-
- status_string = get(my_data.pushbutton_free_run, 'String');
- if(strcmp(status_string, 'Start Free Run'))
-
- % Turn all the other model status controls back on
- % MAKE SURE TO INCLUDE OTHER CONTROLS HERE
- set(handles.pushbutton_single_step, 'Enable', 'On');
-
- % Very last, turn on the start free run button
- set(hObject, 'Enable', 'On');
-
- return
- end
- % Do the next advance or assimilation step
- step_ahead(hObject, my_data)
- end
+ % Being told to start free run
+ % Change the pushbutton to stop
+ set(hObject, 'String', 'Stop Free Run');
+ % Update the handles global structure
+ guidata(hObject, handles);
+
+ % Loop through advance and assimilate steps until stopped
+ while(true)
+ % Check to see if stop has been pushed; get latest copy of global data
+ my_data = guidata(gcbo);
+
+ status_string = get(my_data.pushbutton_free_run, 'String');
+ if(strcmp(status_string, 'Start Free Run'))
+
+ % Turn all the other model status controls back on
+ % MAKE SURE TO INCLUDE OTHER CONTROLS HERE
+ set(handles.pushbutton_single_step, 'Enable', 'On');
+
+ % Very last, turn on the start free run button
+ set(hObject, 'Enable', 'On');
+
+ return
+ end
+ % Do the next advance or assimilation step
+ step_ahead(hObject, my_data)
+ end
end
% Only way to get here is at the end of a stop; No need to clean up
@@ -173,27 +173,27 @@ function step_ahead(hObject, handles)
% Test on semaphore, either advance or assimilate
if(handles.ready_to_advance)
- % Set semaphore to indicate that next step is an assimilation
- handles.ready_to_advance = false;
-
- % Set the pushbutton text to indicate that next step is an assimilate
- set(handles.pushbutton_single_step, 'String', 'Assimilate Obs');
-
- % Code for advancing model comes next (delete two exisiting lines)
- pause(2)
- plot([1 2], [2 1], 'r');
-
+ % Set semaphore to indicate that next step is an assimilation
+ handles.ready_to_advance = false;
+
+ % Set the pushbutton text to indicate that next step is an assimilate
+ set(handles.pushbutton_single_step, 'String', 'Assimilate Obs');
+
+ % Code for advancing model comes next (delete two exisiting lines)
+ pause(2)
+ plot([1 2], [2 1], 'r');
+
else
- % Set semaphore to indicate that next step is a model advance
- handles.ready_to_advance = true;
-
- % Set the pushbutton text to indicate that the next step is a model advance
- set(handles.pushbutton_single_step, 'String', 'Advance Model');
-
- % Code for doing the assimilation comes here (delete two exisiting lines)
- pause(2)
- plot([1 2], [2 1], 'b');
-
+ % Set semaphore to indicate that next step is a model advance
+ handles.ready_to_advance = true;
+
+ % Set the pushbutton text to indicate that the next step is a model advance
+ set(handles.pushbutton_single_step, 'String', 'Advance Model');
+
+ % Code for doing the assimilation comes here (delete two exisiting lines)
+ pause(2)
+ plot([1 2], [2 1], 'b');
+
end
% If using multiple windows might need to reset focus to the gui window here
diff --git a/documentation/DART_LAB/matlab/twod_ensemble.m b/documentation/DART_LAB/matlab/twod_ensemble.m
index e0b88003d8..3b732aba72 100644
--- a/documentation/DART_LAB/matlab/twod_ensemble.m
+++ b/documentation/DART_LAB/matlab/twod_ensemble.m
@@ -273,9 +273,9 @@
%This graph is the graph of the observation
handles.h_obs_likelihood = axes( ...
- 'Position', [500/figureWidth 40/figureHeight 390/figureWidth 200/figureHeight], ...
- 'FontName', atts.fontname, ...
- 'FontSize', atts.fontsize);
+ 'Position', [500/figureWidth 40/figureHeight 390/figureWidth 200/figureHeight], ...
+ 'FontName', atts.fontname, ...
+ 'FontSize', atts.fontsize);
handles.h_marg_obs_plot = plot_gaussian(observation, obs_error_sd, 1);
@@ -302,13 +302,13 @@
function create_ensemble_Callback(~,~)
% Allows the user to create a new ensemble in the left axes
-
+
% Disable the update ensemble button and all other active buttons
set(handles.ui_button_create_ensemble, 'Enable', 'Off');
set(handles.ui_button_update_ensemble, 'Enable', 'Off');
set(handles.ui_edit_observation, 'Enable', 'Off');
set(handles.ui_edit_obs_error_sd, 'Enable', 'Off');
-
+
% Clear out any old ensemble members if they exist
axes(handles.h_joint)
for i = 1:handles.ens_size
@@ -317,7 +317,7 @@ function create_ensemble_Callback(~,~)
set(handles.h_unobs(i), 'Visible', 'off');
set(handles.h_marg(i), 'Visible', 'off');
end
-
+
% Turn off any posterior old plotting
set(handles.h_update_ens, 'Visible', 'off');
set(handles.h_marg_update, 'Visible', 'off');
@@ -326,106 +326,106 @@ function create_ensemble_Callback(~,~)
set(handles.h_state_inc, 'Visible', 'off');
set(handles.h_joint_update, 'Visible', 'off');
set(handles.h_joint_inc, 'Visible', 'off');
-
+
% Clear out the old best fit line
set(handles.h_best_fit, 'Visible', 'off');
set(handles.h_correl, 'Visible', 'off');
-
+
% Work in the joint distribution plot
axes(handles.h_joint);
hold on
-
+
% Need to guarantee at least 2 ensemble members
ens_size = 0;
-
+
while ens_size < 1000
-
+
[xt, yt] = ginput(1);
gca;
% Make sure that the click was in the correct set of axes
% Terminate by clicking outside of graph range
if(xt < 0 || xt > 10 || yt < 0 || yt > 10 || gca ~= handles.h_joint)
- axes(handles.h_joint);
+ axes(handles.h_joint); %#ok
break;
else
-
+
ens_size = ens_size + 1;
- x(1, ens_size) = xt;
- x(2, ens_size) = yt;
-
- axes(handles.h_joint);
+ x(1, ens_size) = xt; %#ok
+ x(2, ens_size) = yt; %#ok
+
+ axes(handles.h_joint); %#ok
handles.h_ens_member(ens_size) = ...
plot(x(1, ens_size), x(2, ens_size), '*', ...
'MarkerSize', 16, 'Color', atts.green, 'LineWidth',2.0);
-
+
% Plot the marginal for the unobserved state variable
%>@ TODO POSSIBLE IMPROVEMENT ... annotate new marginal mean, sd
- axes(handles.h_unobMarginal);
+ axes(handles.h_unobMarginal); %#ok
handles.h_unobs(ens_size) = ...
plot(0, x(2, ens_size), '*', 'MarkerSize', 16, 'Color', atts.green, 'LineWidth',2.0);
-
+
% Plot the marginal for the observed quantity
- axes(handles.h_obMarginal);
+ axes(handles.h_obMarginal); %#ok
handles.h_marg(ens_size) = ...
plot(x(1, ens_size), 0, '*', 'MarkerSize', 16, 'Color', atts.green, 'LineWidth',2.0);
-
+
% Plot the marginal in the gui frame
- axes(handles.h_obs_likelihood);
+ axes(handles.h_obs_likelihood); %#ok
handles.h_gui_marg(ens_size) = ...
plot(x(1, ens_size), 0, '*', 'MarkerSize', 16, 'Color', atts.green, 'LineWidth',2.0);
-
+
% Then switch back to axes(handles.h_joint)
- axes(handles.h_joint);
-
+ axes(handles.h_joint); %#ok
+
if (ens_size < 2)
continue
end
-
+
% Clear out the error message if it's been made visible
set(h_err_text, 'Visible', 'off');
set(h_click, 'Visible', 'off');
-
+
prior_correl = corrcoef(x(1, :), x(2, :));
str1 = sprintf('Correlation = %f', prior_correl(1,2));
set(handles.h_correl,'String', str1, 'Visible', 'on')
-
+
end
end
-
+
% it is possible that they click outside the box before completing a viable
% ensemble ... in this case, just return and let them start over.
if (ens_size > 0)
-
+
% Turn off the data entry messages
set(h_finish, 'Visible', 'off');
-
+
%% Ensemble created, compute mean and sd, clean up and return
% Set the global gui storage
handles.ens_size = ens_size;
handles.ens_members = x;
-
+
% Plot the best fit line on the ensemble
prior_mean = mean(x, 2);
prior_cov = cov(x(1, :), x(2, :));
slope = prior_cov(1, 2) / var(x(1, :));
-
+
best_x = [0 10];
best_y(1) = prior_mean(2) - (prior_mean(1)) * slope;
best_y(2) = best_y(1) + 10 * slope;
handles.h_best_fit = plot(best_x, best_y, 'g', 'LineWidth', 2.0);
set(handles.h_best_fit, 'Color', atts.green);
-
+
end
-
+
% Enable the update ensemble button
set(handles.ui_button_create_ensemble, 'Enable', 'On');
set(handles.ui_button_update_ensemble, 'Enable', 'On');
set(handles.ui_edit_observation, 'Enable', 'On');
set(handles.ui_edit_obs_error_sd, 'Enable', 'On');
-
+
% Reset focus to the menu gui window
axes(handles.h_obs_likelihood);
-
+
end
%% -------------------------------------------------------------------------
@@ -434,7 +434,7 @@ function update_ensemble_Callback(~,~)
% Uses the assimilation to update the ensemble according to the
% observation, and then plots it on the main graph on the left, the
% two marginals, and the right observation graph
-
+
axes(handles.h_obs_likelihood);
% Turn off any old points
set(handles.h_update_ens, 'Visible', 'off');
@@ -444,13 +444,13 @@ function update_ensemble_Callback(~,~)
set(handles.h_state_inc, 'Visible', 'off');
set(handles.h_joint_update, 'Visible', 'off');
set(handles.h_joint_inc, 'Visible', 'off');
-
+
ensemble = handles.ens_members;
h_observation = get(handles.ui_edit_observation);
h_obs_error_sd = get(handles.ui_edit_obs_error_sd);
observation = str2double(h_observation.String);
obs_error_sd = str2double(h_obs_error_sd.String);
-
+
%If ensemble is not empty
if (size(ensemble,2) > 0)
switch handles.filter_type
@@ -464,19 +464,19 @@ function update_ensemble_Callback(~,~)
[obs_increments, ~] = ...
obs_increment_rhf(ensemble(1, :), observation, obs_error_sd^2);
end
-
+
% Add on increments to get new ensemble
new_ensemble = ensemble(1, :) + obs_increments;
-
+
%Set the y-coordinate of the ensembles, to be halfway between 0 and
%the bottom of the graph;
y(1:handles.ens_size) = -handles.y_max/10;
-
+
handles.h_update_ens = plot(new_ensemble, y, '*', 'MarkerSize', 16, 'Color', atts.blue);
-
+
% Plot the increments in the state marginal plot
axes(handles.h_obMarginal);
-
+
% Need to sort ensemble to get nice ordering for increments
[~, sort_obs_ind] = sort(ensemble(1, :));
for i = 1:handles.ens_size
@@ -488,16 +488,16 @@ function update_ensemble_Callback(~,~)
plot([ensemble(1, sort_obs_ind(i)), new_ensemble(1, sort_obs_ind(i))], ...
[y(i), y(i)], 'c');
end
-
+
% Figure out the increments for the unobserved variable
-
+
axes(handles.h_unobMarginal);
-
+
covar = cov(ensemble');
state_inc = obs_increments * covar(1, 2) / covar(1, 1);
new_state = ensemble(2, :) + state_inc;
%>@ TODO POSSIBLE IMPROVEMENT ... annotate new marginal mean, sd
-
+
% Now need to sort the state variable ensemble to get nice ordering
[~, sort_ind] = sort(ensemble(2, :));
for i = 1:handles.ens_size
@@ -507,7 +507,7 @@ function update_ensemble_Callback(~,~)
handles.h_state_inc(i) = plot([y(i), y(i)], ...
[ensemble(2, sort_ind(i)), new_state(sort_ind(i))], 'c');
end
-
+
% Plot the updated joint distribution points
axes(handles.h_joint);
for i = 1:handles.ens_size
@@ -516,30 +516,30 @@ function update_ensemble_Callback(~,~)
handles.h_joint_inc(i) = plot([ensemble(1, i), new_ensemble(1, i)], ...
[ensemble(2, i), new_state(i)], 'c');
end
-
+
% Return the focus to the window with pushbuttons
axes(handles.h_obs_likelihood);
-
+
end
end
%% -------------------------------------------------------------------------
function edit_observation_Callback(~, ~)
-
+
% Enable things that an error might have turned off
set(handles.ui_edit_obs_error_sd, 'Enable', 'on');
set(handles.ui_button_create_ensemble, 'Enable', 'on');
-
+
% Only enable the update ensemble pushbutton if an ensemble has been created
if(handles.ens_size > 0)
set(handles.ui_button_update_ensemble, 'Enable', 'on');
end
-
+
% Get the value of the observation
if( isfinite( str2double( get(handles.ui_edit_observation, 'String'))))
observation = str2double(get(handles.ui_edit_observation, 'String'));
-
+
if (observation > 10)
set(handles.ui_edit_observation, 'String', '<10!');
input_error('observation');
@@ -549,7 +549,7 @@ function edit_observation_Callback(~, ~)
input_error('observation');
return;
end
-
+
%Set background color to normal and error text off
set(handles.ui_edit_observation, 'BackgroundColor', 'white');
set(handles.ui_text_error, 'Visible', 'Off');
@@ -562,55 +562,55 @@ function edit_observation_Callback(~, ~)
input_error('observation');
return
end
-
+
% Get the value of the observation error sd
h_obs_error_sd = get(handles.ui_edit_obs_error_sd);
obs_error_sd = str2double(h_obs_error_sd.String);
-
+
% Plot the updated distribution
set(handles.h_marg_obs_plot, 'Visible', 'off');
handles.h_marg_obs_plot = plot_gaussian(observation, obs_error_sd, 1);
set(handles.h_marg_obs_plot, 'Color', atts.red, 'Linestyle', '--', 'Linewidth', 2);
-
+
% Update the observation asterisk
set(handles.h_obs_ast, 'Visible', 'off');
handles.h_obs_ast = plot(observation, 0, 'r*', 'MarkerSize', 16,'LineWidth',2.0);
set(handles.h_obs_ast,'Color',atts.red)
-
+
% Plot the updated obs distribution on the marginal subplot
axes(handles.h_obMarginal);
-
+
% Plot the updated observation in the marginal
set(handles.h_obs_marg, 'Visible', 'off');
handles.h_obs_marg = plot(observation, 0, 'r*', 'MarkerSize', 16,'LineWidth',2.0);
set(handles.h_obs_marg,'Color',atts.red)
-
+
% Replot the update ensemble members so the correlate to new
% observation
update_ensemble_Callback();
-
+
axes(handles.h_obs_likelihood);
-
+
end
%% --------------------------------------------------------------------
function edit_obs_error_sd_Callback(~, ~)
-
+
% Enable things that an error might have turned off
set(handles.ui_edit_observation, 'Enable', 'on')
set(handles.ui_button_create_ensemble, 'Enable', 'on')
-
+
% Only enable the update ensemble pushbutton if an ensemble has been created
if(handles.ens_size > 0)
set(handles.ui_button_update_ensemble, 'Enable', 'on');
end
-
+
% Get the value of the observation error standard deviation
if(isfinite(str2double(get(handles.ui_edit_obs_error_sd, 'String'))) && ...
- str2double(get(handles.ui_edit_obs_error_sd, 'String')) > 0)
+ str2double(get(handles.ui_edit_obs_error_sd, 'String')) > 0)
obs_error_sd = str2double(get(handles.ui_edit_obs_error_sd, 'String'));
-
+
%Set background color to normal and error text off
set(handles.ui_edit_obs_error_sd, 'BackgroundColor', 'white');
set(handles.ui_text_error, 'Visible', 'Off');
@@ -618,55 +618,55 @@ function edit_obs_error_sd_Callback(~, ~)
set(handles.h_best_fit, 'Visible', 'On');
set(handles.h_joint_update, 'Visible', 'On');
set(handles.h_joint_inc, 'Visible', 'On');
-
+
else
set(handles.ui_edit_obs_error_sd, 'String', '?');
input_error('standard deviation');
return
end
-
+
% Get the value of the observation
h_observation = get(handles.ui_edit_observation);
observation = str2double(h_observation.String);
handles.y_max = norm_pdf(observation, observation, obs_error_sd);
-
+
%Give 0.2 cushion to y_max
handles.y_max = handles.y_max + 0.2;
-
+
%Update the axis based on the new y_max
axis([0 10 -handles.y_max/5 handles.y_max]);
-
+
set(gca,'YTickMode','auto')
ticks = get(gca,'YTick');
inds = (ticks >= 0); % Only show ticks for values greater than 0
newticks = ticks(inds);
set(gca,'YTick',newticks)
-
+
% Replot the update ensemble members so the correlate to new obs_sd
update_ensemble_Callback();
-
+
% Plot the updated distribution on the menu plot
-
+
set(handles.h_marg_obs_plot, 'Visible', 'off');
handles.h_marg_obs_plot = plot_gaussian(observation, obs_error_sd, 1);
set(handles.h_marg_obs_plot, 'Color', atts.red, 'Linestyle', '--', 'Linewidth', 2);
-
+
% Update the observation asterisk
-
+
set(handles.h_obs_ast, 'Visible', 'off');
handles.h_obs_ast = plot(observation, 0, 'r*', 'MarkerSize', 16,'LineWidth',2.0);
set(handles.h_obs_ast, 'Color', atts.red)
-
+
% Plot the updated observation in the marginal
axes(handles.h_obMarginal);
-
+
set(handles.h_obs_marg, 'Visible', 'off');
handles.h_obs_marg = plot(observation, 0, 'r*', 'MarkerSize', 16,'LineWidth',2.0);
set(handles.h_obs_marg, 'Color', atts.red)
-
+
% Reset focus to the menu gui window
axes(handles.h_obs_likelihood);
-
+
end
%% ----------------------------------------------------------------------------
@@ -699,12 +699,12 @@ function initialize()
function Assimilation_selection(~, eventdata)
% Function is called whenever a radio button has been selected, it sets
% the global filter variable
-
+
% eventdata refers to the data in the GUI when a radio button in the
% group is changed
-
+
% Set the filter_type string to newest radiobutton Value
-
+
handles.filter_type = get(eventdata.NewValue,'String');
end
@@ -720,14 +720,14 @@ function input_error(mystring)
set(handles.h_joint_inc, 'Visible', 'Off');
set(handles.ui_text_error, 'String' , 'Observation must be a number between 0 and 10');
set(handles.ui_text_error, 'Visible', 'On');
-
+
% Disable other input to guarantee only one error at a time!
set(handles.ui_edit_obs_error_sd, 'Enable', 'off');
set(handles.ui_button_create_ensemble, 'Enable', 'off');
set(handles.ui_button_update_ensemble, 'Enable', 'off');
-
+
otherwise
-
+
set(handles.ui_edit_obs_error_sd, 'BackgroundColor', atts.red);
set(handles.h_ens_member, 'Visible', 'Off');
set(handles.h_best_fit, 'Visible', 'Off');
@@ -735,7 +735,7 @@ function input_error(mystring)
set(handles.h_joint_inc, 'Visible', 'Off');
set(handles.ui_text_error, 'String' , 'Observation Error SD must be a number greater than 0');
set(handles.ui_text_error, 'Visible', 'On');
-
+
% Disable other input to guarantee only one error at a time!
set(handles.ui_edit_observation, 'Enable', 'off')
set(handles.ui_button_create_ensemble, 'Enable', 'off')
diff --git a/documentation/doxygen/README b/documentation/doxygen/README
index c277cf5d74..9903055a49 100644
--- a/documentation/doxygen/README
+++ b/documentation/doxygen/README
@@ -8,7 +8,7 @@ Doxygen automatic documentation generation.
To create html pages from the DART source:
-- You must have doxygen installed somewhere on your search path.
+- You must have 'doxygen' installed somewhere on your search path.
From a terminal window type 'which doxygen'. For Linux systems
in many cases this is already installed. For Macs try one of
the package managers like 'macports'. The GUI download .dmg
@@ -21,21 +21,21 @@ To create html pages from the DART source:
cd into that directory and run the './gendocs' shell script. It will
generate a single index.html main page plus separate documentation pages
for each executable that has a mkmf_xxx and path_names_xxx pair of files
- in the work directory. All documentation will be created and put under
- $DART/documentation/doxygen/model_name.
+ in the work directory. The last output lines of the script will echo
+ where the html files have been created.
To create documentation with diagrams of 'used by' and 'uses', run
- './gendocs -devel' to enable the development diagrams.
+ './gendocs -devel' to enable the development diagrams. This takes
+ longer to run and requires the 'dot' utility.
To use the documentation:
-- Open $DART/documentation/doxygen/model_name/index.html in a browser and click
- on any executable name.
+- Open index.html in a browser and click on any executable name.
- Click on the triangle in front of 'Data Types List' to open the list.
-- There is a second 'Data Types List'. Click on that triangle in
+- There may be a second 'Data Types List'. Click on that triangle in
front of the second 'Data Types List' to open the list. You
should see a list of modules.
@@ -50,6 +50,7 @@ To use the documentation:
- Any text in blue can be clicked on and it will take you to the
reference page for that type, function or subroutine.
+
#
# $URL$
# $Revision$
diff --git a/documentation/doxygen/gendocs b/documentation/doxygen/gendocs
index abff65e6fe..5f49f44700 100755
--- a/documentation/doxygen/gendocs
+++ b/documentation/doxygen/gendocs
@@ -12,7 +12,7 @@
# before using this script, copy it to a model's work directory, along
# with one of the doxygen configuration template files listed below.
-# pick one: the second tries to create diagrams showing the calling
+# pick one: the "devel" version tries to create diagrams showing the calling
# and called relationship between subroutines, but the number and size
# of files it generates is much larger.
@@ -22,14 +22,36 @@ else
template=doxygen-config-template
fi
+# this assumes we are running from some work directory.
+# if you are building from some other named dir, change
+# 'work' to that dir name in the line below.
model=`pwd | sed -e 's;/work;;' -e 's;^.*/;;' `
umodel=`echo $model | tr '[a-z]' '[A-Z]' `
-toppath=`cd ../../../; pwd`
-destdir=$toppath/documentation/doxygen/$model
+# figure out how far down we are in the directory hierarchy.
+if [ -f ../../../CHANGELOG ]; then
+ toppath=`cd ../../../; pwd`
+elif [ -f ../../../../CHANGELOG ]; then
+ toppath=`cd ../../../../; pwd`
+elif [ -f ../../CHANGELOG ]; then
+ toppath=`cd ../../; pwd`
+elif [ -f ../../../../../CHANGELOG ]; then
+ toppath=`cd ../../../../../; pwd`
+else
+ echo cannot find the top level DART directory
+ echo based on the current working directory.
+ exit -1
+fi
+
+# the first option puts all docs under DART/documentation.
+# try putting them into models/bob/documentation instead?
+# (this script needs to be run from a work directory)
+#destdir=$toppath/documentation/doxygen/$model
+destdir=../documentation
+doxygen_dir=$toppath/documentation/doxygen
echo Generating documentation for all executables in the current directory
-echo for the model ${model}. All html files will be located under the directory
+echo for ${model}. All html files will be located under the directory
echo $destdir
if [ ! -d $destdir ]; then mkdir -p $destdir; fi
@@ -50,7 +72,7 @@ do
# flist -> multiline path_names_xx content with \ after every
# line except the last one
- sed -e "s;THISDESTDIR;${destdir};" -e "s/THISEXECUTABLE/$exename/" -e "s/THISMODEL/$model/" -e "/^INPUT /r flist" $template > doxygen-$exename
+ sed -e "s;THISDESTDIR;${destdir};" -e "s/THISEXECUTABLE/$exename/" -e "s/THISMODEL/$model/" -e "/^INPUT /r flist" $doxygen_dir/$template > doxygen-$exename
doxygen doxygen-$exename
diff --git a/models/9var/model_mod.f90 b/models/9var/model_mod.f90
index be65505061..3fc4dd6969 100644
--- a/models/9var/model_mod.f90
+++ b/models/9var/model_mod.f90
@@ -446,7 +446,7 @@ subroutine nc_write_model_atts(ncid, domain_id)
integer, intent(in) :: ncid ! netCDF file identifier
integer, intent(in) :: domain_id
-integer :: msize, i
+integer :: msize
! other parts of the dart system will write the state into the file
! so this routine just needs to write any model-specific
diff --git a/models/9var/work/quickbuild.csh b/models/9var/work/quickbuild.csh
index 27b7ccf98d..3f9e3a7b3e 100755
--- a/models/9var/work/quickbuild.csh
+++ b/models/9var/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -52,7 +52,7 @@ if ( $?CODE_DEBUG ) then
set cdebug = $CODE_DEBUG
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,8 +68,8 @@ foreach DATAFILE ( *.cdl )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $MODEL data file $n named $OUTNAME"
-
+ echo "constructing $MODEL data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
@@ -97,7 +97,7 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$MODEL build number $n is $PROG"
+ echo "$MODEL build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
@@ -113,15 +113,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -130,10 +130,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -143,21 +143,21 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$MODEL MPI build number $n is $PROG"
+ echo "$MODEL MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/LMDZ/work/input.nml b/models/LMDZ/work/input.nml
index 867cf014e0..2bbbf9ccbc 100644
--- a/models/LMDZ/work/input.nml
+++ b/models/LMDZ/work/input.nml
@@ -158,8 +158,8 @@
output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90',
input_files = '../../../observations/forward_operators/obs_def_gps_mod.f90',
'../../../observations/forward_operators/obs_def_altimeter_mod.f90',
- '../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90'
- '../../../observations/forward_operators/obs_def_AIRS_mod.f90'
+ '../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90',
+ '../../../observations/forward_operators/obs_def_AIRS_mod.f90',
'../../../observations/forward_operators/obs_def_insat_mod.f90'
/
diff --git a/models/LMDZ/work/quickbuild.csh b/models/LMDZ/work/quickbuild.csh
index 7138d59922..c6040f040b 100755
--- a/models/LMDZ/work/quickbuild.csh
+++ b/models/LMDZ/work/quickbuild.csh
@@ -7,113 +7,184 @@
# DART $Id$
#----------------------------------------------------------------------
-# compile all programs in the current directory with a mkmf_xxx file.
+# compile all programs in the current directory that have a mkmf_xxx file.
#
# usage: [ -mpi | -nompi ]
+#
+#
+# environment variable options:
+# before running this script, do:
+# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
+# and these files are required by most debuggers.
+#
+# to pass any flags to the 'make' program, set DART_MFLAGS in your environment.
+# e.g. to build faster by running 4 (or your choice) compiles at once:
+# "setenv DART_MFLAGS '-j 4' " (csh) or "export DART_MFLAGS='-j 4' " (bash)
+#----------------------------------------------------------------------
+
+# this model name:
+set BUILDING = "LMDZ"
+
+# programs which have the option of building with MPI:
+set MPI_TARGETS = "filter perfect_model_obs model_mod_check closest_member_tool"
+
+# set default (override with -mpi or -nompi):
+# 0 = build without MPI, 1 = build with MPI
+set with_mpi = 0
+
+# ---------------
+# shouldn't have to modify this script below here.
+
+if ( $#argv >= 1 ) then
+ if ( "$1" == "-mpi" ) then
+ set with_mpi = 1
+ else if ( "$1" == "-nompi" ) then
+ set with_mpi = 0
+ else
+ echo usage: $0 '[ -mpi | -nompi ]'
+ exit 0
+ endif
+endif
+
+set preprocess_done = 0
+set tdebug = 0
+set cdebug = 0
+set mflags = ''
+
+# environment vars this script looks for
+if ( $?CODE_DEBUG ) then
+ set cdebug = $CODE_DEBUG
+endif
+if ( $?DART_TEST ) then
+ set tdebug = $DART_TEST
+endif
+if ( $?DART_MFLAGS ) then
+ set mflags = "$DART_MFLAGS"
+endif
+
+
+\rm -f *.o *.mod Makefile .cppdefs
+
#----------------------------------------------------------------------
-# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
-# so this MUST be run first.
+# Build any NetCDF files from .cdl files
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
-\rm -f ../../../obs_def/obs_def_mod.f90
-\rm -f ../../../obs_kind/obs_kind_mod.f90
+@ n = 0
+
+@ has_cdl = `ls *.cdl | wc -l` >& /dev/null
-set MODEL = "LMDZ"
+if ( $has_cdl > 0 ) then
+ foreach DATAFILE ( *.cdl )
-@ n = 1
+ set OUTNAME = `basename $DATAFILE .cdl`.nc
-echo
-echo
-echo "---------------------------------------------------------------"
-echo "${MODEL} build number ${n} is preprocess"
+ if ( ! -f $OUTNAME ) then
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
+ ncgen -o $OUTNAME $DATAFILE || exit $n
+ endif
-csh mkmf_preprocess
-make || exit $n
+ end
+endif
-./preprocess || exit 99
#----------------------------------------------------------------------
# Build all the single-threaded targets
#----------------------------------------------------------------------
-foreach TARGET ( mkmf_* )
-
- set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
-
- switch ( $TARGET )
- case mkmf_preprocess:
- breaksw
- default:
- @ n = $n + 1
- echo
- echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
- \rm -f ${PROG}
- csh $TARGET || exit $n
- make || exit $n
- breaksw
- endsw
+@ n = 0
+
+foreach TARGET ( mkmf_preprocess mkmf_* )
+
+ set PROG = `echo $TARGET | sed -e 's/mkmf_//'`
+
+ if ( $PROG == "preprocess" && $preprocess_done ) goto skip
+
+ if ( $with_mpi ) then
+ foreach i ( $MPI_TARGETS )
+ if ( $PROG == $i ) goto skip
+ end
+ endif
+
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "$BUILDING build number $n is $PROG"
+ \rm -f $PROG
+ csh $TARGET || exit $n
+ make $mflags || exit $n
+
+ if ( $tdebug ) then
+ echo 'removing all files between builds'
+ \rm -f *.o *.mod Makefile .cppdefs
+ endif
+
+ # preprocess creates module files that are required by
+ # the rest of the executables, so it must be run in addition
+ # to being built.
+ if ( $PROG == "preprocess" ) then
+ ./preprocess || exit $n
+ set preprocess_done = 1
+ endif
+
+skip:
end
-\rm -f *.o *.mod input.nml*_default
+if ( $cdebug ) then
+ echo 'preserving .o and .mod files for debugging'
+else
+ \rm -f *.o *.mod Makefile .cppdefs
+endif
+
+\rm -f input.nml*_default
+
+echo "Success: All single task DART programs compiled."
-if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
-else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
- echo "Script is exiting without building the MPI version of the DART programs."
- exit 0
else
- echo ""
- echo "Success: All DART programs compiled."
- echo "Script is exiting before building the MPI version of the DART programs."
- echo "Run the quickbuild.csh script with a -mpi argument or"
- echo "edit the quickbuild.csh script and remove the exit line"
- echo "to compile with MPI to run in parallel on multiple cpus."
- echo ""
+ echo "Script is exiting after building the serial versions of the DART programs."
exit 0
endif
+\rm -f *.o *.mod Makefile .cppdefs
+
#----------------------------------------------------------------------
-# to enable an MPI parallel version of filter for this model,
-# call this script with the -mpi argument, or if you are going to build
-# with MPI all the time, remove or comment out the entire section above.
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
-\rm -f filter wakeup_filter
+foreach PROG ( $MPI_TARGETS )
-foreach TARGET ( mkmf_* )
+ set TARGET = `echo $PROG | sed -e 's/^/mkmf_/'`
- set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "$BUILDING with MPI build number $n is $PROG"
+ \rm -f $PROG
+ csh $TARGET -mpi || exit $n
+ make $mflags || exit $n
+
+ if ( $tdebug ) then
+ echo 'removing all files between builds'
+ \rm -f *.o *.mod Makefile .cppdefs
+ endif
- echo TARGET = $TARGET
- switch ( $TARGET )
- case mkmf_*filter:
- @ n = $n + 1
- echo
- echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
- \rm -f ${PROG}
- csh $TARGET -mpi || exit $n
- make
- if ($status != 0) then
- echo
- echo "If this died in mpi_utilities_mod, see code comment"
- echo "in mpi_utilities_mod.f90 starting with 'BUILD TIP' "
- echo
- exit $n
- endif
- breaksw
- default:
- breaksw
- endsw
end
-\rm -f *.o *.mod input.nml*_default
+if ( $cdebug ) then
+ echo 'preserving .o and .mod files for debugging'
+else
+ \rm -f *.o *.mod Makefile .cppdefs
+endif
+\rm -f input.nml*_default
+
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/MITgcm_annulus/work/quickbuild.csh b/models/MITgcm_annulus/work/quickbuild.csh
index 34c5c6c999..19d5492c7a 100755
--- a/models/MITgcm_annulus/work/quickbuild.csh
+++ b/models/MITgcm_annulus/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -58,13 +58,13 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
@@ -79,7 +79,7 @@ else
endif
#----------------------------------------------------------------------
-# to enable an MPI parallel version of filter for this model,
+# to enable an MPI parallel version of filter for this model,
# call this script with the -mpi argument, or if you are going to build
# with MPI all the time, remove or comment out the entire section above.
#----------------------------------------------------------------------
@@ -108,7 +108,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90
index a9c451e18c..ab92b17576 100644
--- a/models/MITgcm_ocean/model_mod.f90
+++ b/models/MITgcm_ocean/model_mod.f90
@@ -28,6 +28,7 @@ module model_mod
use mpi_utilities_mod, only: my_task_id
use random_seq_mod, only : random_seq_type, init_random_seq, random_gaussian
+use netcdf
implicit none
private
@@ -62,10 +63,10 @@ module model_mod
DARTtime_to_timestepindex
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
character(len=129) :: msgstring
logical, save :: module_initialized = .false.
diff --git a/models/MITgcm_ocean/work/quickbuild.csh b/models/MITgcm_ocean/work/quickbuild.csh
index eb7a7a36c2..c956814e35 100755
--- a/models/MITgcm_ocean/work/quickbuild.csh
+++ b/models/MITgcm_ocean/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -59,15 +59,15 @@ foreach TARGET ( mkmf_* )
end
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -76,16 +76,16 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
-\rm -f *.o *.mod filter wakeup_filter
+\rm -f *.o *.mod filter wakeup_filter Makefile .cppdefs
@ n = $n + 1
echo
@@ -109,7 +109,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/NAAPS/work/quickbuild.csh b/models/NAAPS/work/quickbuild.csh
index 49e490dfe0..1dff2a38e9 100755
--- a/models/NAAPS/work/quickbuild.csh
+++ b/models/NAAPS/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -59,15 +59,15 @@ foreach TARGET ( mkmf_* )
end
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -76,16 +76,16 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
-\rm -f *.o *.mod filter wakeup_filter
+\rm -f *.o *.mod filter wakeup_filter Makefile .cppdefs
@ n = $n + 1
echo
@@ -109,7 +109,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/NCOMMAS/work/quickbuild.csh b/models/NCOMMAS/work/quickbuild.csh
index f4d3fae2df..fde6a151c9 100755
--- a/models/NCOMMAS/work/quickbuild.csh
+++ b/models/NCOMMAS/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -59,15 +59,15 @@ foreach TARGET ( mkmf_* )
end
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -76,16 +76,16 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
-\rm -f *.o *.mod filter wakeup_filter
+\rm -f *.o *.mod filter wakeup_filter Makefile .cppdefs
@ n = $n + 1
echo
@@ -109,7 +109,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/POP/dart_pop_mod.f90 b/models/POP/dart_pop_mod.f90
index 9fb72ec023..0fc2688043 100644
--- a/models/POP/dart_pop_mod.f90
+++ b/models/POP/dart_pop_mod.f90
@@ -11,11 +11,13 @@ module dart_pop_mod
set_calendar_type, get_calendar_string, &
print_date, print_time, operator(==), operator(-)
use utilities_mod, only : get_unit, open_file, close_file, file_exist, &
- register_module, error_handler, nc_check, &
+ register_module, error_handler, &
find_namelist_in_file, check_namelist_read, &
E_ERR, E_WARN, E_MSG, find_textfile_dims, &
logfileunit
+use netcdf_utilities_mod, only : nc_check
+
use typesizes
use netcdf
diff --git a/models/POP/model_mod.f90 b/models/POP/model_mod.f90
index 17a10882d9..a64ef00c21 100644
--- a/models/POP/model_mod.f90
+++ b/models/POP/model_mod.f90
@@ -1887,6 +1887,7 @@ subroutine nc_write_model_atts( ncid, domain_id )
if ( .not. module_initialized ) call static_init_model
! Write Global Attributes
+
call nc_begin_define_mode(ncid)
call nc_add_global_creation_time(ncid)
@@ -1903,7 +1904,6 @@ subroutine nc_write_model_atts( ncid, domain_id )
call output_grid(ncid)
endif
-! Flush the buffer and leave netCDF file open
call nc_synchronize_file(ncid)
end subroutine nc_write_model_atts
diff --git a/models/POP/work/input.nml b/models/POP/work/input.nml
index d6585339a2..21a48651de 100644
--- a/models/POP/work/input.nml
+++ b/models/POP/work/input.nml
@@ -25,12 +25,13 @@
print_every_nth_obs = -1
output_forward_op_errors = .false.
silence = .false.
+ distributed_state = .true.
/
&filter_nml
- async = 4
+ async = 0
adv_ens_command = 'no_CESM_advance_script'
- ens_size = 23
+ ens_size = 3
obs_sequence_in_name = 'obs_seq.out'
obs_sequence_out_name = 'obs_seq.final'
input_state_file_list = "restarts_in.txt"
@@ -41,10 +42,12 @@
first_obs_seconds = -1
last_obs_days = -1
last_obs_seconds = -1
- num_output_state_members = 10,
- num_output_obs_members = 23
+ num_output_state_members = 3,
+ num_output_obs_members = 3
output_interval = 1
num_groups = 1
+ distributed_state = .true.
+ compute_posterior = .true.
output_forward_op_errors = .false.
output_timestamps = .false.
trace_execution = .false.
@@ -69,8 +72,12 @@
/
+# "buffer_state_io" must be true for 1/10th degree pop.
+# it can be false for smaller runs.
+
&state_vector_io_nml
- buffer_state_io = .false.
+ buffer_state_io = .true.
+ single_precision_output = .false.
/
@@ -83,6 +90,11 @@
/
# cutoff of 0.03 (radians) is about 200km
+#
+# "distribute_mean" must be true for 1/10th degree pop. it runs
+# slower than setting it false, but it won't run otherwise.
+# if running a smaller pop case, use false to run faster.
+#
&assim_tools_nml
filter_kind = 1
cutoff = 0.20
@@ -93,6 +105,7 @@
output_localization_diagnostics = .false.
localization_diagnostics_file = 'localization_diagnostics'
print_every_nth_obs = 0
+ distribute_mean = .true.
/
&ensemble_manager_nml
diff --git a/models/POP/work/quickbuild.csh b/models/POP/work/quickbuild.csh
index a133cd7e8e..cd22b11301 100755
--- a/models/POP/work/quickbuild.csh
+++ b/models/POP/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 1
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -59,7 +59,7 @@ endif
# Build all the single-threaded targets
#----------------------------------------------------------------------
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
foreach TARGET ( mkmf_preprocess mkmf_* )
@@ -76,7 +76,7 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -92,15 +92,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -110,15 +110,15 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit here.
#----------------------------------------------------------------------
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -128,21 +128,21 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET -mpi || exit $n
make || exit $n
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/ROMS/model_mod.f90 b/models/ROMS/model_mod.f90
index 953910b1c5..ff0637c860 100644
--- a/models/ROMS/model_mod.f90
+++ b/models/ROMS/model_mod.f90
@@ -148,14 +148,6 @@ module model_mod
integer :: debug = 0 ! turn up for more and more debug messages
character(len=256) :: roms_filename = 'roms_input.nc'
-namelist /model_nml/ &
- assimilation_period_days, &
- assimilation_period_seconds, &
- roms_filename, &
- vert_localization_coord, &
- debug, &
- variables
-
! DART contents are specified in the input.nml:&model_nml namelist.
!>@todo NF90_MAX_NAME is 256 ... this makes the namelist output unreadable
integer, parameter :: MAX_STATE_VARIABLES = 8
@@ -166,6 +158,14 @@ module model_mod
integer :: kind_list(MAX_STATE_VARIABLES) = MISSING_I
real(r8) :: clamp_vals(MAX_STATE_VARIABLES,2) = MISSING_R8
+namelist /model_nml/ &
+ assimilation_period_days, &
+ assimilation_period_seconds, &
+ roms_filename, &
+ vert_localization_coord, &
+ debug, &
+ variables
+
integer :: nfields ! This is the number of variables in the DART state vector.
integer :: domain_id ! global variable for state_structure_mod routines
diff --git a/models/ROMS/test_grid.f90 b/models/ROMS/test_grid.f90
deleted file mode 100644
index 96a6e9d717..0000000000
--- a/models/ROMS/test_grid.f90
+++ /dev/null
@@ -1,335 +0,0 @@
-! 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 test_grid
-
-!----------------------------------------------------------------------
-! purpose: test routines. this version for models with oned locations.
-!----------------------------------------------------------------------
-
-use types_mod, only : r8, i8, missing_r8, metadatalength
-
-use utilities_mod, only : register_module, error_handler, E_MSG, E_ERR, &
- initialize_utilities, finalize_utilities, &
- find_namelist_in_file, check_namelist_read, &
- nc_check, E_MSG, open_file, close_file, do_output
-
-use mpi_utilities_mod, only : initialize_mpi_utilities, finalize_mpi_utilities
-
-use location_mod, only : location_type, set_location, write_location, &
- get_dist, get_location
-
-use obs_kind_mod, only : get_index_for_quantity, get_name_for_quantity
-
-
-use obs_sequence_mod, only : static_init_obs_sequence
-
-use assim_model_mod, only : static_init_assim_model
-
-use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
- set_time, print_time, print_date, operator(-)
-
-use ensemble_manager_mod, only : init_ensemble_manager, ensemble_type
-
-use state_vector_io_mod, only : state_vector_io_init, &
- read_state, write_state
-
-use filter_mod, only : filter_set_initial_time
-
-use io_filenames_mod, only : io_filenames_init, file_info_type, get_restart_filename, &
- stage_metadata_type, get_stage_metadata
-
-use model_mod, only : static_init_model, get_model_size, &
- get_state_meta_data, &
- model_interpolate
-
-use distributed_state_mod, only : create_state_window, free_state_window, &
- create_mean_window, free_mean_window
-
-use test_roms_interpolate_mod, only : test_interpolate_single, test_interpolate_range
-
-use netcdf
-
-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$"
-
-!------------------------------------------------------------------
-! The namelist variables
-!------------------------------------------------------------------
-
-integer(i8) :: x_ind = -1
-real(r8), dimension(3) :: loc_of_interest = -1.0_r8
-character(len=metadatalength) :: kind_of_interest = 'ANY'
-character(len=metadatalength) :: interp_test_vertcoord = 'VERTISHEIGHT'
-logical :: verbose = .FALSE.
-integer :: test1thru = 1
-real(r8) :: interp_test_di = 10.0
-real(r8) :: interp_test_dj = 10.0
-real(r8) :: interp_test_dk = 10.0
-real(r8), dimension(2) :: interp_test_jrange = (/ 0.0, 120.0 /)
-real(r8), dimension(2) :: interp_test_irange = (/ 0.0, 120.0 /)
-real(r8), dimension(2) :: interp_test_krange = (/ 0.0, 100.0 /)
-character(len = 129) :: restart_in_file_name = 'input'
-character(len = 129) :: restart_out_file_name = 'output'
-
-namelist /test_grid_nml/ x_ind, &
- loc_of_interest, kind_of_interest, &
- interp_test_di, interp_test_irange, &
- interp_test_dj, interp_test_jrange, &
- interp_test_dk, interp_test_krange, &
- interp_test_vertcoord, &
- verbose, test1thru, &
- restart_in_file_name, restart_out_file_name
-
-! io variables
-integer :: iunit, io
-integer :: ios_out
-type(file_info_type) :: input_file_info, output_file_info
-type(stage_metadata_type) :: stage_info
-logical :: read_time_from_file = .true.
-
-
-! model state variables
-type(ensemble_type) :: ens_handle
-
-type(time_type) :: time1, model_time
-integer :: mykindindex
-integer(i8) :: model_size
-real(r8) :: interp_vals
-
-! misc. variables
-integer :: dom, mem, num_ens, num_failed
-
-! error handler strings
-character(len=512) :: string1
-
-!----------------------------------------------------------------------
-! This portion checks the geometry information.
-!----------------------------------------------------------------------
-
-call initialize_modules_used()
-
-call find_namelist_in_file("input.nml", "test_grid_nml", iunit)
-read(iunit, nml = test_grid_nml, iostat = io)
-call check_namelist_read(iunit, io, "test_grid_nml")
-
-call print_test_message('RUNNING TEST 1', &
- 'Reading the namelist and running static_init_model', &
- 'calling get_model_size()')
-
-! only running for single member and ROMS only has one domain
-num_ens = 1
-mem = 1
-dom = 1
-
-call static_init_assim_model()
-
-model_size = get_model_size()
-
-if ( do_output() ) then
- write(*,*)
- write(*,'(''state vector has length'',i10)') model_size
- write(*,*)
-endif
-
-call print_test_message('FINISHED TEST 1')
-
-if ( test1thru == 1 ) call exit(0)
-
-
-call print_test_message('RUNNING TEST 2', &
- 'Read and write trivial restart file')
-
-call set_calendar_type(GREGORIAN)
-
-model_time = set_time(21600, 149446) ! 06Z 4 March 2010
-
-! Set up the ensemble storage and read in the restart file
-call init_ensemble_manager(ens_handle, num_ens, model_size)
-
-! Reading netcdf restart file:
-call io_filenames_init(input_file_info, num_ens, .false., .false., root_name='input')
-call io_filenames_init(output_file_info, num_ens, .false.,.false., root_name='output')
-
-
-!----------------------------------------------------------------------
-! Open a test netcdf initial conditions file.
-!----------------------------------------------------------------------
-stage_info = get_stage_metadata(input_file_info)
-if ( do_output() ) write(*,*) 'Reading File : ', trim( get_restart_filename(stage_info, mem, domain=dom) )
-call read_state(ens_handle, input_file_info, read_time_from_file, time1)
-model_time = time1
-
-stage_info = get_stage_metadata(output_file_info)
-if ( do_output() ) write(*,*) 'Writing File : ', trim( get_restart_filename(stage_info, mem, domain=dom) )
-call write_state(ens_handle, output_file_info)
-
-write(*,*)
-call print_date( model_time,' test_grid:model date')
-call print_time( model_time,' test_grid:model time')
-
-call print_test_message('FINISHED TEST 2')
-
-if ( test1thru == 2 ) call exit(0)
-
-!----------------------------------------------------------------------
-! Check the meta data
-!----------------------------------------------------------------------
-
-call print_test_message('RUNNING TEST 3', &
- 'Testing get_state_meta_data')
-
-if ( x_ind > 0 .and. x_ind <= model_size ) then
- call check_meta_data( x_ind )
-else
- if ( do_output() ) write(*,*) "x_ind = ", x_ind, " not in valid range of model 0-", model_size
-endif
-
-call print_test_message('FINISHED TEST 3')
-
-if ( test1thru == 3 ) call exit(0)
-
-!----------------------------------------------------------------------
-! Check the interpolation - print initially to STDOUT
-!----------------------------------------------------------------------
-
-call print_test_message('RUNNING TEST 4', &
- 'Testing loc_of_interest for model_interpolate')
-
-call create_state_window(ens_handle)
-
-mykindindex = get_index_for_quantity(kind_of_interest)
-
-if ( do_output() ) write(*,*) "interpolating at di,dj,dk :", &
- loc_of_interest(1), &
- loc_of_interest(2), &
- loc_of_interest(3)
-
-num_failed = test_interpolate_single( ens_handle, &
- interp_test_vertcoord, &
- loc_of_interest(1), &
- loc_of_interest(2), &
- loc_of_interest(3), &
- mykindindex, &
- interp_vals, &
- ios_out )
-print*, ' '
-
-call print_test_message('FINISHED TEST 4')
-
-if ( test1thru == 4 ) call exit(0)
-
-call print_test_message('RUNNING TEST 5', &
- 'Testing range of data for model_interpolate')
-
-num_failed = test_interpolate_range( ens_handle, &
- interp_test_dj, &
- interp_test_di, &
- interp_test_dk, &
- interp_test_vertcoord, &
- interp_test_irange, &
- interp_test_jrange, &
- interp_test_krange, &
- mykindindex, &
- verbose )
-
-call print_test_message('FINISHED TEST 5')
-
-! finalize test_grid
-call error_handler(E_MSG,'full_test_grid','Finished successfully.',source,revision,revdate)
-call finalize_mpi_utilities()
-
-!----------------------------------------------------------------------
-
-contains
-
-!----------------------------------------------------------------------
-subroutine check_meta_data( iloc )
-
-integer(i8), intent(in) :: iloc
-type(location_type) :: loc
-integer :: var_kind
-
-if ( do_output() ) then
- write(*,*)
- write(*,*)'Checking metadata routines.'
- write(*,*)
-endif
-
-call get_state_meta_data(iloc, loc, var_kind)
-
-call write_location(42, loc, fform='formatted', charstring=string1)
-
-if ( do_output() ) then
- write(*,*)
- write(*,*)' indx ',iloc,' is type ',var_kind, 'name : ', get_name_for_quantity(var_kind)
- write(*,*)' ', trim(string1)
-endif
-
-end subroutine check_meta_data
-
-!----------------------------------------------------------------------
-
-subroutine initialize_modules_used()
-
-! Standard initialization (mpi not needed to use ensemble manager
-! since we are enforcing that this run as a single task).
-call initialize_mpi_utilities('test_grid')
-
-! Initialize modules used that require it
-call register_module(source,revision,revdate)
-
-! Initialize modules used that require it
-call static_init_obs_sequence()
-
-call state_vector_io_init()
-
-end subroutine initialize_modules_used
-
-!----------------------------------------------------------------------
-
-subroutine print_test_message(test_msg, msg1, msg2, msg3)
-
-character(len=*), intent(in) :: test_msg
-character(len=*), intent(in), optional :: msg1
-character(len=*), intent(in), optional :: msg2
-character(len=*), intent(in), optional :: msg3
-
-character(len=64) :: msg_string
-character(len=64) :: msg_close
-
-if ( do_output() ) then
- write(msg_string,*) '******************** ', trim(test_msg), ' *************************'
- write(msg_close ,*) '*************************************************************'
-
- write(*,*)
- write(*,*) trim(msg_string)
- if ( present(msg1) ) write(*,*) ' ', trim(msg1)
- if ( present(msg2) ) write(*,*) ' --', trim(msg2)
- if ( present(msg3) ) write(*,*) ' --', trim(msg3)
- if ( present(msg1) ) write(*,*) trim(msg_close)
-
- write(*,*)
-endif
-
-end subroutine print_test_message
-
-
-!----------------------------------------------------------------------
-
-
-end program test_grid
-
-!
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
diff --git a/models/ROMS/test_grid.nml b/models/ROMS/test_grid.nml
deleted file mode 100644
index db693fdcc4..0000000000
--- a/models/ROMS/test_grid.nml
+++ /dev/null
@@ -1,18 +0,0 @@
-
-&test_grid_nml
- x_ind = -1
- loc_of_interest = -1.0
- kind_of_interest = 'ANY'
- interp_test_vertcoord = 'VERTISHEIGHT'
- verbose = .FALSE.
- test1thru = 1
- interp_test_di = 10.0
- interp_test_dj = 10.0
- interp_test_dk = 10.0
- interp_test_jrange = 0.0, 120.0
- interp_test_irange = 0.0, 120.0
- interp_test_krange = 0.0, 100.0
- restart_in_file_name = 'input'
- restart_out_file_name = 'output'
- /
-
diff --git a/models/ROMS/test_roms_interpolate.f90 b/models/ROMS/test_roms_interpolate.f90
index 4f18a9a8d0..132542e2c8 100644
--- a/models/ROMS/test_roms_interpolate.f90
+++ b/models/ROMS/test_roms_interpolate.f90
@@ -15,7 +15,9 @@ module test_roms_interpolate_mod
use utilities_mod, only : register_module, error_handler, E_MSG, E_ERR, &
initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
- nc_check, E_MSG, open_file, close_file, do_output
+ E_MSG, open_file, close_file, do_output
+
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : location_type, set_location, write_location, &
get_dist, VERTISUNDEF, VERTISSURFACE, &
diff --git a/models/ROMS/work/input.nml b/models/ROMS/work/input.nml
index f92033c5dc..342e166e95 100644
--- a/models/ROMS/work/input.nml
+++ b/models/ROMS/work/input.nml
@@ -45,6 +45,8 @@
num_output_obs_members = 3
output_interval = 1
num_groups = 1
+ distributed_state = .true.
+ compute_posterior = .true.
output_forward_op_errors = .false.
output_timestamps = .false.
trace_execution = .true.
diff --git a/models/ROMS/work/quickbuild.csh b/models/ROMS/work/quickbuild.csh
index 7daf1005dc..71364674bf 100755
--- a/models/ROMS/work/quickbuild.csh
+++ b/models/ROMS/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 1
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/am2/work/quickbuild.csh b/models/am2/work/quickbuild.csh
index 81d45b43dd..fad74e37a3 100755
--- a/models/am2/work/quickbuild.csh
+++ b/models/am2/work/quickbuild.csh
@@ -8,29 +8,29 @@
#
# Script to manage the compilation of all components for this model;
# executes a known "perfect model" experiment using an existing
-# observation sequence file (obs_seq.in) and initial conditions appropriate
+# observation sequence file (obs_seq.in) and initial conditions appropriate
# for both 'perfect_model_obs' (perfect_ics) and 'filter' (filter_ics).
# There are enough initial conditions for 80 ensemble members in filter.
# Use ens_size = 81 and it WILL bomb. Guaranteed.
# The 'input.nml' file controls all facets of this execution.
#
# 'create_obs_sequence' and 'create_fixed_network_sequence' were used to
-# create the observation sequence file 'obs_seq.in' - this defines
-# what/where/when we want observations. This script does not run these
-# programs - intentionally.
+# create the observation sequence file 'obs_seq.in' - this defines
+# what/where/when we want observations. This script does not run these
+# programs - intentionally.
#
-# 'perfect_model_obs' results in a true_state.nc file that contains
+# 'perfect_model_obs' results in a true_state.nc file that contains
# the true state, and obs_seq.out - a file that contains the "observations"
# that will be assimilated by 'filter'.
#
-# 'filter' results in three files (depending on values in 'stages_to_write'):
-# preassim.nc - all ensemble members prior to assimilation
-# i.e. the (potentially inflated) forecast,
-# analysis.nc - all ensemble members after the assimilation (i.e. the analysis), and
+# 'filter' results in three files (depending on values in 'stages_to_write'):
+# preassim.nc - all ensemble members prior to assimilation
+# i.e. the (potentially inflated) forecast,
+# analysis.nc - all ensemble members after the assimilation (i.e. the analysis), and
# obs_seq.final - the ensemble members' estimates of the observations
#
-# Once 'perfect_model_obs' has advanced the model and harvested the
-# observations for the assimilation experiment, 'filter' may be run
+# Once 'perfect_model_obs' has advanced the model and harvested the
+# observations for the assimilation experiment, 'filter' may be run
# over and over by simply changing the namelist parameters in input.nml.
#
# The result of each assimilation can be explored in model-space with
@@ -41,12 +41,12 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -79,7 +79,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -87,18 +87,18 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -107,13 +107,13 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
\rm -f filter wakeup_filter
@@ -140,7 +140,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/bgrid_solo/fms_src/shared/horiz_interp/horiz_interp.f90 b/models/bgrid_solo/fms_src/shared/horiz_interp/horiz_interp.f90
index e38b7fed51..df1d1a8a5b 100644
--- a/models/bgrid_solo/fms_src/shared/horiz_interp/horiz_interp.f90
+++ b/models/bgrid_solo/fms_src/shared/horiz_interp/horiz_interp.f90
@@ -1566,7 +1566,7 @@ function indp (value, array, ia)
' when searching for nearest element to value=',value
write (stdout,*) ' array(i) < array(i-1) for i=',i
write (stdout,*) ' array(i) for i=1..ia follows:'
- call abort()
+ call exit_all()
endif
enddo
if (value .lt. array(1) .or. value .gt. array(ia)) then
diff --git a/models/bgrid_solo/work/filter_input_list.txt b/models/bgrid_solo/work/filter_input_list.txt
deleted file mode 100644
index 768142a783..0000000000
--- a/models/bgrid_solo/work/filter_input_list.txt
+++ /dev/null
@@ -1 +0,0 @@
-filter_input.nc
diff --git a/models/bgrid_solo/work/filter_output_list.txt b/models/bgrid_solo/work/filter_output_list.txt
deleted file mode 100644
index 55ff52c45f..0000000000
--- a/models/bgrid_solo/work/filter_output_list.txt
+++ /dev/null
@@ -1 +0,0 @@
-filter_output.nc
diff --git a/models/bgrid_solo/work/input.nml b/models/bgrid_solo/work/input.nml
index 8a80b4f43e..ad794b9976 100644
--- a/models/bgrid_solo/work/input.nml
+++ b/models/bgrid_solo/work/input.nml
@@ -29,14 +29,14 @@
&filter_nml
single_file_in = .true.,
- input_state_files = ''
- input_state_file_list = 'filter_input_list.txt'
+ input_state_files = 'filter_input.nc'
+ input_state_file_list = ''
stages_to_write = 'preassim', 'analysis', 'output'
single_file_out = .true.,
- output_state_files = ''
- output_state_file_list = 'filter_output_list.txt'
+ output_state_files = 'filter_output.nc'
+ output_state_file_list = ''
output_interval = 1,
output_members = .true.
num_output_state_members = 20,
diff --git a/models/bgrid_solo/work/quickbuild.csh b/models/bgrid_solo/work/quickbuild.csh
index 0c1688c89b..1a96239efc 100755
--- a/models/bgrid_solo/work/quickbuild.csh
+++ b/models/bgrid_solo/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -24,7 +24,7 @@
set BUILDING = "bgrid_solo"
# programs which have the option of building with MPI:
-set MPI_TARGETS = "filter perfect_model_obs"
+set MPI_TARGETS = "filter perfect_model_obs model_mod_check"
# set default (override with -mpi or -nompi):
# 0 = build without MPI, 1 = build with MPI
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/bgrid_solo/work/restart_in.txt b/models/bgrid_solo/work/restart_in.txt
deleted file mode 100644
index 768142a783..0000000000
--- a/models/bgrid_solo/work/restart_in.txt
+++ /dev/null
@@ -1 +0,0 @@
-filter_input.nc
diff --git a/models/bgrid_solo/work/restart_out.txt b/models/bgrid_solo/work/restart_out.txt
deleted file mode 100644
index 55ff52c45f..0000000000
--- a/models/bgrid_solo/work/restart_out.txt
+++ /dev/null
@@ -1 +0,0 @@
-filter_output.nc
diff --git a/models/cam-fv/bisection_subr.f90 b/models/cam-fv/bisection_subr.f90
new file mode 100644
index 0000000000..e1527e8fc0
--- /dev/null
+++ b/models/cam-fv/bisection_subr.f90
@@ -0,0 +1,139 @@
+!> given an array of sorted values and a value to find, return the smaller
+!> and higher index values, and the fraction across.
+!>
+!> fraction_across = 0.0 is the 100% the smaller value index,
+!> 1.0 is the 100% the larger value index.
+!>
+!> if the array values are inverted (e.g. index 1 is the largest value),
+!> set inverted = .true. the interpretation in the calling code for
+!> smaller index, larger index and fraction_across remain the same as the default case.
+!>
+!> if the fraction_across the enclosing level should be computed using a
+!> log scale, set log_scale = .true.
+!>
+!> my_status values:
+!> 0 = good return
+!> -1 = value_to_find is below smallest value
+!> 1 = value_to_find is above largest value
+!> 96 = cannot use log scale with negative data values
+!> 97 = array only has a single value
+!> 98 = interval has 0 width or values are inverted
+!> 99 = unknown error
+!>
+!> bad output values use MISSING_I and MISSING_R8
+!>
+!> this should be in the utilities module. which should be split into
+!> smaller modules because right now it's a dumping ground for every
+!> random routine that is useful to more than one module.
+
+integer, parameter :: r8 = SELECTED_REAL_KIND(12)
+integer, parameter :: MISSING_I = -888888
+real(r8), parameter :: MISSING_R8 = -888888.0_r8
+
+subroutine find_enclosing_indices(nitems, data_array, value_to_find, &
+ smaller_value_index, larger_value_index, fraction_across, my_status, &
+ inverted, log_scale)
+
+integer, intent(in) :: nitems
+real(r8), intent(in) :: data_array(nitems)
+real(r8), intent(in) :: value_to_find
+integer, intent(out) :: smaller_value_index
+integer, intent(out) :: larger_value_index
+real(r8), intent(out) :: fraction_across
+integer, intent(out) :: my_status
+logical, intent(in), optional :: inverted
+logical, intent(in), optional :: log_scale
+
+integer :: i, j, k
+logical :: invert, do_log
+
+! set defaults and initialize intent(out) items
+! so we can return immediately on error.
+
+invert = .false.
+if (present(inverted)) invert = inverted
+
+do_log = .false.
+if (present(log_scale)) do_log = log_scale
+
+smaller_value_index = MISSING_I
+larger_value_index = MISSING_I
+fraction_across = MISSING_R8
+my_status = -99
+
+! exclude malformed call cases
+if (nitems <= 1) then
+ my_status = 97
+ return
+endif
+
+! discard out of range values
+if ((value_to_find < data_array(1) .and. .not. invert) .or. &
+ (value_to_find < data_array(nitems) .and. invert)) then
+ my_status = -1
+ return
+endif
+
+if ((value_to_find > data_array(nitems) .and. .not. invert) .or. &
+ (value_to_find > data_array(1) .and. invert)) then
+ my_status = 1
+ return
+endif
+
+! bisection section (get it?)
+i = 1
+j = nitems
+
+do
+ k=(i+j)/2
+ if ((value_to_find < data_array(k) .and. .not. invert) .or. &
+ (value_to_find > data_array(k) .and. invert)) then
+ j=k
+ else
+ i=k
+ endif
+ if (i+1 >= j) exit
+enddo
+
+print *, 'i, j: ', i, i+1
+print *, 'data: ', data_array(i), data_array(i+1)
+
+if (.not. invert) then
+ smaller_value_index = i
+ larger_value_index = i+1
+else
+ smaller_value_index = i+1
+ larger_value_index = i
+endif
+
+! avoid divide by 0. the indices have been set but the fraction and status are
+! still bad to indicate an error.
+if ((data_array(larger_value_index) - data_array(smaller_value_index)) <= 0.0_r8) then
+ my_status = 98
+ return
+endif
+
+! no log computations if any data values are negative
+! (do this on 2 lines to avoid testing the data value
+! unless we are planning to take the log.)
+if (do_log) then
+ if (data_array(smaller_value_index) <= 0.0) then
+ my_status = 96
+ return
+ endif
+endif
+
+! compute fraction here
+if (.not. do_log) then
+ fraction_across = (value_to_find - data_array(smaller_value_index)) / &
+ (data_array(larger_value_index) - data_array(smaller_value_index))
+else
+ fraction_across = (log(value_to_find) - log(data_array(smaller_value_index))) / &
+ (log(data_array(larger_value_index)) - log(data_array(smaller_value_index)))
+
+endif
+
+! good return
+my_status = 0
+
+end subroutine find_enclosing_indices
diff --git a/models/cam-fv/chem_tables.txt b/models/cam-fv/chem_tables.txt
new file mode 100644
index 0000000000..4325de2d32
--- /dev/null
+++ b/models/cam-fv/chem_tables.txt
@@ -0,0 +1,146 @@
+! CAM-chem
+!
+! These lists were provided by Jerome Barre' and/or Avelino Arellano.
+!
+! Chemical quantities, and the molar mass of each chemical species
+
+! is column 1 the netcdf variable name?
+! i think it should be the QTY_xxx value in dart
+! or how about this?
+!
+! netcdf varname conversion val dart qty
+
+ O3 47.9982 QTY_O3
+ O 15.9994 QTY_O
+ O1D 15.9994 QTY_O1D
+ N2O 44.01288 QTY_N2O
+ NO 30.00614 QTY_NO
+ NO2 46.00554 QTY_NO2
+ NO3 62.00494 QTY_NO3
+ HNO3 63.01234 QTY_HNO3
+ HO2NO2 79.01174 QTY_HO2NO2
+ N2O5 108.01048 QTY_N2O5
+ H2 2.0148 QTY_H2
+ OH 17.0068 QTY_OH
+ HO2 33.0062 QTY_HO2
+ H2O2 34.0136 QTY_H2O2
+ CH4 16.0406 QTY_CH4
+ CO 28.0104 QTY_CO
+ CH3O2 47.032 QTY_CH3O2
+ CH3OOH 48.0394 QTY_CH3OOH
+ CH2O 30.0252 QTY_CH2O
+ CH3OH 32.04 QTY_CH3OH
+ C2H5OH 46.0658 QTY_C2H5OH
+ C2H4 28.0516 QTY_C2H4
+ EO 61.0578 QTY_EO
+ EO2 77.0572 QTY_EO2
+ CH3COOH 60.0504 QTY_CH3COOH
+ GLYALD 60.0504 QTY_GLYALD
+ C2H6 30.0664 QTY_C2H6
+ C2H5O2 61.0578 QTY_C2H5O2
+ C2H5OOH 62.0652 QTY_C2H5OOH
+ CH3CHO 44.051 QTY_CH3CHO
+ CH3CO3 75.0424 QTY_CH3CO3
+ CH3COOOH 76.0498 QTY_CH3COOOH
+ C3H6 42.0774 QTY_C3H6
+ C3H8 44.0922 QTY_C3H8
+ C3H7O2 75.0836 QTY_C3H7O2
+ C3H7OOH 76.091 QTY_C3H7OOH
+ PO2 91.083 QTY_PO2
+ POOH 92.0904 QTY_POOH
+ CH3COCH3 58.0768 QTY_CH3COCH3
+ RO2 89.0682 QTY_RO2
+ ROOH 90.0756 QTY_ROOH
+ BIGENE 56.1032 QTY_BIGENE
+ ENEO2 105.1088 QTY_ENEO2
+ MEK 72.1026 QTY_MEK
+ MEKO2 103.094 QTY_MEKO2
+ MEKOOH 104.1014 QTY_MEKOOH
+ BIGALK 72.1438 QTY_BIGALK
+ ALKO2 103.1352 QTY_ALKO2
+ ALKOOH 104.1426 QTY_ALKOOH
+ ISOP 68.1142 QTY_ISOP
+ ISOPO2 117.1198 QTY_ISOPO2
+ ISOPOOH 118.1272 QTY_ISOPOOH
+ MVK 70.0878 QTY_MVK
+ MACR 70.0878 QTY_MACR
+ MACRO2 119.0934 QTY_MACRO2
+ MACROOH 120.1008 QTY_MACROOH
+ MCO3 101.0792 QTY_MCO3
+ HYDRALD 100.113 QTY_HYDRALD
+ HYAC 74.0762 QTY_HYAC
+ CH3COCHO 72.0614 QTY_CH3COCHO
+ XO2 149.1186 QTY_XO2
+ XOOH 150.126 QTY_XOOH
+ C10H16 136.2284 QTY_C10H16
+ TERPO2 185.234 QTY_TERPO2
+ TERPOOH 186.2414 QTY_TERPOOH
+ TOLUENE 92.1362 QTY_TOLUENE
+ CRESOL 108.1356 QTY_CRESOL
+ TOLO2 173.1406 QTY_TOLO2
+ TOLOOH 174.148 QTY_TOLOOH
+ XOH 190.1474 QTY_XOH
+ BIGALD 98.0982 QTY_BIGALD
+ GLYOXAL 58.0356 QTY_GLYOXAL
+ PAN 121.04794 QTY_PAN
+ ONIT 119.07434 QTY_ONIT
+ MPAN 147.08474 QTY_MPAN
+ ISOPNO3 162.11794 QTY_ISOPNO3
+ ONITR 147.12594 QTY_ONITR
+ SOA 144.132 QTY_SOA
+ SO2 64.0648 QTY_SO2
+ DMS 62.1324 QTY_DMS
+ NH3 17.02894 QTY_NH3
+ NH4 18.03634 QTY_NH4
+ NH4NO3 80.04128 QTY_NH4NO3
+ Rn 222.0 QTY_Rn
+ Pb 207.2 QTY_Pb
+ HCN 27.02514 QTY_HCN
+ CH3CN 41.05094 QTY_CH3CN
+ C2H2 26.0368 QTY_C2H2
+ HCOOH 46.0246 QTY_HCOOH
+ HOCH2OO 63.0314 QTY_HOCH2OO
+ H2SO4 98.0784 QTY_H2SO4
+ SOAG 12.011 QTY_SOAG
+ so4_a1 115.10734 QTY_so4_a1
+ pom_a1 12.011 QTY_pom_a1
+ soa_a1 12.011 QTY_soa_a1
+ bc_a1 12.011 QTY_bc_a1
+ dst_a1 135.064039 QTY_dst_a1
+ ncl_a1 58.442468 QTY_ncl_a1
+ num_a1 1.0074 QTY_num_a1
+ so4_a2 115.10734 QTY_so4_a2
+ soa_a2 12.011 QTY_soa_a2
+ ncl_a2 58.442468 QTY_ncl_a2
+ num_a2 1.0074 QTY_num_a2
+ dst_a3 135.064039 QTY_dst_a3
+ ncl_a3 58.442468 QTY_ncl_a3
+ so4_a3 115.10734 QTY_so4_a3
+ num_a3 1.0074 QTY_num_a3
+ CO01 28.0104 QTY_CO01
+ CO02 28.0104 QTY_CO02
+ CO03 28.0104 QTY_CO03
+ CO04 28.0104 QTY_CO04
+ CO05 28.0104 QTY_CO05
+ CO06 28.0104 QTY_CO06
+ CO07 28.0104 QTY_CO07
+ CO08 28.0104 QTY_CO08
+ CO09 28.0104 QTY_CO09
+ CB1 12.011 QTY_CB1
+ CB2 12.011 QTY_CB2
+ OC1 12.011 QTY_OC1
+ OC2 12.011 QTY_OC2
+ CB101 12.011 QTY_CB101
+ CB201 12.011 QTY_CB201
+ OC101 12.011 QTY_OC101
+ OC201 12.011 QTY_OC201
+ CB102 12.011 QTY_CB102
+ CB202 12.011 QTY_CB202
+ OC102 12.011 QTY_OC102
+ OC202 12.011 QTY_OC202
+
+
+! 2 unit conversion arrays derived from adv_mass will be filled in map_qtys.
+real(r8), parameter :: molar_mass_dry_air = 28.9644
+
+! CAM-chem end
diff --git a/models/cam-fv/chem_tables_mod.f90 b/models/cam-fv/chem_tables_mod.f90
new file mode 100644
index 0000000000..ac4420b3e9
--- /dev/null
+++ b/models/cam-fv/chem_tables_mod.f90
@@ -0,0 +1,322 @@
+! 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$
+!----------------------------------------------------------------
+!>
+!> this routines supports unit conversions between chemistry values
+!> in the cam state and the observed quantities
+!>
+!----------------------------------------------------------------
+
+module chem_tables_mod
+
+
+use types_mod
+use utilities_mod
+use obs_kind_mod
+
+implicit none
+private
+
+public :: init_chem_tables, &
+ finalize_chem_tables, &
+ get_molar_mass, &
+ get_volume_mixing_ratio
+
+!public :: chem_convert_factors, molar_mass_dry_air
+
+! version controlled file description for error handling, do not edit
+character(len=*), parameter :: source = &
+ "$URL$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
+
+
+type chem_convert
+ character(len=31) :: netcdf_varname
+ real(r8) :: convert_factor
+ character(len=31) :: quantity_name
+end type
+
+
+! table of chemistry conversion factors from mmr to vmr and back
+type(chem_convert), allocatable :: chem_conv_table(:)
+
+real(r8), parameter :: molar_mass_dry_air = 28.9644_r8
+
+integer :: num_qtys
+character(len=256) :: string1, string2
+logical :: module_initialized = .false.
+
+contains
+
+!--------------------------------------------------------------------
+!> call once to allocate and initialize the table
+
+subroutine init_chem_tables()
+
+! to add more quantities, add entries here following the pattern.
+! there can be only one entry per 'QTY_xxx'
+
+integer :: i
+
+if (module_initialized) return
+
+num_qtys = get_num_quantities()
+
+allocate(chem_conv_table(0:num_qtys))
+
+! initialize all entries to an empty name and a factor of 1.0
+do i=0, num_qtys
+ call set_entry('', 1.0_r8, i)
+enddo
+
+! and now add entries for real items
+call add_entry('H', 1.0074_r8, 'QTY_ATOMIC_H_MIXING_RATIO')
+call add_entry('O', 15.9994_r8, 'QTY_ATOMIC_OXYGEN_MIXING_RATIO')
+call add_entry('O2', 31.9988_r8, 'QTY_MOLEC_OXYGEN_MIXING_RATIO')
+call add_entry('O3', 47.9982_r8, 'QTY_O3')
+call add_entry('N2', 28.0135_r8, 'QTY_NITROGEN')
+
+
+!%! 'N2O ', 44.01288, 'QTY_N2O ', &
+!%! 'NO ', 30.00614, 'QTY_NO ', &
+!%! 'NO2 ', 46.00554, 'QTY_NO2 ', &
+!%! 'NO3 ', 62.00494, 'QTY_NO3 ', &
+!%! 'HNO3 ', 63.01234, 'QTY_HNO3 ', &
+!%! 'HO2NO2 ', 79.01174, 'QTY_HO2NO2 ', &
+!%! 'N2O5 ', 108.01048, 'QTY_N2O5 ', &
+!%! 'H2 ', 2.0148, 'QTY_H2 ', &
+!%! 'OH ', 17.0068, 'QTY_OH ', &
+!%! 'HO2 ', 33.0062, 'QTY_HO2 ', &
+!%! 'H2O2 ', 34.0136, 'QTY_H2O2 ', &
+!%! 'CH4 ', 16.0406, 'QTY_CH4 ', &
+!%! 'CO ', 28.0104, 'QTY_CO ', &
+!%! 'CH3O2 ', 47.032, 'QTY_CH3O2 ', &
+!%! 'CH3OOH ', 48.0394, 'QTY_CH3OOH ', &
+!%! 'CH2O ', 30.0252, 'QTY_CH2O ', &
+!%! 'CH3OH ', 32.04, 'QTY_CH3OH ', &
+!%! 'C2H5OH ', 46.0658, 'QTY_C2H5OH ', &
+!%! 'C2H4 ', 28.0516, 'QTY_C2H4 ', &
+!%! 'EO ', 61.0578, 'QTY_EO ', &
+!%! 'EO2 ', 77.0572, 'QTY_EO2 ', &
+!%! 'CH3COOH ', 60.0504, 'QTY_CH3COOH ', &
+!%! 'GLYALD ', 60.0504, 'QTY_GLYALD ', &
+!%! 'C2H6 ', 30.0664, 'QTY_C2H6 ', &
+!%! 'C2H5O2 ', 61.0578, 'QTY_C2H5O2 ', &
+!%! 'C2H5OOH ', 62.0652, 'QTY_C2H5OOH ', &
+!%! 'CH3CHO ', 44.051, 'QTY_CH3CHO ', &
+!%! 'CH3CO3 ', 75.0424, 'QTY_CH3CO3 ', &
+!%! 'CH3COOOH ', 76.0498, 'QTY_CH3COOOH ', &
+!%! 'C3H6 ', 42.0774, 'QTY_C3H6 ', &
+!%! 'C3H8 ', 44.0922, 'QTY_C3H8 ', &
+!%! 'C3H7O2 ', 75.0836, 'QTY_C3H7O2 ', &
+!%! 'C3H7OOH ', 76.091, 'QTY_C3H7OOH ', &
+!%! 'PO2 ', 91.083, 'QTY_PO2 ', &
+!%! 'POOH ', 92.0904, 'QTY_POOH ', &
+!%! 'CH3COCH3 ', 58.0768, 'QTY_CH3COCH3 ', &
+!%! 'RO2 ', 89.0682, 'QTY_RO2 ', &
+!%! 'ROOH ', 90.0756, 'QTY_ROOH ', &
+!%! 'BIGENE ', 56.1032, 'QTY_BIGENE ', &
+!%! 'ENEO2 ', 105.1088, 'QTY_ENEO2 ', &
+!%! 'MEK ', 72.1026, 'QTY_MEK ', &
+!%! 'MEKO2 ', 103.094, 'QTY_MEKO2 ', &
+!%! 'MEKOOH ', 104.1014, 'QTY_MEKOOH ', &
+!%! 'BIGALK ', 72.1438, 'QTY_BIGALK ', &
+!%! 'ALKO2 ', 103.1352, 'QTY_ALKO2 ', &
+!%! 'ALKOOH ', 104.1426, 'QTY_ALKOOH ', &
+!%! 'ISOP ', 68.1142, 'QTY_ISOP ', &
+!%! 'ISOPO2 ', 117.1198, 'QTY_ISOPO2 ', &
+!%! 'ISOPOOH ', 118.1272, 'QTY_ISOPOOH ', &
+!%! 'MVK ', 70.0878, 'QTY_MVK ', &
+!%! 'MACR ', 70.0878, 'QTY_MACR ', &
+!%! 'MACRO2 ', 119.0934, 'QTY_MACRO2 ', &
+!%! 'MACROOH ', 120.1008, 'QTY_MACROOH ', &
+!%! 'MCO3 ', 101.0792, 'QTY_MCO3 ', &
+!%! 'HYDRALD ', 100.113, 'QTY_HYDRALD ', &
+!%! 'HYAC ', 74.0762, 'QTY_HYAC ', &
+!%! 'CH3COCHO ', 72.0614, 'QTY_CH3COCHO ', &
+!%! 'XO2 ', 149.1186, 'QTY_XO2 ', &
+!%! 'XOOH ', 150.126, 'QTY_XOOH ', &
+!%! 'C10H16 ', 136.2284, 'QTY_C10H16 ', &
+!%! 'TERPO2 ', 185.234, 'QTY_TERPO2 ', &
+!%! 'TERPOOH ', 186.2414, 'QTY_TERPOOH ', &
+!%! 'TOLUENE ', 92.1362, 'QTY_TOLUENE ', &
+!%! 'CRESOL ', 108.1356, 'QTY_CRESOL ', &
+!%! 'TOLO2 ', 173.1406, 'QTY_TOLO2 ', &
+!%! 'TOLOOH ', 174.148, 'QTY_TOLOOH ', &
+!%! 'XOH ', 190.1474, 'QTY_XOH ', &
+!%! 'BIGALD ', 98.0982, 'QTY_BIGALD ', &
+!%! 'GLYOXAL ', 58.0356, 'QTY_GLYOXAL ', &
+!%! 'PAN ', 121.04794, 'QTY_PAN ', &
+!%! 'ONIT ', 119.07434, 'QTY_ONIT ', &
+!%! 'MPAN ', 147.08474, 'QTY_MPAN ', &
+!%! 'ISOPNO3 ', 162.11794, 'QTY_ISOPNO3 ', &
+!%! 'ONITR ', 147.12594, 'QTY_ONITR ', &
+!%! 'SOA ', 144.132, 'QTY_SOA ', &
+!%! 'SO2 ', 64.0648, 'QTY_SO2 ', &
+!%! 'DMS ', 62.1324, 'QTY_DMS ', &
+!%! 'NH3 ', 17.02894, 'QTY_NH3 ', &
+!%! 'NH4 ', 18.03634, 'QTY_NH4 ', &
+!%! 'NH4NO3 ', 80.04128, 'QTY_NH4NO3 ', &
+!%! 'Rn ', 222.0, 'QTY_Rn ', &
+!%! 'Pb ', 207.2, 'QTY_Pb ', &
+!%! 'HCN ', 27.02514, 'QTY_HCN ', &
+!%! 'CH3CN ', 41.05094, 'QTY_CH3CN ', &
+!%! 'C2H2 ', 26.0368, 'QTY_C2H2 ', &
+!%! 'HCOOH ', 46.0246, 'QTY_HCOOH ', &
+!%! 'HOCH2OO ', 63.0314, 'QTY_HOCH2OO ', &
+!%! 'H2SO4 ', 98.0784, 'QTY_H2SO4 ', &
+!%! 'SOAG ', 12.011, 'QTY_SOAG ', &
+!%! 'so4_a1 ', 115.10734, 'QTY_so4_a1 ', &
+!%! 'pom_a1 ', 12.011, 'QTY_pom_a1 ', &
+!%! 'soa_a1 ', 12.011, 'QTY_soa_a1 ', &
+!%! 'bc_a1 ', 12.011, 'QTY_bc_a1 ', &
+!%! 'dst_a1 ', 135.064039, 'QTY_dst_a1 ', &
+!%! 'ncl_a1 ', 58.442468, 'QTY_ncl_a1 ', &
+!%! 'num_a1 ', 1.0074, 'QTY_num_a1 ', &
+!%! 'so4_a2 ', 115.10734, 'QTY_so4_a2 ', &
+!%! 'soa_a2 ', 12.011, 'QTY_soa_a2 ', &
+!%! 'ncl_a2 ', 58.442468, 'QTY_ncl_a2 ', &
+!%! 'num_a2 ', 1.0074, 'QTY_num_a2 ', &
+!%! 'dst_a3 ', 135.064039, 'QTY_dst_a3 ', &
+!%! 'ncl_a3 ', 58.442468, 'QTY_ncl_a3 ', &
+!%! 'so4_a3 ', 115.10734, 'QTY_so4_a3 ', &
+!%! 'num_a3 ', 1.0074, 'QTY_num_a3 ', &
+!%! 'CO01 ', 28.0104, 'QTY_CO01 ', &
+!%! 'CO02 ', 28.0104, 'QTY_CO02 ', &
+!%! 'CO03 ', 28.0104, 'QTY_CO03 ', &
+!%! 'CO04 ', 28.0104, 'QTY_CO04 ', &
+!%! 'CO05 ', 28.0104, 'QTY_CO05 ', &
+!%! 'CO06 ', 28.0104, 'QTY_CO06 ', &
+!%! 'CO07 ', 28.0104, 'QTY_CO07 ', &
+!%! 'CO08 ', 28.0104, 'QTY_CO08 ', &
+!%! 'CO09 ', 28.0104, 'QTY_CO09 ', &
+!%! 'CB1 ', 12.011, 'QTY_CB1 ', &
+!%! 'CB2 ', 12.011, 'QTY_CB2 ', &
+!%! 'OC1 ', 12.011, 'QTY_OC1 ', &
+!%! 'OC2 ', 12.011, 'QTY_OC2 ', &
+!%! 'CB101 ', 12.011, 'QTY_CB101 ', &
+!%! 'CB201 ', 12.011, 'QTY_CB201 ', &
+!%! 'OC101 ', 12.011, 'QTY_OC101 ', &
+!%! 'OC201 ', 12.011, 'QTY_OC201 ', &
+!%! 'CB102 ', 12.011, 'QTY_CB102 ', &
+!%! 'CB202 ', 12.011, 'QTY_CB202 ', &
+!%! 'OC102 ', 12.011, 'QTY_OC102 ', &
+!%! 'OC202 ', 12.011, 'QTY_OC202 '
+
+
+end subroutine init_chem_tables
+
+!--------------------------------------------------------------------
+!> call at end to free the table space
+
+subroutine finalize_chem_tables
+
+deallocate(chem_conv_table)
+
+end subroutine finalize_chem_tables
+
+!--------------------------------------------------------------------
+!>
+
+subroutine add_entry(netcdf_varname, convert_factor, quantity_name)
+
+character(len=*), intent(in) :: netcdf_varname
+real(r8), intent(in) :: convert_factor
+character(len=*), intent(in) :: quantity_name
+
+integer :: qty_index
+
+! get qty indx, error if not found
+qty_index = get_index_for_quantity(quantity_name)
+if (qty_index < 0) then
+ write(string1,'(3A)') 'quantity string "', trim(quantity_name), &
+ '" not found in known quantities list'
+ write(string2, *) 'check obs_kind_mod.f90 for valid quantities; defined by preprocess namelist'
+ call error_handler(E_ERR, 'chem_convert_factor', string1, &
+ source, revision, revdate, text2=string2)
+endif
+
+! build type, add to array at indx
+
+chem_conv_table(qty_index) = chem_convert(netcdf_varname, convert_factor, quantity_name)
+
+end subroutine add_entry
+
+!--------------------------------------------------------------------
+!>
+
+subroutine set_entry(netcdf_varname, convert_factor, quantity_index)
+
+character(len=*), intent(in) :: netcdf_varname
+real(r8), intent(in) :: convert_factor
+integer, intent(in) :: quantity_index
+
+character(len=32) :: quantity_name
+
+quantity_name = get_name_for_quantity(quantity_index)
+if (quantity_name == '') then
+ write(string1,'(3A)') 'quantity index "', quantity_index, &
+ '" not found in known quantities list'
+ write(string2, *) 'check obs_kind_mod.f90 for valid quantities; defined by preprocess namelist'
+ call error_handler(E_ERR, 'chem_convert_factor', string1, &
+ source, revision, revdate, text2=string2)
+endif
+
+chem_conv_table(quantity_index) = chem_convert(netcdf_varname, convert_factor, quantity_name)
+
+end subroutine set_entry
+
+!--------------------------------------------------------------------
+!>
+function get_molar_mass(qty)
+
+integer, intent(in) :: qty
+real(r8) :: get_molar_mass
+
+if (qty < 0 .or. qty > num_qtys) then
+ write(string1,'(A,I6,A,I6)') 'quantity number ', qty, &
+ ' must be between 0 and ', num_qtys
+ call error_handler(E_ERR, 'get_molar_mass', string1, &
+ source, revision, revdate)
+endif
+
+get_molar_mass = chem_conv_table(qty)%convert_factor
+
+end function get_molar_mass
+
+!--------------------------------------------------------------------
+!>
+function get_volume_mixing_ratio(qty)
+
+integer, intent(in) :: qty
+real(r8) :: get_volume_mixing_ratio
+
+if (qty < 0 .or. qty > num_qtys) then
+ write(string1,'(A,I6,A,I6)') 'quantity number ', qty, &
+ ' must be between 0 and ', num_qtys
+ call error_handler(E_ERR, 'get_volume_mixing_ratio', string1, &
+ source, revision, revdate)
+endif
+if (chem_conv_table(qty)%convert_factor /= 1.0_r8) then
+ get_volume_mixing_ratio = molar_mass_dry_air / chem_conv_table(qty)%convert_factor
+else
+ get_volume_mixing_ratio = 1.0_r8
+endif
+
+end function get_volume_mixing_ratio
+
+!--------------------------------------------------------------------
+
+end module chem_tables_mod
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
+
+
diff --git a/models/cam-fv/doc/README_cam-fv b/models/cam-fv/doc/README_cam-fv
index a9e2b23731..8098ad1d18 100644
--- a/models/cam-fv/doc/README_cam-fv
+++ b/models/cam-fv/doc/README_cam-fv
@@ -1,37 +1,32 @@
-We recommend that before using the DART CAM-FV interface
+Before using the cam-fv interface, we recommend
you become familiar with DART by working through
-the core parts of the DART tutorial or getting instruction
-from someone knowledgable about DART.
+the core parts of the tutorial.
-The scripts which set up CAM and CAM-DART assimilations
-are in the models/cam-fv/shell_scripts/cesm2_0 directory.
-Work through setup_hybrid first, which will guide you
+The scripts which set up CAM and CAM-DART assimilations are in
+the shell_scripts directory.
+There is a subdirectory for the releases of CESM which work with DART.
+
+Working through setup_hybrid will guide you
through setting up the multi-instance CAM-FV environment
which DART requires.
-
That script includes instructions for activating the
-assimilation using the DART_config script.
-Check the output of the forecasts and assimilations
-carefully to catch errors early in the development process.
+assimilation using DART_config.template.
+Do check the output of the forecasts and assimilations
+carefully, to catch errors earlier in the development process.
We highly recommend using observation space diagnostics
to evaluate your results.
-Once you are comfortable with these procedures you may
-find it more efficient to use the setup_advanced script,
-which combines the setup of CAM and the activation of the
-assimilation. It also provides more advanced mechanisms
-for setting up the best assimilation for your research.
+Once you are comfortable with those procedures,
+you may want to explore the setup_advanced script,
+which has advanced features.
-The CESM environment which DART requires is now included
-in CESM's testing process. So you should be able to use
-any new releases or any betas after CESM 2.0 with DART.
-For releases or betas other than CESM 2.0 we recommend
-setting up a new models/cam-fv/shell_scripts/cesm#_#
-directory, modeled on the cesm2_0 directory, to minimize
-problems with changing CESM requirements.
+CESM's automated testing includes the features that DART requires.
+You should be able to use CESM versions newer than 2.0 with DART.
+We recommend that you set up a new shell_scripts/cesm#_#
+directory, modeled on the cesm2_1 directory, to minimize
+problems running with multiple CESM versions.
-If you discover that CESM is not playing well with DART
+If you discover that CESM is not playing well with DART,
and you have tried the simple fixes (increasing nodes/member,
decreasing ensemble size, removing your SourceMods, etc)
please contact us at dart@ucar.edu.
-
diff --git a/models/cam-fv/high_top_table.f90 b/models/cam-fv/high_top_table.f90
new file mode 100644
index 0000000000..e9dccd446b
--- /dev/null
+++ b/models/cam-fv/high_top_table.f90
@@ -0,0 +1,207 @@
+std_atm_table_len = 201
+allocate(std_atm_hgt_col(std_atm_table_len), std_atm_pres_col(std_atm_table_len))
+
+std_atm_hgt_col(1) = 1000.0_r8 ; std_atm_pres_col(1) = 7.518E-09_r8
+std_atm_hgt_col(2) = 995.0_r8 ; std_atm_pres_col(2) = 7.651E-09_r8
+std_atm_hgt_col(3) = 990.0_r8 ; std_atm_pres_col(3) = 7.790E-09_r8
+std_atm_hgt_col(4) = 985.0_r8 ; std_atm_pres_col(4) = 7.931E-09_r8
+std_atm_hgt_col(5) = 980.0_r8 ; std_atm_pres_col(5) = 8.075E-09_r8
+std_atm_hgt_col(6) = 975.0_r8 ; std_atm_pres_col(6) = 8.222E-09_r8
+std_atm_hgt_col(7) = 970.0_r8 ; std_atm_pres_col(7) = 8.371E-09_r8
+std_atm_hgt_col(8) = 965.0_r8 ; std_atm_pres_col(8) = 8.524E-09_r8
+std_atm_hgt_col(9) = 960.0_r8 ; std_atm_pres_col(9) = 8.680E-09_r8
+std_atm_hgt_col(10) = 955.0_r8 ; std_atm_pres_col(10) = 8.839E-09_r8
+std_atm_hgt_col(11) = 950.0_r8 ; std_atm_pres_col(11) = 9.001E-09_r8
+std_atm_hgt_col(12) = 945.0_r8 ; std_atm_pres_col(12) = 9.168E-09_r8
+std_atm_hgt_col(13) = 940.0_r8 ; std_atm_pres_col(13) = 9.338E-09_r8
+std_atm_hgt_col(14) = 935.0_r8 ; std_atm_pres_col(14) = 9.513E-09_r8
+std_atm_hgt_col(15) = 930.0_r8 ; std_atm_pres_col(15) = 9.692E-09_r8
+std_atm_hgt_col(16) = 925.0_r8 ; std_atm_pres_col(16) = 9.875E-09_r8
+std_atm_hgt_col(17) = 920.0_r8 ; std_atm_pres_col(17) = 1.006E-08_r8
+std_atm_hgt_col(18) = 915.0_r8 ; std_atm_pres_col(18) = 1.026E-08_r8
+std_atm_hgt_col(19) = 910.0_r8 ; std_atm_pres_col(19) = 1.046E-08_r8
+std_atm_hgt_col(20) = 905.0_r8 ; std_atm_pres_col(20) = 1.066E-08_r8
+std_atm_hgt_col(21) = 900.0_r8 ; std_atm_pres_col(21) = 1.087E-08_r8
+std_atm_hgt_col(22) = 895.0_r8 ; std_atm_pres_col(22) = 1.109E-08_r8
+std_atm_hgt_col(23) = 890.0_r8 ; std_atm_pres_col(23) = 1.132E-08_r8
+std_atm_hgt_col(24) = 885.0_r8 ; std_atm_pres_col(24) = 1.155E-08_r8
+std_atm_hgt_col(25) = 880.0_r8 ; std_atm_pres_col(25) = 1.179E-08_r8
+std_atm_hgt_col(26) = 875.0_r8 ; std_atm_pres_col(26) = 1.203E-08_r8
+std_atm_hgt_col(27) = 870.0_r8 ; std_atm_pres_col(27) = 1.229E-08_r8
+std_atm_hgt_col(28) = 865.0_r8 ; std_atm_pres_col(28) = 1.255E-08_r8
+std_atm_hgt_col(29) = 860.0_r8 ; std_atm_pres_col(29) = 1.283E-08_r8
+std_atm_hgt_col(30) = 855.0_r8 ; std_atm_pres_col(30) = 1.311E-08_r8
+std_atm_hgt_col(31) = 850.0_r8 ; std_atm_pres_col(31) = 1.340E-08_r8
+std_atm_hgt_col(32) = 845.0_r8 ; std_atm_pres_col(32) = 1.371E-08_r8
+std_atm_hgt_col(33) = 840.0_r8 ; std_atm_pres_col(33) = 1.402E-08_r8
+std_atm_hgt_col(34) = 835.0_r8 ; std_atm_pres_col(34) = 1.435E-08_r8
+std_atm_hgt_col(35) = 830.0_r8 ; std_atm_pres_col(35) = 1.469E-08_r8
+std_atm_hgt_col(36) = 825.0_r8 ; std_atm_pres_col(36) = 1.504E-08_r8
+std_atm_hgt_col(37) = 820.0_r8 ; std_atm_pres_col(37) = 1.541E-08_r8
+std_atm_hgt_col(38) = 815.0_r8 ; std_atm_pres_col(38) = 1.579E-08_r8
+std_atm_hgt_col(39) = 810.0_r8 ; std_atm_pres_col(39) = 1.619E-08_r8
+std_atm_hgt_col(40) = 805.0_r8 ; std_atm_pres_col(40) = 1.660E-08_r8
+std_atm_hgt_col(41) = 800.0_r8 ; std_atm_pres_col(41) = 1.704E-08_r8
+std_atm_hgt_col(42) = 795.0_r8 ; std_atm_pres_col(42) = 1.749E-08_r8
+std_atm_hgt_col(43) = 790.0_r8 ; std_atm_pres_col(43) = 1.795E-08_r8
+std_atm_hgt_col(44) = 785.0_r8 ; std_atm_pres_col(44) = 1.844E-08_r8
+std_atm_hgt_col(45) = 780.0_r8 ; std_atm_pres_col(45) = 1.896E-08_r8
+std_atm_hgt_col(46) = 775.0_r8 ; std_atm_pres_col(46) = 1.949E-08_r8
+std_atm_hgt_col(47) = 770.0_r8 ; std_atm_pres_col(47) = 2.006E-08_r8
+std_atm_hgt_col(48) = 765.0_r8 ; std_atm_pres_col(48) = 2.064E-08_r8
+std_atm_hgt_col(49) = 760.0_r8 ; std_atm_pres_col(49) = 2.126E-08_r8
+std_atm_hgt_col(50) = 755.0_r8 ; std_atm_pres_col(50) = 2.191E-08_r8
+std_atm_hgt_col(51) = 750.0_r8 ; std_atm_pres_col(51) = 2.260E-08_r8
+std_atm_hgt_col(52) = 745.0_r8 ; std_atm_pres_col(52) = 2.331E-08_r8
+std_atm_hgt_col(53) = 740.0_r8 ; std_atm_pres_col(53) = 2.407E-08_r8
+std_atm_hgt_col(54) = 735.0_r8 ; std_atm_pres_col(54) = 2.487E-08_r8
+std_atm_hgt_col(55) = 730.0_r8 ; std_atm_pres_col(55) = 2.571E-08_r8
+std_atm_hgt_col(56) = 725.0_r8 ; std_atm_pres_col(56) = 2.660E-08_r8
+std_atm_hgt_col(57) = 720.0_r8 ; std_atm_pres_col(57) = 2.755E-08_r8
+std_atm_hgt_col(58) = 715.0_r8 ; std_atm_pres_col(58) = 2.854E-08_r8
+std_atm_hgt_col(59) = 710.0_r8 ; std_atm_pres_col(59) = 2.960E-08_r8
+std_atm_hgt_col(60) = 705.0_r8 ; std_atm_pres_col(60) = 3.072E-08_r8
+std_atm_hgt_col(61) = 700.0_r8 ; std_atm_pres_col(61) = 3.191E-08_r8
+std_atm_hgt_col(62) = 695.0_r8 ; std_atm_pres_col(62) = 3.317E-08_r8
+std_atm_hgt_col(63) = 690.0_r8 ; std_atm_pres_col(63) = 3.451E-08_r8
+std_atm_hgt_col(64) = 685.0_r8 ; std_atm_pres_col(64) = 3.594E-08_r8
+std_atm_hgt_col(65) = 680.0_r8 ; std_atm_pres_col(65) = 3.746E-08_r8
+std_atm_hgt_col(66) = 675.0_r8 ; std_atm_pres_col(66) = 3.908E-08_r8
+std_atm_hgt_col(67) = 670.0_r8 ; std_atm_pres_col(67) = 4.080E-08_r8
+std_atm_hgt_col(68) = 665.0_r8 ; std_atm_pres_col(68) = 4.264E-08_r8
+std_atm_hgt_col(69) = 660.0_r8 ; std_atm_pres_col(69) = 4.459E-08_r8
+std_atm_hgt_col(70) = 655.0_r8 ; std_atm_pres_col(70) = 4.668E-08_r8
+std_atm_hgt_col(71) = 650.0_r8 ; std_atm_pres_col(71) = 4.892E-08_r8
+std_atm_hgt_col(72) = 645.0_r8 ; std_atm_pres_col(72) = 5.130E-08_r8
+std_atm_hgt_col(73) = 640.0_r8 ; std_atm_pres_col(73) = 5.385E-08_r8
+std_atm_hgt_col(74) = 635.0_r8 ; std_atm_pres_col(74) = 5.659E-08_r8
+std_atm_hgt_col(75) = 630.0_r8 ; std_atm_pres_col(75) = 5.951E-08_r8
+std_atm_hgt_col(76) = 625.0_r8 ; std_atm_pres_col(76) = 6.264E-08_r8
+std_atm_hgt_col(77) = 620.0_r8 ; std_atm_pres_col(77) = 6.600E-08_r8
+std_atm_hgt_col(78) = 615.0_r8 ; std_atm_pres_col(78) = 6.961E-08_r8
+std_atm_hgt_col(79) = 610.0_r8 ; std_atm_pres_col(79) = 7.349E-08_r8
+std_atm_hgt_col(80) = 605.0_r8 ; std_atm_pres_col(80) = 7.765E-08_r8
+std_atm_hgt_col(81) = 600.0_r8 ; std_atm_pres_col(81) = 8.213E-08_r8
+std_atm_hgt_col(82) = 595.0_r8 ; std_atm_pres_col(82) = 8.695E-08_r8
+std_atm_hgt_col(83) = 590.0_r8 ; std_atm_pres_col(83) = 9.214E-08_r8
+std_atm_hgt_col(84) = 585.0_r8 ; std_atm_pres_col(84) = 9.774E-08_r8
+std_atm_hgt_col(85) = 580.0_r8 ; std_atm_pres_col(85) = 1.038E-07_r8
+std_atm_hgt_col(86) = 575.0_r8 ; std_atm_pres_col(86) = 1.103E-07_r8
+std_atm_hgt_col(87) = 570.0_r8 ; std_atm_pres_col(87) = 1.173E-07_r8
+std_atm_hgt_col(88) = 565.0_r8 ; std_atm_pres_col(88) = 1.249E-07_r8
+std_atm_hgt_col(89) = 560.0_r8 ; std_atm_pres_col(89) = 1.330E-07_r8
+std_atm_hgt_col(90) = 555.0_r8 ; std_atm_pres_col(90) = 1.418E-07_r8
+std_atm_hgt_col(91) = 550.0_r8 ; std_atm_pres_col(91) = 1.514E-07_r8
+std_atm_hgt_col(92) = 545.0_r8 ; std_atm_pres_col(92) = 1.617E-07_r8
+std_atm_hgt_col(93) = 540.0_r8 ; std_atm_pres_col(93) = 1.728E-07_r8
+std_atm_hgt_col(94) = 535.0_r8 ; std_atm_pres_col(94) = 1.849E-07_r8
+std_atm_hgt_col(95) = 530.0_r8 ; std_atm_pres_col(95) = 1.979E-07_r8
+std_atm_hgt_col(96) = 525.0_r8 ; std_atm_pres_col(96) = 2.120E-07_r8
+std_atm_hgt_col(97) = 520.0_r8 ; std_atm_pres_col(97) = 2.273E-07_r8
+std_atm_hgt_col(98) = 515.0_r8 ; std_atm_pres_col(98) = 2.439E-07_r8
+std_atm_hgt_col(99) = 510.0_r8 ; std_atm_pres_col(99) = 2.618E-07_r8
+std_atm_hgt_col(100) = 505.0_r8 ; std_atm_pres_col(100) = 2.813E-07_r8
+std_atm_hgt_col(101) = 500.0_r8 ; std_atm_pres_col(101) = 3.024E-07_r8
+std_atm_hgt_col(102) = 495.0_r8 ; std_atm_pres_col(102) = 3.252E-07_r8
+std_atm_hgt_col(103) = 490.0_r8 ; std_atm_pres_col(103) = 3.501E-07_r8
+std_atm_hgt_col(104) = 485.0_r8 ; std_atm_pres_col(104) = 3.770E-07_r8
+std_atm_hgt_col(105) = 480.0_r8 ; std_atm_pres_col(105) = 4.063E-07_r8
+std_atm_hgt_col(106) = 475.0_r8 ; std_atm_pres_col(106) = 4.382E-07_r8
+std_atm_hgt_col(107) = 470.0_r8 ; std_atm_pres_col(107) = 4.728E-07_r8
+std_atm_hgt_col(108) = 465.0_r8 ; std_atm_pres_col(108) = 5.104E-07_r8
+std_atm_hgt_col(109) = 460.0_r8 ; std_atm_pres_col(109) = 5.514E-07_r8
+std_atm_hgt_col(110) = 455.0_r8 ; std_atm_pres_col(110) = 5.960E-07_r8
+std_atm_hgt_col(111) = 450.0_r8 ; std_atm_pres_col(111) = 6.445E-07_r8
+std_atm_hgt_col(112) = 445.0_r8 ; std_atm_pres_col(112) = 6.974E-07_r8
+std_atm_hgt_col(113) = 440.0_r8 ; std_atm_pres_col(113) = 7.550E-07_r8
+std_atm_hgt_col(114) = 435.0_r8 ; std_atm_pres_col(114) = 8.179E-07_r8
+std_atm_hgt_col(115) = 430.0_r8 ; std_atm_pres_col(115) = 8.864E-07_r8
+std_atm_hgt_col(116) = 425.0_r8 ; std_atm_pres_col(116) = 9.612E-07_r8
+std_atm_hgt_col(117) = 420.0_r8 ; std_atm_pres_col(117) = 1.043E-06_r8
+std_atm_hgt_col(118) = 415.0_r8 ; std_atm_pres_col(118) = 1.132E-06_r8
+std_atm_hgt_col(119) = 410.0_r8 ; std_atm_pres_col(119) = 1.229E-06_r8
+std_atm_hgt_col(120) = 405.0_r8 ; std_atm_pres_col(120) = 1.336E-06_r8
+std_atm_hgt_col(121) = 400.0_r8 ; std_atm_pres_col(121) = 1.452E-06_r8
+std_atm_hgt_col(122) = 395.0_r8 ; std_atm_pres_col(122) = 1.579E-06_r8
+std_atm_hgt_col(123) = 390.0_r8 ; std_atm_pres_col(123) = 1.718E-06_r8
+std_atm_hgt_col(124) = 385.0_r8 ; std_atm_pres_col(124) = 1.870E-06_r8
+std_atm_hgt_col(125) = 380.0_r8 ; std_atm_pres_col(125) = 2.037E-06_r8
+std_atm_hgt_col(126) = 375.0_r8 ; std_atm_pres_col(126) = 2.220E-06_r8
+std_atm_hgt_col(127) = 370.0_r8 ; std_atm_pres_col(127) = 2.421E-06_r8
+std_atm_hgt_col(128) = 365.0_r8 ; std_atm_pres_col(128) = 2.641E-06_r8
+std_atm_hgt_col(129) = 360.0_r8 ; std_atm_pres_col(129) = 2.884E-06_r8
+std_atm_hgt_col(130) = 355.0_r8 ; std_atm_pres_col(130) = 3.151E-06_r8
+std_atm_hgt_col(131) = 350.0_r8 ; std_atm_pres_col(131) = 3.445E-06_r8
+std_atm_hgt_col(132) = 345.0_r8 ; std_atm_pres_col(132) = 3.769E-06_r8
+std_atm_hgt_col(133) = 340.0_r8 ; std_atm_pres_col(133) = 4.126E-06_r8
+std_atm_hgt_col(134) = 335.0_r8 ; std_atm_pres_col(134) = 4.521E-06_r8
+std_atm_hgt_col(135) = 330.0_r8 ; std_atm_pres_col(135) = 4.957E-06_r8
+std_atm_hgt_col(136) = 325.0_r8 ; std_atm_pres_col(136) = 5.440E-06_r8
+std_atm_hgt_col(137) = 320.0_r8 ; std_atm_pres_col(137) = 5.975E-06_r8
+std_atm_hgt_col(138) = 315.0_r8 ; std_atm_pres_col(138) = 6.568E-06_r8
+std_atm_hgt_col(139) = 310.0_r8 ; std_atm_pres_col(139) = 7.226E-06_r8
+std_atm_hgt_col(140) = 305.0_r8 ; std_atm_pres_col(140) = 7.957E-06_r8
+std_atm_hgt_col(141) = 300.0_r8 ; std_atm_pres_col(141) = 8.770E-06_r8
+std_atm_hgt_col(142) = 295.0_r8 ; std_atm_pres_col(142) = 9.676E-06_r8
+std_atm_hgt_col(143) = 290.0_r8 ; std_atm_pres_col(143) = 1.069E-05_r8
+std_atm_hgt_col(144) = 285.0_r8 ; std_atm_pres_col(144) = 1.181E-05_r8
+std_atm_hgt_col(145) = 280.0_r8 ; std_atm_pres_col(145) = 1.308E-05_r8
+std_atm_hgt_col(146) = 275.0_r8 ; std_atm_pres_col(146) = 1.449E-05_r8
+std_atm_hgt_col(147) = 270.0_r8 ; std_atm_pres_col(147) = 1.608E-05_r8
+std_atm_hgt_col(148) = 265.0_r8 ; std_atm_pres_col(148) = 1.787E-05_r8
+std_atm_hgt_col(149) = 260.0_r8 ; std_atm_pres_col(149) = 1.989E-05_r8
+std_atm_hgt_col(150) = 255.0_r8 ; std_atm_pres_col(150) = 2.218E-05_r8
+std_atm_hgt_col(151) = 250.0_r8 ; std_atm_pres_col(151) = 2.476E-05_r8
+std_atm_hgt_col(152) = 245.0_r8 ; std_atm_pres_col(152) = 2.770E-05_r8
+std_atm_hgt_col(153) = 240.0_r8 ; std_atm_pres_col(153) = 3.105E-05_r8
+std_atm_hgt_col(154) = 235.0_r8 ; std_atm_pres_col(154) = 3.488E-05_r8
+std_atm_hgt_col(155) = 230.0_r8 ; std_atm_pres_col(155) = 3.927E-05_r8
+std_atm_hgt_col(156) = 225.0_r8 ; std_atm_pres_col(156) = 4.432E-05_r8
+std_atm_hgt_col(157) = 220.0_r8 ; std_atm_pres_col(157) = 5.015E-05_r8
+std_atm_hgt_col(158) = 215.0_r8 ; std_atm_pres_col(158) = 5.690E-05_r8
+std_atm_hgt_col(159) = 210.0_r8 ; std_atm_pres_col(159) = 6.476E-05_r8
+std_atm_hgt_col(160) = 205.0_r8 ; std_atm_pres_col(160) = 7.394E-05_r8
+std_atm_hgt_col(161) = 200.0_r8 ; std_atm_pres_col(161) = 8.474E-05_r8
+std_atm_hgt_col(162) = 195.0_r8 ; std_atm_pres_col(162) = 9.749E-05_r8
+std_atm_hgt_col(163) = 190.0_r8 ; std_atm_pres_col(163) = 1.127E-04_r8
+std_atm_hgt_col(164) = 185.0_r8 ; std_atm_pres_col(164) = 1.308E-04_r8
+std_atm_hgt_col(165) = 180.0_r8 ; std_atm_pres_col(165) = 1.527E-04_r8
+std_atm_hgt_col(166) = 175.0_r8 ; std_atm_pres_col(166) = 1.794E-04_r8
+std_atm_hgt_col(167) = 170.0_r8 ; std_atm_pres_col(167) = 2.121E-04_r8
+std_atm_hgt_col(168) = 165.0_r8 ; std_atm_pres_col(168) = 2.528E-04_r8
+std_atm_hgt_col(169) = 160.0_r8 ; std_atm_pres_col(169) = 3.039E-04_r8
+std_atm_hgt_col(170) = 155.0_r8 ; std_atm_pres_col(170) = 3.693E-04_r8
+std_atm_hgt_col(171) = 150.0_r8 ; std_atm_pres_col(171) = 4.542E-04_r8
+std_atm_hgt_col(172) = 145.0_r8 ; std_atm_pres_col(172) = 5.669E-04_r8
+std_atm_hgt_col(173) = 140.0_r8 ; std_atm_pres_col(173) = 7.203E-04_r8
+std_atm_hgt_col(174) = 135.0_r8 ; std_atm_pres_col(174) = 9.357E-04_r8
+std_atm_hgt_col(175) = 130.0_r8 ; std_atm_pres_col(175) = 1.250E-03_r8
+std_atm_hgt_col(176) = 125.0_r8 ; std_atm_pres_col(176) = 1.736E-03_r8
+std_atm_hgt_col(177) = 120.0_r8 ; std_atm_pres_col(177) = 2.537E-03_r8
+std_atm_hgt_col(178) = 115.0_r8 ; std_atm_pres_col(178) = 4.004E-03_r8
+std_atm_hgt_col(179) = 110.0_r8 ; std_atm_pres_col(179) = 7.149E-03_r8
+std_atm_hgt_col(180) = 105.0_r8 ; std_atm_pres_col(180) = 1.442E-02_r8
+std_atm_hgt_col(181) = 100.0_r8 ; std_atm_pres_col(181) = 3.201E-02_r8
+std_atm_hgt_col(182) = 95.0_r8 ; std_atm_pres_col(182) = 7.577E-02_r8
+std_atm_hgt_col(183) = 90.0_r8 ; std_atm_pres_col(183) = 1.844E-01_r8
+std_atm_hgt_col(184) = 85.0_r8 ; std_atm_pres_col(184) = 4.457E-01_r8
+std_atm_hgt_col(185) = 80.0_r8 ; std_atm_pres_col(185) = 1.052E+00_r8
+std_atm_hgt_col(186) = 75.0_r8 ; std_atm_pres_col(186) = 2.388E+00_r8
+std_atm_hgt_col(187) = 70.0_r8 ; std_atm_pres_col(187) = 5.221E+00_r8
+std_atm_hgt_col(188) = 65.0_r8 ; std_atm_pres_col(188) = 1.093E+01_r8
+std_atm_hgt_col(189) = 60.0_r8 ; std_atm_pres_col(189) = 2.196E+01_r8
+std_atm_hgt_col(190) = 55.0_r8 ; std_atm_pres_col(190) = 4.253E+01_r8
+std_atm_hgt_col(191) = 50.0_r8 ; std_atm_pres_col(191) = 7.978E+01_r8
+std_atm_hgt_col(192) = 45.0_r8 ; std_atm_pres_col(192) = 1.491E+02_r8
+std_atm_hgt_col(193) = 40.0_r8 ; std_atm_pres_col(193) = 2.871E+02_r8
+std_atm_hgt_col(194) = 35.0_r8 ; std_atm_pres_col(194) = 5.746E+02_r8
+std_atm_hgt_col(195) = 30.0_r8 ; std_atm_pres_col(195) = 1.197E+03_r8
+std_atm_hgt_col(196) = 25.0_r8 ; std_atm_pres_col(196) = 2.549E+03_r8
+std_atm_hgt_col(197) = 20.0_r8 ; std_atm_pres_col(197) = 5.529E+03_r8
+std_atm_hgt_col(198) = 15.0_r8 ; std_atm_pres_col(198) = 1.211E+04_r8
+std_atm_hgt_col(199) = 10.0_r8 ; std_atm_pres_col(199) = 2.650E+04_r8
+std_atm_hgt_col(200) = 5.0_r8 ; std_atm_pres_col(200) = 5.405E+04_r8
+std_atm_hgt_col(201) = 0.0_r8 ; std_atm_pres_col(201) = 1.013E+05_r8
+
+std_atm_hgt_col(:) = std_atm_hgt_col(:) * 1000.0_r8
+
diff --git a/models/cam-fv/low_top_table.f90 b/models/cam-fv/low_top_table.f90
new file mode 100644
index 0000000000..4171eeeda4
--- /dev/null
+++ b/models/cam-fv/low_top_table.f90
@@ -0,0 +1,52 @@
+
+std_atm_table_len = 45
+allocate(std_atm_hgt_col(std_atm_table_len), std_atm_pres_col(std_atm_table_len))
+
+std_atm_hgt_col(1) = 86.0_r8 ; std_atm_pres_col(1) = 3.732E-01_r8
+std_atm_hgt_col(2) = 84.0_r8 ; std_atm_pres_col(2) = 5.308E-01_r8
+std_atm_hgt_col(3) = 82.0_r8 ; std_atm_pres_col(3) = 7.498E-01_r8
+std_atm_hgt_col(4) = 80.0_r8 ; std_atm_pres_col(4) = 1.052E+00_r8
+std_atm_hgt_col(5) = 78.0_r8 ; std_atm_pres_col(5) = 1.467E+00_r8
+std_atm_hgt_col(6) = 76.0_r8 ; std_atm_pres_col(6) = 2.033E+00_r8
+std_atm_hgt_col(7) = 74.0_r8 ; std_atm_pres_col(7) = 2.800E+00_r8
+std_atm_hgt_col(8) = 72.0_r8 ; std_atm_pres_col(8) = 3.835E+00_r8
+std_atm_hgt_col(9) = 70.0_r8 ; std_atm_pres_col(9) = 5.220E+00_r8
+std_atm_hgt_col(10) = 68.0_r8 ; std_atm_pres_col(10) = 7.051E+00_r8
+std_atm_hgt_col(11) = 66.0_r8 ; std_atm_pres_col(11) = 9.459E+00_r8
+std_atm_hgt_col(12) = 64.0_r8 ; std_atm_pres_col(12) = 1.260E+01_r8
+std_atm_hgt_col(13) = 62.0_r8 ; std_atm_pres_col(13) = 1.669E+01_r8
+std_atm_hgt_col(14) = 60.0_r8 ; std_atm_pres_col(14) = 2.196E+01_r8
+std_atm_hgt_col(15) = 58.0_r8 ; std_atm_pres_col(15) = 2.872E+01_r8
+std_atm_hgt_col(16) = 56.0_r8 ; std_atm_pres_col(16) = 3.736E+01_r8
+std_atm_hgt_col(17) = 54.0_r8 ; std_atm_pres_col(17) = 4.833E+01_r8
+std_atm_hgt_col(18) = 52.0_r8 ; std_atm_pres_col(18) = 6.221E+01_r8
+std_atm_hgt_col(19) = 50.0_r8 ; std_atm_pres_col(19) = 7.977E+01_r8
+std_atm_hgt_col(20) = 48.0_r8 ; std_atm_pres_col(20) = 1.023E+02_r8
+std_atm_hgt_col(21) = 46.0_r8 ; std_atm_pres_col(21) = 1.313E+02_r8
+std_atm_hgt_col(22) = 44.0_r8 ; std_atm_pres_col(22) = 1.695E+02_r8
+std_atm_hgt_col(23) = 42.0_r8 ; std_atm_pres_col(23) = 2.200E+02_r8
+std_atm_hgt_col(24) = 40.0_r8 ; std_atm_pres_col(24) = 2.871E+02_r8
+std_atm_hgt_col(25) = 38.0_r8 ; std_atm_pres_col(25) = 3.771E+02_r8
+std_atm_hgt_col(26) = 36.0_r8 ; std_atm_pres_col(26) = 4.985E+02_r8
+std_atm_hgt_col(27) = 34.0_r8 ; std_atm_pres_col(27) = 6.634E+02_r8
+std_atm_hgt_col(28) = 32.0_r8 ; std_atm_pres_col(28) = 8.890E+02_r8
+std_atm_hgt_col(29) = 30.0_r8 ; std_atm_pres_col(29) = 1.197E+03_r8
+std_atm_hgt_col(30) = 28.0_r8 ; std_atm_pres_col(30) = 1.616E+03_r8
+std_atm_hgt_col(31) = 26.0_r8 ; std_atm_pres_col(31) = 2.188E+03_r8
+std_atm_hgt_col(32) = 24.0_r8 ; std_atm_pres_col(32) = 2.972E+03_r8
+std_atm_hgt_col(33) = 22.0_r8 ; std_atm_pres_col(33) = 4.047E+03_r8
+std_atm_hgt_col(34) = 20.0_r8 ; std_atm_pres_col(34) = 5.529E+03_r8
+std_atm_hgt_col(35) = 18.0_r8 ; std_atm_pres_col(35) = 7.565E+03_r8
+std_atm_hgt_col(36) = 16.0_r8 ; std_atm_pres_col(36) = 1.035E+04_r8
+std_atm_hgt_col(37) = 14.0_r8 ; std_atm_pres_col(37) = 1.417E+04_r8
+std_atm_hgt_col(38) = 12.0_r8 ; std_atm_pres_col(38) = 1.940E+04_r8
+std_atm_hgt_col(39) = 10.0_r8 ; std_atm_pres_col(39) = 2.650E+04_r8
+std_atm_hgt_col(40) = 8.0_r8 ; std_atm_pres_col(40) = 3.565E+04_r8
+std_atm_hgt_col(41) = 6.0_r8 ; std_atm_pres_col(41) = 4.722E+04_r8
+std_atm_hgt_col(42) = 4.0_r8 ; std_atm_pres_col(42) = 6.166E+04_r8
+std_atm_hgt_col(43) = 2.0_r8 ; std_atm_pres_col(43) = 7.950E+04_r8
+std_atm_hgt_col(44) = 0.0_r8 ; std_atm_pres_col(44) = 1.013E+05_r8
+std_atm_hgt_col(45) = -2.0_r8 ; std_atm_pres_col(45) = 1.278E+05_r8
+
+std_atm_hgt_col(:) = std_atm_hgt_col(:) * 1000.0_r8
+
diff --git a/models/cam-fv/model_mod.f90 b/models/cam-fv/model_mod.f90
index 2852144df4..db27d9ba71 100644
--- a/models/cam-fv/model_mod.f90
+++ b/models/cam-fv/model_mod.f90
@@ -1,4166 +1,2941 @@
! 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
-
+! by ucar, "as is", without charge, subject to all terms of use at
+! http://www.image.ucar.edu/dares/dart/dart_download
+!
! $Id$
-
-! > > > This version has NOT been updated to describe RMA changes.
-! See RMA-KR for changes to Helen's original RMA version.
-! Some comments in here are meant to connect with comments in
-! the trunk (non-RMA) version as of 2016-7. These comments
-! and the sections in the trunk may be helpful in tracing the
-! development of the RMA for FV, and help with the development
-! of the RMA SE version.
-
-
-!> This is the interface module between remote memory access capable DART (RMA)
-!> and the atmospheric components of CESM; CAM, WACCM, CAM-Chem (, ...?).
-!> It contains the required 16 interface procedures, as specified by DART.
-!> It also contains several utility routines which help translate between CAM and DART
-!> formats, and deal with time.
-!> It is used by filter and perfect_model_obs.
-!>
-!> This module handles the finite volume dynamical core version of CAM.
-!> A separate model_mod will handle CAM-SE, the spectral element dycore.
-!> CAM-FV uses a logically rectangular grid,
-!> while CAM-SE uses the cubed sphere (non-rectangular) horizontal grid.
-!>
-!> There is a perturburbation routine for generating and initial ensemble.
-!> This routine is activated by the filter namelist logical perturb_from_single_instance
-!> and the model_mod namelist variable pert_names.
-!> The module does not provide adv_1step or init_conditions because CAM
-!> is a separate executable and cannot be called as a subroutine.
-!>
-!> This module intercepts the get_close_obs() calls and can alter the distances
-!> for obs near the top of the model to reduce the impact on the state near the
-!> top.
-!>
-!> The coordinate orders of fields are preserved from the CAM initial file order.
-!>
-!> The RMA model_mod does not refer to TYPE_s, since they were replaced by association
-!> with CAM variables and use of find_name.
-!> In the future, DART QTYs will be associated with CAM variables by the ${comp}_variables
-!> mechanism as in models/clm.
-!> If a user wants to add new CAM variables to the state vector,
-!> then more QTY_s may be needed in the 'use obs_kind_mod' statement and maybe the obs_kind_mod.
-!>
-!> Observations below the lowest model level (including surface observations) and above
-!> the highest model level cannot be assimilated (yet). The spatial extent of observations
-!> can be further restricted using model_nml namelist variables.
-!>
-!> MODULE ORGANIZATION (search for the following strings to find the corresponding section)
+!----------------------------------------------------------------
!>
-!> 'use' statements
-!> Global storage for describing cam model class
-!> Namelist variables with default values
-!> Derived parameters
-!> static_init_model section
-!> Module I/O to/from DART and files
-!> model_interpolate section
-!> Vector-field translations
-!> get_close section
-!> Utility routines; called by several main subroutines
-!> Stubs not used by cam/model_mod (this is not all of them)
-!>
-!> See the subversion code logs for history of this module.
-!> There is an html description of this module in ./model_mod.html.
+!> this is the interface between the cam-fv atmosphere model and dart.
+!> the required public interfaces and arguments cannot be changed.
!>
+!----------------------------------------------------------------
module model_mod
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-! CONTRIBUTORS (aside from the DART team)
-
-! Ave Arellano did the first work with CAM-Chem, assimilating MOPPITT CO observations
-! into CAM-Chem using the FV core. Jerome Barre and Benjamin Gaubert took up the development
-! work from Ave, and prompted several additions to DART, as well as cam/model_mod.
-
-! Nick Pedatella developed the first vert_coord = 'log_invP' capability
-! to enable assimilation using WACCM and scale height vertical locations.
-
-! NOTES about the module.
-
-! This module no longer (RMA) keeps a copy of the ensemble mean in module global storage.
-! That was needed for convert_vert to transform the vertical coordinate of something
-! passed from filter into the coordinate used in model_mod. But now convert_vert is
-! called directly by filter, where the model states and or mean are available,
-! so ens_mean is not needed.
-! All locations are now converted to a standard coordinate
-! (pressure or log(P0/pressure), aka scale height), instead of always converting the state
-! vertical location to that of the ob. The highest_obs_level and ..._height_m variables
-! are derived from highest_obs_pressure_Pa namelist variable.
-!
-! Surface pressure may be needed on the A-grid (thermodynamic variables) and grids staggered
-! relative to the A-grid (winds). These are retrieved (A-grid) and/or calculated (staggered)
-! as needed from filter, rather than being stored globally in this module.
-
-! The coordinates of CAM (lats, lons, etc.) and their dimensions and attributes are
-! read into globally accessible data structures (see grid_1d_type).
-!
-! MODULE ORGANIZATION (search for the following strings to find the corresponding section)
-!
-! USE statements
-! Global storage for describing cam model class
-! Namelist variables with default values
-! Derived parameters
-! static_init_model section
-! Module I/O to/from DART and files
-! model_interpolate section
-! Vector-field translations
-! get_close section
-! Utility routines; called by several main subroutines
-! Stubs not used by cam/model_mod (this is not all of them)
-
-!= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
-
-! USE statements
-
-use netcdf
-use typeSizes
-
-use types_mod, only : r8, MISSING_I, MISSING_R8, gravity_const => gravity, &
- PI, DEG2RAD, RAD2DEG, obstypelength, earth_radius, i8
-! FIXME; these constants should be consistent with CESM, not necessarily with DART.
-! add after verification against Hui's tests; gas_constant_v,gas_constant,ps0,PI,DEG2RAD
-
-use time_manager_mod, only : time_type, set_time, set_date, print_time, print_date, &
- set_calendar_type, get_calendar_type, get_time, get_date, &
- operator(-), operator(==)
-
-use utilities_mod, only : open_file, close_file, find_namelist_in_file, check_namelist_read, &
- register_module, error_handler, file_exist, E_ERR, E_WARN, E_MSG, &
- logfileunit, nmlfileunit, do_output, get_unit, do_nml_file, &
- do_nml_term
-
-use netcdf_utilities_mod, only : nc_add_global_attribute, nc_synchronize_file, nc_check, &
- nc_add_global_creation_time, nc_begin_define_mode, &
- nc_end_define_mode
-
-use mpi_utilities_mod, only : my_task_id, task_count
-
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-use location_mod, only : location_type, get_location, set_location, query_location, &
- is_vertical, &
- VERTISUNDEF, VERTISSURFACE, VERTISLEVEL, &
- VERTISPRESSURE, VERTISHEIGHT, VERTISSCALEHEIGHT, write_location, &
- get_close_type, get_dist, loc_get_close => get_close
-
-! READ THIS SYNTAX as:
-! There's a subroutine in location_mod named 'get_close'.
-! If I want to use that one in this module then refer to it as 'loc_get_close'.
-! If I call 'get_close', then I'll get the one in this module,
-! which does some stuff I need, AND ALSO CALLS 'loc_get_close'
-
-! FIXME
-! I've put a copy of solve_quadratic in this model_mod.
-! Eventually it should go into a utilities module.
-! use utilities_YYY, only : solve_quadratic
-
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-use obs_kind_mod, only : QTY_U_WIND_COMPONENT, QTY_V_WIND_COMPONENT, QTY_PRESSURE, &
- QTY_SURFACE_PRESSURE, QTY_TEMPERATURE, QTY_SPECIFIC_HUMIDITY, &
- QTY_CLOUD_LIQUID_WATER, QTY_CLOUD_ICE, QTY_CLOUD_FRACTION, &
- QTY_GRAV_WAVE_DRAG_EFFIC, QTY_GRAV_WAVE_STRESS_FRACTION, &
- QTY_SURFACE_ELEVATION, &
- QTY_CO, QTY_CO2, QTY_NO, QTY_NO2, QTY_CH4, QTY_NH3, QTY_O3, &
- QTY_AOD, QTY_CO01, QTY_CO02, QTY_CO03, &
- QTY_SFCO, QTY_SFCO01, QTY_SFCO02, QTY_SFCO03, &
- QTY_CB1, QTY_CB2, QTY_OC1, QTY_OC2, &
- QTY_SFCB1, QTY_SFCB2, QTY_SFOC1, QTY_SFOC2, &
- QTY_CB102, QTY_CB202, QTY_OC102, QTY_OC202, &
- QTY_SFCB102, QTY_SFCB202, QTY_SFOC102, QTY_SFOC202, &
- get_index_for_quantity, get_name_for_quantity, get_quantity_for_type_of_obs
-
-
-! Other possibilities (names have changed with various CAM versions):
-! Atmos
-! CLOUD: "Cloud fraction" ;
-! QCWAT: "q associated with cloud water" ;
-! TCWAT: "T associated with cloud water" ;
-! CWAT: "Total Grid box averaged Condensate Amount (liquid + ice)" ;
-! also? LCWAT
-
-! pbl
-! PBLH: "PBL height" ;
-! QPERT: "Perturbation specific humidity (eddies in PBL)" ;
-! TPERT: "Perturbation temperature (eddies in PBL)" ;
-
-! Surface
-! LANDFRAC: "Fraction of sfc area covered by land" ;
-! LANDM: "Land ocean transition mask: ocean (0), continent (1), transition (0-1)" ;
-! also LANDM_COSLAT
-! ICEFRAC: "Fraction of sfc area covered by sea-ice" ;
-! SGH: "Standard deviation of orography" ;
-! Z0FAC: "factor relating z0 to sdv of orography" ;
-! TS: "Surface temperature (radiative)" ;
-! TSOCN: "Ocean tempertare" ;
-! TSICE: "Ice temperature" ;
-! TSICERAD: "Radiatively equivalent ice temperature" ;
-
-! Land/under surface
-! SICTHK: "Sea ice thickness" ;
-! SNOWHICE: "Water equivalent snow depth" ;
-! TS1: "subsoil temperature" ;
-! TS2: "subsoil temperature" ;
-! TS3: "subsoil temperature" ;
-! TS4: "subsoil temperature" ;
-
-! Other fields are not included because they look more CLM oriented.
-
-! Other fields which users may add to the CAM initial files are not listed here.
-! Examples are EFGWORO, FRACLDV from the gravity wave drag parameterization study
-! and chemical species from WACCM and CAM-Chem.
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-use random_seq_mod, only : random_seq_type, init_random_seq, random_gaussian
-
-use ensemble_manager_mod, only : ensemble_type
-
-use distributed_state_mod, only : get_state, get_state_array
-
-use state_structure_mod, only : add_domain, get_model_variable_indices, get_dim_name, &
- get_num_dims, get_domain_size, get_dart_vector_index, &
- get_index_start, get_index_end
-
-use default_model_mod, only : adv_1step, init_time, init_conditions, nc_write_model_vars
-
-! end of use statements
-!= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
-
-! CAM global/module declarations
+use types_mod, only : MISSING_R8, MISSING_I, i8, r8, vtablenamelength, &
+ gravity, DEG2RAD
+use time_manager_mod, only : set_time, time_type, set_date, &
+ set_calendar_type, get_date
+use location_mod, only : location_type, set_vertical, set_location, &
+ get_location, write_location, is_vertical, &
+ VERTISUNDEF, VERTISSURFACE, VERTISLEVEL, &
+ VERTISPRESSURE, VERTISHEIGHT, &
+ VERTISSCALEHEIGHT, query_location, &
+ set_vertical_localization_coord, get_dist, &
+ loc_get_close_obs => get_close_obs, &
+ loc_get_close_state => get_close_state, &
+ vertical_localization_on, get_close_type, get_maxdist
+use utilities_mod, only : find_namelist_in_file, check_namelist_read, &
+ string_to_logical, string_to_real,&
+ nmlfileunit, do_nml_file, do_nml_term, &
+ register_module, error_handler, &
+ file_exist, to_upper, E_ERR, E_MSG, array_dump, &
+ find_enclosing_indices
+use obs_kind_mod, only : QTY_SURFACE_ELEVATION, QTY_PRESSURE, &
+ QTY_GEOMETRIC_HEIGHT, QTY_VERTLEVEL, &
+ QTY_SURFACE_PRESSURE, &
+ QTY_TEMPERATURE, QTY_SPECIFIC_HUMIDITY, &
+ QTY_MOLEC_OXYGEN_MIXING_RATIO, &
+ QTY_ION_O_MIXING_RATIO, QTY_ATOMIC_H_MIXING_RATIO, &
+ QTY_ATOMIC_OXYGEN_MIXING_RATIO, QTY_NITROGEN, &
+ get_index_for_quantity, get_num_quantities, &
+ get_name_for_quantity, get_quantity_for_type_of_obs
+use mpi_utilities_mod, only : my_task_id
+use random_seq_mod, only : random_seq_type, init_random_seq, random_gaussian
+use ensemble_manager_mod, only : ensemble_type, get_my_num_vars, get_my_vars
+use distributed_state_mod, only : get_state
+use state_structure_mod, only : add_domain, get_dart_vector_index, get_domain_size, &
+ get_dim_name, get_kind_index, get_num_dims, &
+ get_num_variables, get_varid_from_kind, &
+ get_model_variable_indices, state_structure_info
+use netcdf_utilities_mod, only : nc_get_variable, nc_get_variable_size, &
+ nc_add_attribute_to_variable, &
+ nc_define_integer_variable, &
+ nc_define_real_variable, &
+ nc_define_real_scalar, &
+ nc_add_global_creation_time, &
+ nc_add_global_attribute, &
+ nc_define_dimension, nc_put_variable, &
+ nc_synchronize_file, nc_end_define_mode, &
+ nc_begin_define_mode, nc_open_file_readonly, &
+ nc_close_file, nc_variable_exists
+use chem_tables_mod, only : init_chem_tables, finalize_chem_tables, &
+ get_molar_mass, get_volume_mixing_ratio
+use quad_utils_mod, only : quad_interp_handle, init_quad_interp, &
+ set_quad_coords, finalize_quad_interp, &
+ quad_lon_lat_locate, quad_lon_lat_evaluate, &
+ GRID_QUAD_IRREG_SPACED_REGULAR, &
+ QUAD_LOCATED_CELL_CENTERS
+use default_model_mod, only : adv_1step, nc_write_model_vars, &
+ init_time => fail_init_time, &
+ init_conditions => fail_init_conditions
implicit none
private
-! The first block are the 16 required interfaces. The following block
-! are additional useful interfaces that utility programs can call.
-public :: &
- static_init_model, get_model_size, &
- shortest_time_between_assimilations, &
- pert_model_copies, get_state_meta_data, model_interpolate, &
- nc_write_model_atts, nc_write_model_vars, &
- init_conditions, init_time, adv_1step, end_model, &
- get_close_obs, get_close_state, &
- convert_vertical_obs, convert_vertical_state, &
- query_vert_localization_coord, read_model_time, write_model_time
-
-public :: &
- model_type, prog_var_to_vector, vector_to_prog_var, &
- read_cam_init, &
- init_model_instance, end_model_instance, write_cam_init, &
- write_cam_times
+! these routines must be public and you cannot change
+! the arguments - they will be called *from* the dart code.
+
+! routines in this list have code in this module
+public :: static_init_model, &
+ get_model_size, &
+ get_state_meta_data, &
+ model_interpolate, &
+ shortest_time_between_assimilations, &
+ nc_write_model_atts, &
+ write_model_time, &
+ read_model_time, &
+ end_model, &
+ pert_model_copies, &
+ convert_vertical_obs, &
+ convert_vertical_state, &
+ get_close_obs, &
+ get_close_state
+
+! code for these routines are in other modules
+public :: nc_write_model_vars, &
+ adv_1step, &
+ init_time, &
+ init_conditions
-!-----------------------------------------------------------------------
! 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$"
-!-----------------------------------------------------------------------
-
-integer :: component_id ! for add_domain.
-
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Global storage for describing cam model class
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-!-----------------------------------------------------------------------
-
-! A type for cam model.
-! Each variable will be allowed to have different dimensions, even different from
-! others of the same rank (i.e. 2d).
-! The maximum size for each dimension (for a given rank) will be used to allocate space
-! when a model_type variable is initialized.
-type model_type
- private
- real(r8), allocatable :: vars_0d(:)
- real(r8), allocatable :: vars_1d(:, :)
- real(r8), allocatable :: vars_2d(:, :, :)
- real(r8), allocatable :: vars_3d(:, :, :, :)
-end type model_type
-
-!>@todo FIXME: this should be an i8 to handle really large
-!> state vectors, but that change ripples through several layers
-!> of code. nevertheless it should be done.
-integer :: model_size
-
-! This list of dimensions used to define fields will be ordered as they are on the caminput.nc file.
-integer :: num_dims
-integer, allocatable :: dim_sizes(:)
-character(len=NF90_MAX_NAME), allocatable :: dim_names(:)
-
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Grid fields
-! These structures are used by nc_write_model_atts.
-! They are dimensioned in create_grid_1d_instance and filled in read_cam_coord.
-
-! Should this whole type be allocatable, since scalars can be allocated?
-! No, not needed. Deallocating just the allocatable components is enough cleaning.
-
-type grid_1d_type
- private
- character(len=8) :: label = ''
- integer :: dim_id = MISSING_I
- integer :: length = MISSING_I
- real(r8) :: resolution = MISSING_R8
- real(r8), allocatable :: vals(:)
- integer :: num_atts = MISSING_I
- character(len=NF90_MAX_NAME), allocatable :: atts_names(:)
- character(len=NF90_MAX_NAME), allocatable :: atts_vals(:)
-end type grid_1d_type
-
-integer, parameter :: no_lev = MISSING_I ! constant to tell get_val_level there are no levels.
-integer :: iii
-! integer :: grid_num_0d = 0 ! # of grid scalars to read from file
-! P0 now a "coordinate", and may be removed entirely
-! character(len=8),dimension(100) :: grid_names_0d = (/'P0',(' ',iii=1,100)/)
-
-integer :: grid_num_1d = 12 ! # of 1d grid fields to read from file
-character(len=8) :: grid_names_1d(100) = &
- (/ 'lon ','lat ','lev ','gw ', &
- 'hyam ','hybm ','hyai ','hybi ', &
- 'slon ','slat ','ilev ','P0 ', &
- (' ',iii=1,88 ) /)
-! These names should match the grid_names_1d to keep things clear.
-! All the possible coordinates (not dimensions) on the caminput.nc file.
-type(grid_1d_type), target :: lon ,lat ,lev ,gw ,hyam ,hybm ,hyai ,hybi, slon ,slat ,ilev, P0
-! "Any non-pointer sub-object of an object with the TARGET attribute also has the TARGET attribute."
-! So I can point to, e.g., lat%vals.
-
-! grid_2d_type ?
-! integer :: grid_num_2d = 0 ! # of 2d grid fields to read from file
-! ? should phis be in grid_names_2d?
-! character (len=8),dimension(100) :: grid_names_2d = (/(' ',iii=1,100)/)
-
-! CAM-chem
-! These lists were provided by Jerome Barre' and/or Avelino Arellano.
-! They implemented the unit conversion in subroutine read_cam_init in Lanai (and/or earlier DARTs).
-! The Manhattan implementation at the end of model_interpolate was by Kevin Raeder.
-! FIXME It would be better if the following 2 vectors were read from an external file....
-! If meteorological variables (including PRESSURE), or SURFACE_ELEVATION need to have
-! their units converted, their names and conversion factors could be entered in these lists.
-
-integer, parameter :: chemical_list=128
-! Names of chemical species.
-character(len=16) :: solsym(chemical_list) = &
-(/'O3 ','O ','O1D ','N2O ','NO ', &
- 'NO2 ','NO3 ','HNO3 ','HO2NO2 ','N2O5 ', &
- 'H2 ','OH ','HO2 ','H2O2 ','CH4 ', &
- 'CO ','CH3O2 ','CH3OOH ','CH2O ','CH3OH ', &
- 'C2H5OH ','C2H4 ','EO ','EO2 ','CH3COOH ', &
- 'GLYALD ','C2H6 ','C2H5O2 ','C2H5OOH ','CH3CHO ', &
- 'CH3CO3 ','CH3COOOH ','C3H6 ','C3H8 ','C3H7O2 ', &
- 'C3H7OOH ','PO2 ','POOH ','CH3COCH3 ','RO2 ', &
- 'ROOH ','BIGENE ','ENEO2 ','MEK ','MEKO2 ', &
- 'MEKOOH ','BIGALK ','ALKO2 ','ALKOOH ','ISOP ', &
- 'ISOPO2 ','ISOPOOH ','MVK ','MACR ','MACRO2 ', &
- 'MACROOH ','MCO3 ','HYDRALD ','HYAC ','CH3COCHO ', &
- 'XO2 ','XOOH ','C10H16 ','TERPO2 ','TERPOOH ', &
- 'TOLUENE ','CRESOL ','TOLO2 ','TOLOOH ','XOH ', &
- 'BIGALD ','GLYOXAL ','PAN ','ONIT ','MPAN ', &
- 'ISOPNO3 ','ONITR ','SOA ','SO2 ','DMS ', &
- 'NH3 ','NH4 ','NH4NO3 ','Rn ','Pb ', &
- 'HCN ','CH3CN ','C2H2 ','HCOOH ','HOCH2OO ', &
- 'H2SO4 ','SOAG ','so4_a1 ','pom_a1 ','soa_a1 ', &
- 'bc_a1 ','dst_a1 ','ncl_a1 ','num_a1 ','so4_a2 ', &
- 'soa_a2 ','ncl_a2 ','num_a2 ','dst_a3 ','ncl_a3 ', &
- 'so4_a3 ','num_a3 ','CO01 ','CO02 ','CO03 ', &
- 'CO04 ','CO05 ','CO06 ','CO07 ','CO08 ', &
- 'CO09 ','CB1 ','CB2 ','OC1 ','OC2 ', &
- 'CB101 ','CB201 ','OC101 ','OC201 ', &
- 'CB102 ','CB202 ','OC102 ','OC202 ' &
- /)
-
-! The molar mass of each chemical species
-real(r8) :: adv_mass(chemical_list) = &
-(/47.9982_r8, 15.9994_r8, 15.9994_r8, 44.01288_r8, 30.00614_r8, &
- 46.00554_r8, 62.00494_r8, 63.01234_r8, 79.01174_r8, 108.01048_r8, &
- 2.0148_r8, 17.0068_r8, 33.0062_r8, 34.0136_r8, 16.0406_r8, &
- 28.0104_r8, 47.032_r8, 48.0394_r8, 30.0252_r8, 32.04_r8, &
- 46.0658_r8, 28.0516_r8, 61.0578_r8, 77.0572_r8, 60.0504_r8, &
- 60.0504_r8, 30.0664_r8, 61.0578_r8, 62.0652_r8, 44.051_r8, &
- 75.0424_r8, 76.0498_r8, 42.0774_r8, 44.0922_r8, 75.0836_r8, &
- 76.091_r8, 91.083_r8, 92.0904_r8, 58.0768_r8, 89.0682_r8, &
- 90.0756_r8, 56.1032_r8, 105.1088_r8, 72.1026_r8, 103.094_r8, &
- 104.1014_r8, 72.1438_r8, 103.1352_r8, 104.1426_r8, 68.1142_r8, &
- 117.1198_r8, 118.1272_r8, 70.0878_r8, 70.0878_r8, 119.0934_r8, &
- 120.1008_r8, 101.0792_r8, 100.113_r8, 74.0762_r8, 72.0614_r8, &
- 149.1186_r8, 150.126_r8, 136.2284_r8, 185.234_r8, 186.2414_r8, &
- 92.1362_r8, 108.1356_r8, 173.1406_r8, 174.148_r8, 190.1474_r8, &
- 98.0982_r8, 58.0356_r8, 121.04794_r8, 119.07434_r8, 147.08474_r8, &
- 162.11794_r8, 147.12594_r8, 144.132_r8, 64.0648_r8, 62.1324_r8, &
- 17.02894_r8, 18.03634_r8, 80.04128_r8, 222.0_r8, 207.2_r8, &
- 27.02514_r8, 41.05094_r8, 26.0368_r8, 46.0246_r8, 63.0314_r8, &
- 98.0784_r8, 12.011_r8, 115.10734_r8, 12.011_r8, 12.011_r8, &
- 12.011_r8, 135.064039_r8, 58.442468_r8, 1.0074_r8, 115.10734_r8, &
- 12.011_r8, 58.442468_r8, 1.0074_r8, 135.064039_r8,58.442468_r8, &
- 115.10734_r8, 1.0074_r8, 28.0104_r8, 28.0104_r8, 28.0104_r8, &
- 28.0104_r8, 28.0104_r8, 28.0104_r8, 28.0104_r8, 28.0104_r8, &
- 28.0104_r8, 12.011_r8, 12.011_r8, 12.011_r8, 12.011_r8, &
- 12.011_r8, 12.011_r8, 12.011_r8, 12.011_r8, &
- 12.011_r8, 12.011_r8, 12.011_r8, 12.011_r8 &
-/)
-
-! 2 unit conversion arrays derived from adv_mass will be filled in map_qtys.
-real(r8), parameter :: molar_mass_dry_air = 28.9644_r8
-
-! CAM-chem end
-
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Namelist variables with default values follow
-
-! Files where basic info about model configuration can be found
-character(len=128) :: &
- model_config_file = 'caminput.nc', & ! An example cam initial file.
- cam_phis = 'cam_phis.nc', & ! Separate source of PHIS/topography.
- model_version = '6.0'
-
-
-! Define location restrictions on which observations are assimilated
-! (values are calculated anyway, but istatus is set to 2)
-! RMA-KR; This would be a good time to change 'log_invP' to 'scale_ht' or 'scaled_h?
-character(len=8) :: vert_coord = 'pressure' ! or 'log_invP'
-real(r8) :: max_obs_lat_degree = 90.0_r8
-real(r8) :: highest_obs_pressure_Pa = 1000.0_r8
-real(r8) :: highest_state_pressure_Pa = 9400.0_r8
-
-! Namelist variables and default values for defining state vector.
-
-integer :: state_num_0d = 0 ! # of scalars fields to read from file
-integer :: state_num_1d = 0 ! # of 1d fields to read from file
-integer :: state_num_2d = 0 ! # of 2d fields to read from file
-integer :: state_num_3d = 0 ! # of 3d fields to read from file
-
-! These can't be allocatable since they are namelist items.
-! They have to have a fixed size at compile time.
-! Large, arbitrary dimension could be avoided by reading in sizes from a first namelist,
-! allocating, setting default values, then get values from second namelist.
-! Or, allocate with defaults values, read in namelist, deallocate and reallocate.
-integer, parameter :: MAX_STATE_NAMES = 100
-character(len=8) :: state_names_0d(MAX_STATE_NAMES) = ' '
-character(len=8) :: state_names_1d(MAX_STATE_NAMES) = ' '
-character(len=8) :: state_names_2d(MAX_STATE_NAMES) = ' '
-character(len=8) :: state_names_3d(MAX_STATE_NAMES) = ' '
-
-! NOVERT
-! There's a danger of having a mismatch of which_vert_Xd with the state_names_Xd.
-! Should this definition be part of a new structure state_names_Xd, which is parsed
-! into a name and which_vert after being read? Not for now.
-
-integer :: which_vert_1d(MAX_STATE_NAMES) = MISSING_I
-integer :: which_vert_2d(MAX_STATE_NAMES) = MISSING_I
-integer :: which_vert_3d(MAX_STATE_NAMES) = MISSING_I
-
-
-! Is there a way to exclude state_nums from namelist and have those filled in
-! the subroutine which sorts state_names?
-! Yes, use two namelists model_nml_1 and model_nml_2 at future date.
-
-! List of fields which this code needs to perturb because they're
-! constant valued model parameters and show no spread when start_from_restart = .true.
-character(len=8) :: pert_names (MAX_STATE_NAMES) = ' '
-real(r8) :: pert_sd (MAX_STATE_NAMES) = MISSING_R8
-real(r8) :: pert_base_vals(MAX_STATE_NAMES) = MISSING_R8
-
-! Special for an experiment. Specify one string kind e.g QTY_CLOUD_LIQUID and
-! observations of that kind will only impact other obs and state vars of that
-! same kind. All other kinds of obs and state vars will not be impacted
-! by obs of this kind. A null string means behave as normal.
-character(len=obstypelength) :: impact_only_same_kind = ' '
-
-
-! Specify shortest time step that the model will support
-! This is limited below by CAMs fixed time step but is also impacted
-! by numerical stability concerns for repeated restarting in leapfrog.
-integer :: Time_step_seconds = 21600, Time_step_days = 0
-
-! set to .true. to get more details about the state vector and the
-! CAM fields and sizes in the init code.
-logical :: print_details = .false.
-
-
-namelist /model_nml/ vert_coord, model_version, cam_phis, &
- state_num_0d, state_num_1d, state_num_2d, state_num_3d, &
- state_names_0d, state_names_1d, state_names_2d, state_names_3d, &
- which_vert_1d, which_vert_2d, which_vert_3d, &
- pert_names, pert_sd, pert_base_vals, &
- highest_obs_pressure_Pa, highest_state_pressure_Pa, &
- max_obs_lat_degree, Time_step_seconds, Time_step_days, &
- impact_only_same_kind, print_details, &
- model_config_file
-
-!---- end of namelist (found in file input.nml) ----
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Derived parameters
-
-! make sure static init code only called once
-logical :: module_initialized = .false.
-
-! Variable to keep track of restricting chemistry observations.
-integer :: impact_kind_index = -1
-
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-type(time_type) :: Time_step_atmos
-
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Random sequence and init for pert_model_copies
-type(random_seq_type) :: random_seq
-integer :: ens_member = 0
-logical :: output_task0
-
-! common message string used by many subroutines
+! maximum number of fields you can list to be perturbed
+! to generate an ensemble if starting from a single state.
+integer, parameter :: MAX_PERT = 100
+
+! model_nml namelist variables and default values
+character(len=256) :: cam_template_filename = 'caminput.nc'
+character(len=256) :: cam_phis_filename = 'cam_phis.nc'
+character(len=32) :: vertical_localization_coord = 'PRESSURE'
+logical :: use_log_vertical_scale = .false.
+integer :: assimilation_period_days = 0
+integer :: assimilation_period_seconds = 21600
+! proposed changes:
+integer :: no_obs_assim_above_level = -1 ! model levels
+integer :: model_damping_ends_at_level = -1 ! model levels
+! end proposed changes
+integer :: debug_level = 0
+logical :: suppress_grid_info_in_output = .false.
+logical :: custom_routine_to_generate_ensemble = .true.
+character(len=32) :: fields_to_perturb(MAX_PERT) = ""
+real(r8) :: perturbation_amplitude(MAX_PERT)= 0.0_r8
+logical :: using_chemistry = .false.
+logical :: use_variable_mean_mass = .false.
+
+! in converting to scale height for the vertical:
+! set this to .true. to compute the log of the pressure.
+! set this to .false. to additionally normalize by the surface
+! pressure at this location. this option is backwards-compatible
+! with previous versions of this code.
+logical :: no_normalization_of_scale_heights = .true.
+
+! state_variables defines the contents of the state vector.
+! each line of this input should have the form:
+!
+! netcdf_variable_name, dart_quantity, clamp_min, clamp_max, update_variable
+!
+! all items must be strings (even if numerical values).
+! for no clamping, use the string 'NA'
+! to have the assimilation change the variable use 'UPDATE', else 'NO_UPDATE'
+
+integer, parameter :: MAX_STATE_VARIABLES = 100
+integer, parameter :: num_state_table_columns = 5
+character(len=vtablenamelength) :: state_variables(MAX_STATE_VARIABLES * &
+ num_state_table_columns ) = ' '
+
+namelist /model_nml/ &
+ cam_template_filename, &
+ cam_phis_filename, &
+ vertical_localization_coord, &
+ state_variables, &
+ assimilation_period_days, &
+ assimilation_period_seconds, &
+ use_log_vertical_scale, &
+ no_obs_assim_above_level, &
+ model_damping_ends_at_level, &
+ suppress_grid_info_in_output, &
+ custom_routine_to_generate_ensemble, &
+ fields_to_perturb, &
+ perturbation_amplitude, &
+ no_normalization_of_scale_heights, &
+ use_variable_mean_mass, &
+ using_chemistry, &
+ debug_level
+
+! global variables
character(len=512) :: string1, string2, string3
+logical, save :: module_initialized = .false.
+
+! domain id for the cam model. this allows us access to all of the state structure
+! info and is require for getting state variables.
+integer :: domain_id
+
+!> Metadata from the template netCDF file that describes
+!> where the variable data is located and what size it is.
+
+type cam_1d_array
+ integer :: nsize
+ real(r8), allocatable :: vals(:)
+end type
+
+type cam_grid
+ type(cam_1d_array) :: lon
+ type(cam_1d_array) :: lat
+ type(cam_1d_array) :: slon
+ type(cam_1d_array) :: slat
+ type(cam_1d_array) :: lev
+ type(cam_1d_array) :: ilev
+ type(cam_1d_array) :: gw
+ type(cam_1d_array) :: hyai
+ type(cam_1d_array) :: hybi
+ type(cam_1d_array) :: hyam
+ type(cam_1d_array) :: hybm
+ type(cam_1d_array) :: P0
+end type
+
+type(cam_grid) :: grid_data
+
+
+integer, parameter :: STAGGER_NONE = -1
+integer, parameter :: STAGGER_U = 1
+integer, parameter :: STAGGER_V = 2
+integer, parameter :: STAGGER_W = 3
+integer, parameter :: STAGGER_UV = 4
+
+type cam_stagger
+ integer, allocatable :: qty_stagger(:)
+end type
+
+type(cam_stagger) :: grid_stagger
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-integer :: nflds ! # fields to read
-
-! f_dim_#d are the sizes of the coordinates of each variable as found on caminput file.
-! RMA-KR
-! s_dim_#d and s_dimid_#d are no longer needed, because this model mod is specialized
-! for a single CAM; dynamical core, coordinate orders in the initial file, etc.
-integer, allocatable :: f_dim_3d(:,:), f_dim_2d(:,:), f_dim_1d(:,:), &
- f_dimid_3d(:,:), f_dimid_2d(:,:), f_dimid_1d(:,:)
-
-integer :: f_dim_max(4,3)
+! Surface potential; used for calculation of geometric heights.
+real(r8), allocatable :: phis(:, :)
+
+! default to localizing in pressure. override with namelist
+integer :: vertical_localization_type = VERTISPRESSURE
+
+! flag used to know if the vertical unit system has numbers
+! that get larger as you move away from the earth's surface
+! (e.g. height) or smaller (e.g. pressure)
+logical :: higher_is_smaller
+
+! commonly used numbers that we'll set in static_init_model
+real(r8) :: ref_model_top_pressure
+real(r8) :: ref_surface_pressure
+integer :: ref_nlevels
+
+!>@todo FIXME ask kevin if this threshold value is small enough
+! to distinguish cam from waccm configurations?
+
+! an arbitrary value to test the model top against to see
+! if we're running cam vs waccm or waccm-x. it changes the
+! standard atmosphere table we use to convert pressure to height,
+! and changes the formatting of numbers in dart_log output.
+real(r8), parameter :: high_top_threshold = 0.3_r8 ! pascals
+
+! things related to damping at the model top
+logical :: are_damping = .false.
+real(r8) :: ramp_end ! fixed top of ramp; the start (bottom) varies
+logical :: discarding_high_obs = .false.
+real(r8) :: no_assim_above_height = -1.0_r8
+real(r8) :: no_assim_above_level = -1.0_r8
+real(r8) :: no_assim_above_pressure = -1.0_r8
+
+!> build a pressure/height conversion column based on a
+!> standard atmosphere. this can only be used when we
+!> don't have a real ensemble to use, or we don't care
+!> about absolute accuracy.
+
+interface single_pressure_value
+ module procedure single_pressure_value_int
+ module procedure single_pressure_value_real
+end interface
+
+! Precompute pressure <-> height map once based on either a low-top or
+! high-top table depending on what the model top is.
+! Used only to discard obs on heights above the user-defined top threshold.
+integer, parameter :: HIGH_TOP_TABLE = 1
+integer, parameter :: LOW_TOP_TABLE = 2
+integer :: std_atm_table_len
+real(r8), allocatable :: std_atm_hgt_col(:)
+real(r8), allocatable :: std_atm_pres_col(:)
+
+! Horizontal interpolation code. Need a handle for nonstaggered, U and V.
+type(quad_interp_handle) :: interp_nonstaggered, &
+ interp_u_staggered, &
+ interp_v_staggered
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Surface pressures, used by vertical interpolation routines.
-!
-! I assume that staggered grids (US and VS) are staggered only 1 direction (each),
-! so that surface pressure interpolations to get staggered ps use only 2 A-grid ps values.
-! The interpolations for columns of heights are more general, but will do a 2 point interp
-! if the staggering is only in one direction.
+contains
-! height
-! Surface potential; used for calculation of geometric heights.
-logical :: alloc_phis=.true. ! Flag whether to allocate space for phis
-real(r8), allocatable :: phis(:, :) ! surface geopotential
-
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! RMA-KR; cubed sphere (CAM-SE) section removed from here.
-! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-! Array 'cflds' is filled with simple loops over state_names_xxx.
-! I could replace that with code which orders namelist input field names
-! into cflds, regardless of their original order, and tallies how many of each.
-! Is there a way to exclude state_nums from namelist and have those filled in
-! the same subroutine?
-! RMA-KR; this may/will be replaced by the ${comp}_variables mechanism.
-
-character(len=8), allocatable :: cflds(:)
-
-! Attribute values for the fields which comprise the state vector.
-! These are filled by nc_read_model_atts.
-character(len=nf90_max_name), allocatable :: state_long_names(:)
-character(len=nf90_max_name), allocatable :: state_units(:)
-
-! Arrays for linking obs_qtys(QTY_) and model variable names are filled in map_qtys.
-! The max size of QTY_ should come from obs_kind_mod
-! These should be dimensioned the same size as the total of state_names_Nd.
-character(len=8) :: dart_to_cam_types(300) = ''
-integer :: cam_to_dart_qtys(300) = MISSING_I
-! Strategy; array elements are only changed for conversion factors that are != 1.0.
-! Then convert_mmr2vmr = MISSING_R8 triggers a convert_units of 1.0 in interp_lonlat.
-! So far, the conversion from obs units back to state units is no needed.
-! If it becomes needed:
-! 1) define array convert_vmr2mmr(MAX_STATE_NAMES) = MISSING_R8
-! 2) Add lines to function map_qtys similar to the convert_mmr2vmr lines:
-! convert_vmr2mmr(i) = 1.0_r8/convert_mmr2vmr(i)
-real(r8) :: convert_mmr2vmr(MAX_STATE_NAMES) = MISSING_R8
!-----------------------------------------------------------------------
-! These are calculated from highest_obs_pressure_Pa
-integer :: highest_obs_level = MISSING_I
-real(r8) :: highest_obs_height_m = MISSING_R8
-! Better damping
-! Variables to deal with CAM's damping of the top levels of the model.
-! These are set in static_init_model and used in get_close_obs.
-real(r8) :: highest_state_scale_h = MISSING_R8
-real(r8) :: model_top = MISSING_R8
-real(r8) :: damp_wght = MISSING_R8
-type(location_type) :: highest_state_loc, model_top_loc
-
+! All the required interfaces are first.
!-----------------------------------------------------------------------
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-contains
-
-!#######################################################################
-
-! static_init_model section
!-----------------------------------------------------------------------
+!> Called to do one time initialization of the model.
+!> In this case, it reads in the grid information, the namelist
+!> containing the variables of interest, where to get them, their size,
+!> their associated DART Quantity, etc.
!>
-!> Static_init_model does many things which must be done once at the beginning
-!> of the use of model_mod:
-!> + set the calendar and time variables,
-!> + read, check and archive the model_nml namelist,
-!> + set some output level variables,
-!> + set the state vector size,
-!> + read coordinate variables from the CAM initial file,
-!> + read the model topography
-! No TYPE_s and SE code
+!> In addition to harvesting the model metadata (grid,
+!> desired model advance step, etc.), it also fills a structure
+!> containing information about what variables are where in the DART
+!> framework.
subroutine static_init_model()
-! Initializes class data for CAM model (all the stuff that needs to be done once).
-! For now, does this by reading info from a fixed name netcdf file.
-
-integer :: iunit, io, i, nc_file_ID
-integer :: max_levs
-real(r8), allocatable :: clampfield(:,:)
-! RMA-KR; clampfield added to assist restricting the range of some variable values.
+integer :: iunit, io
+integer :: nfields
-! only execute this code once
-if (module_initialized) return
+character(len=*), parameter :: routine = 'static_init_model'
-! Make sure we only come through here once.
-module_initialized = .true.
+if ( module_initialized ) return
-! Register the module
+! Record version info
call register_module(source, revision, revdate)
-! setting calendar type
-! calendar types listed in time_manager_mod.f90
-! this information is NOT passed to CAM; it must be set in the CAM namelist
-call set_calendar_type('GREGORIAN')
+module_initialized = .true.
-! Read the namelist entry
-call find_namelist_in_file("input.nml", "model_nml", iunit)
+! Read the DART namelist for this model
+call find_namelist_in_file('input.nml', 'model_nml', iunit)
read(iunit, nml = model_nml, iostat = io)
-call check_namelist_read(iunit, io, "model_nml")
-call verify_namelist()
-
-! Set the printed output logical variable to reduce printed output;
-output_task0 = do_output()
+call check_namelist_read(iunit, io, 'model_nml')
-! Record the namelist values
+! Record the namelist values used for the run
if (do_nml_file()) write(nmlfileunit, nml=model_nml)
-if (do_nml_term()) write( * , nml=model_nml)
-
-! Set the model minimum time step from the namelist seconds and days input
-Time_step_atmos = set_time(Time_step_seconds, Time_step_days)
-if (print_details .and. output_task0) call print_time(Time_step_atmos)
-
-! Open CAM 'initial' file to read dimensions and coordinates of fields.
-call nc_check(nf90_open(path=trim(model_config_file), mode=nf90_nowrite, ncid=nc_file_ID), &
- 'static_init_model', 'opening '//trim(model_config_file))
-
-! Get sizes of dimensions/coordinates from netcdf and put in global storage.
-call read_cam_init_size(nc_file_ID)
-
-! RMA-KR; model size is now calculated in state_structure_mod/get_domain_size
-
-! Allocate space for global coordinate arrays and read them in.
-! There's a query of caminput.nc within read_cam_coord for the existence of the field.
-! The second argument is a grid_1d_type structure
-call read_cam_coord(nc_file_ID, 'lon', lon)
-call read_cam_coord(nc_file_ID, 'lat', lat)
-call read_cam_coord(nc_file_ID, 'lev', lev)
-call read_cam_coord(nc_file_ID, 'ilev', ilev)
-call read_cam_coord(nc_file_ID, 'gw', gw)
-call read_cam_coord(nc_file_ID, 'slon', slon)
-call read_cam_coord(nc_file_ID, 'slat', slat)
-
-! read hybrid vert coord coefs
-call read_cam_coord(nc_file_ID, 'hyai', hyai)
-call read_cam_coord(nc_file_ID, 'hybi', hybi)
-call read_cam_coord(nc_file_ID, 'hyam', hyam)
-call read_cam_coord(nc_file_ID, 'hybm', hybm)
-
-! It's a scalar, but I can put it into the same coord structure as previous fields.
-! It's length will be 1
-call read_cam_coord(nc_file_ID, 'P0', P0) ! thats a p-zero
-
-!------------------------------------------------------------------------
-! Better damping algorithm for state variables near/in the CAM damped levels
-! at the top of the model.
-! See get_close_obs and models/cam/doc/highest_state_p_Pa.pptx for details.
-! This section must come after the definition of P0 and hyai.
-if (vert_coord == 'pressure') then
- ! CAM's model_top is 1/2 level above the highest state variable level, so
- ! hyai instead of hyam.
- ! P0 is in Pa.
- model_top = hyai%vals(1)*P0%vals(1)
- ! The (lon,lat) here must match the ones in the definition of vert_only_loc in get_close_obs.
- ! FIXME; is this hard-coding OK?
- highest_state_loc = set_location(1.0_r8,1.0_r8,highest_state_pressure_Pa,VERTISPRESSURE)
- model_top_loc = set_location(1.0_r8,1.0_r8,model_top, VERTISPRESSURE)
- ! damp_wght must be in the same units (dist = radians) as the distances in get_close_obs.
- if (highest_state_pressure_Pa /= model_top) then
- damp_wght = 1.0_r8/get_dist(highest_state_loc,model_top_loc,no_vert=.false.)
- endif
-else if (vert_coord == 'log_invP') then
- highest_state_scale_h = scale_height(p_surface=P0%vals(1), p_above=highest_state_pressure_Pa)
- model_top = scale_height(p_surface=P0%vals(1), p_above=(hyai%vals(1)*P0%vals(1)) )
- highest_state_loc = set_location(1.0_r8,1.0_r8,highest_state_scale_h,VERTISSCALEHEIGHT)
- model_top_loc = set_location(1.0_r8,1.0_r8,model_top, VERTISSCALEHEIGHT)
- if (highest_state_scale_h /= model_top) then
- damp_wght = 1.0_r8/get_dist(highest_state_loc,model_top_loc,no_vert=.false.)
- endif
-else
- write(string1, '(A,A)') 'Somehow vert_coord /= {pressure,log_invP}: ', vert_coord
- call error_handler(E_ERR,'static_init_model',string1,source,revision,revdate)
-endif
+if (do_nml_term()) write( * , nml=model_nml)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! # fields to read
-nflds = state_num_0d + state_num_1d + state_num_2d + state_num_3d
-if (print_details) then
- write(string1, '(A,I3,A,4I3)') '# of fields in state vector = ', nflds, &
- ' = sum of ', state_num_0d ,state_num_1d ,state_num_2d ,state_num_3d
- call error_handler(E_MSG,'static_init_model',string1,source,revision,revdate)
-endif
-
-! Order the state vector parts into cflds.
-allocate(cflds(nflds))
-call order_state_fields()
-! Construct array of variables to be clamped - used in filter netcdf write not in write_cam_init
-allocate(clampfield(nflds, 2))
-call set_clamp_fields(clampfield)
-
-! Add a component to the state vector
-component_id = add_domain('caminput.nc', nflds, cflds, clamp_vals = clampfield)
-deallocate(clampfield)
-
-! Compute overall model size and put in global storage
-model_size = get_domain_size(component_id)
-if (output_task0) then
- write(string1, '(A,I9)') 'CAM state vector size: ', model_size
- call error_handler(E_MSG, 'static_init_model', string1)
-endif
-
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Get field attributes needed by nc_write_model_atts from caminput.nc.
-allocate(state_long_names(nflds), state_units(nflds))
-call nc_read_model_atts(nc_file_ID, 'long_name', state_long_names)
-call nc_read_model_atts(nc_file_ID, 'units', state_units)
-
-call nc_check(nf90_close(nc_file_ID), &
- 'static_init_model', 'closing '//trim(model_config_file))
-
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! height
-! Get dimensions and surface geopotential from a new netcdf file and test for consistency.
-! Open file and read PHIS from it.
-! Allocate global variables which will be used in vertical interpolations
-! Check for pressures on vertically staggered grid, as well as standard grid.
-
-call read_cam_2Dreal(cam_phis, 'PHIS')
-
-max_levs = lev%length
-if (ilev%label /= '') max_levs = max(ilev%length, lev%length)
-
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! RMA-KR;
-! p_col is now a local variable, allocated when/where it's needed.
-! Fills arrays for the linking of obs_qtys (QTY_) to model field names
-call map_qtys()
-
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! If restricting impact of a particular kind to only obs and state vars
-! of the same kind, look up and set the kind index.
-! RMA-KR This will/may be replaced by Nancy's more general code for restricting
-! the influence of obs on listed variables.
-if (len_trim(impact_only_same_kind) > 0) then
- impact_kind_index = get_index_for_quantity(impact_only_same_kind)
-endif
-
-! This validates the namelist value and sets the module global value highest_obs_level.
-call set_highest_obs_limit()
+call set_calendar_type('GREGORIAN')
-end subroutine static_init_model
+call read_grid_info(cam_template_filename, grid_data)
-!-----------------------------------------------------------------------
+! initialize global values that are used frequently
+call init_globals()
-subroutine verify_namelist()
+! read the namelist &model_nml :: state_variables
+! to set up what will be read into the cam state vector
+call set_cam_variable_info(state_variables, nfields)
-! FIXME; PS must always be in the state vector;
-! always add PS in to state vector (if missing)
-! In the future we may want to let people not update PS in filter, or ...?
+! convert from string in namelist to integer (e.g. VERTISxxx)
+! and tell the dart code which vertical type we want to localize in.
+call set_vert_localization(vertical_localization_coord)
-integer :: i
-logical :: ps_present = .false.
-logical :: mismatch_which = .false.
-logical :: mismatch_size = .false.
+! if you have chemistry variables in the model state, set
+! this namelist variable so we can initialize the proper tables
+if (using_chemistry) call init_chem_tables()
-if (state_num_0d > 0) then
- if (state_names_0d(state_num_0d) == ' ' .or. &
- state_names_0d(state_num_0d+1) /= ' ') mismatch_size = .true.
+! set top limit where obs impacts are diminished to 0.
+! only allowed if doing vertical localization. error if
+! computing horizontal distances only (odd case, intentionally
+! choosing not to support this.)
+if (model_damping_ends_at_level > 0) then
+ if (vertical_localization_on()) then
+ call init_damping_ramp_info()
+ are_damping = .true.
+ else
+ string1='cannot support model top damping unless also using vertical localization'
+ string2='set "model_damping_ends_at_level = -1" in &model_nml, OR'
+ string3='set "horiz_dist_only = .false." in &location_nml'
+ call error_handler(E_ERR, routine, string1, source, revision, revdate, &
+ text2=string2, text3=string3)
+ endif
endif
-if (state_num_1d > 0) then
- if (state_names_1d(state_num_1d) == ' ' .or. &
- state_names_1d(state_num_1d+1) /= ' ') mismatch_size = .true.
- if ( which_vert_1d(state_num_1d) == MISSING_I .or. &
- which_vert_1d(state_num_1d+1) /= MISSING_I) mismatch_which = .true.
+! set top limit where obs are discarded. -1 to disable.
+if (no_obs_assim_above_level > 0) then
+ call init_discard_high_obs()
+ discarding_high_obs = .true.
endif
-if (state_num_2d > 0) then
- if (state_names_2d(state_num_2d) == ' ' .or. &
- state_names_2d(state_num_2d+1) /= ' ') mismatch_size = .true.
- if ( which_vert_2d(state_num_2d) == MISSING_I .or. &
- which_vert_2d(state_num_2d+1) /= MISSING_I) mismatch_which = .true.
-endif
+! set a flag based on the vertical localization coordinate selected
+call init_sign_of_vert_units()
-if (state_num_3d > 0) then
- if (state_names_3d(state_num_3d) == ' ' .or. &
- state_names_3d(state_num_3d+1) /= ' ') mismatch_size = .true.
- if ( which_vert_3d(state_num_3d) == MISSING_I .or. &
- which_vert_3d(state_num_3d+1) /= MISSING_I) mismatch_which = .true.
-endif
+end subroutine static_init_model
-if (mismatch_size) then
- write(string1,*) 'Mismatch between state_num_#d and state_names_#d in model_nml'
- call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
-endif
-if (mismatch_which) then
- write(string1,*) 'Mismatch between state_num_#d and which_vert_#d in model_nml'
- call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
-endif
+!-----------------------------------------------------------------------
+!> Returns the size of the DART state vector (i.e. model) as an integer.
+!>
-mismatch_which = .false.
-do i=1,max(state_num_1d,state_num_2d,state_num_3d)
- if (which_vert_1d(i) > 1 ) mismatch_which = .true.
- if (which_vert_2d(i) > 1 ) mismatch_which = .true.
- if (which_vert_3d(i) > 1 ) mismatch_which = .true.
+function get_model_size()
- ! PS can't be 0d or 3d.
- if (state_names_1d(i) == 'PS') ps_present = .true.
- if (state_names_2d(i) == 'PS') ps_present = .true.
-enddo
+integer(i8) :: get_model_size
-if (mismatch_which) then
- write(string1,*) 'The CAM model state is defined on levels and the surface. ', &
- ' which_vert_#d must be -2, -1, or 1 for each state variable.'
- call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
-endif
+if ( .not. module_initialized ) call static_init_model
+get_model_size = get_domain_size(domain_id)
-if (.not. ps_present) then
- write(string1,*) '"PS" (surface pressure) must be one of the state variables, but was not found'
- call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
-endif
+end function get_model_size
-if (vert_coord /= 'pressure' .and. vert_coord /= 'log_invP') then
- write(string1,*) 'vert_coord must be "pressure" or "log_invP"'
- call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
-endif
-end subroutine verify_namelist
!-----------------------------------------------------------------------
+!> Given an integer index into the state vector structure, returns the
+!> associated location. A second intent(out) optional argument quantity
+!> can be returned if the model has more than one type of field (for
+!> instance temperature and zonal wind component). This interface is
+!> required for all filter applications as it is required for computing
+!> the distance between observations and state variables.
+!>
+!> @param index_in the index into the DART state vector
+!> @param location the location at that index
+!> @param var_type the DART Quantity at that index
+!>
-subroutine read_cam_init_size(nc_file_ID)
-
-! Gets the number, names, and sizes of field dimensions from a CAM init netcdf file
-! in file_name (regardless of dynamical core).
-! Called by static_init_model (only).
-
-integer, intent(in) :: nc_file_ID
+subroutine get_state_meta_data(index_in, location, var_type)
-integer :: i,j
+integer(i8), intent(in) :: index_in
+type(location_type), intent(out) :: location
+integer, optional, intent(out) :: var_type
-if (.not. module_initialized) call static_init_model()
+! Local variables
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! learn how many dimensions are defined in this file.
-call nc_check(nf90_inquire(nc_file_ID, num_dims), 'read_cam_init_size', 'inquire num_dims')
+integer :: iloc, vloc, jloc
+integer :: myvarid, myqty, nd
-allocate(dim_names(num_dims), dim_sizes(num_dims))
+if ( .not. module_initialized ) call static_init_model
-! Cycle through dimension ids until there aren't any more.
-! dimension ids are sequential integers on the NetCDF file.
-do i = 1,num_dims
- call nc_check(nf90_inquire_dimension(nc_file_ID, i, dim_names(i), dim_sizes(i)), &
- 'read_cam_init_size', 'inquire for '//trim(dim_names(i)))
- if (print_details .and. output_task0) then
- write(string1,*) 'Dims info = ',i, trim(dim_names(i)), dim_sizes(i)
- call error_handler(E_MSG, 'read_cam_init_size', string1,source,revision,revdate)
- endif
+call get_model_variable_indices(index_in, iloc, jloc, vloc, var_id=myvarid, kind_index=myqty)
-enddo
+nd = get_num_dims(domain_id, myvarid)
-! Find and store shapes of all the state vector fields. Grouped by rank of fields into
-! separate f_dim_RANKd arrays.
-call read_coord(nc_file_ID)
+location = get_location_from_index(iloc, jloc, vloc, myqty, nd)
+! return state quantity for this index if requested
+if (present(var_type)) var_type = myqty
-! The arrays into which CAM fields are put are dimensioned by the largest values of
-! the sizes of the dimensions listed in Y_dim_RANKd, Y=[sf], RANK=[1-3] .
-! The second dimension denotes the rank of the array for which the first dim
-! gives the max size(s).
-if (state_num_1d > 0) then
- f_dim_max(1:2, 1) = maxval(f_dim_1d, dim=2) ! gets the max value of f_dim_1d (1:2, :)
-else
- f_dim_max(1:2, 1) = 0
-endif
+end subroutine get_state_meta_data
-if (state_num_2d > 0) then
- f_dim_max(1:3, 2) = maxval(f_dim_2d, dim=2) ! gets the max values of f_dim_2d (1:3, :)
+!-----------------------------------------------------------------------
+!> given the (i,j,k) indices into a field in the state vector,
+!> and the quantity, and the dimensionality of the field (2d, 3d),
+!> compute the location of that item.
+
+function get_location_from_index(i, j, k, q, nd)
+integer, intent(in) :: i
+integer, intent(in) :: j
+integer, intent(in) :: k
+integer, intent(in) :: q
+integer, intent(in) :: nd
+type(location_type) :: get_location_from_index
+
+real(r8) :: slon_val
+real(r8) :: use_vert_val
+integer :: use_vert_type
+
+! full 3d fields are returned with lon/lat/level.
+! 2d fields are either surface fields, or if they
+! are column integrated values then they are 'undefined'
+! in the vertical.
+
+if (nd == 3) then
+ use_vert_type = VERTISLEVEL
+ use_vert_val = real(k,r8)
else
- f_dim_max(1:3, 2) = 0
+ if (q == QTY_SURFACE_ELEVATION .or. q == QTY_SURFACE_PRESSURE) then
+ use_vert_type = VERTISSURFACE
+ use_vert_val = MISSING_R8
+ ! setting the vertical value to missing matches what the previous
+ ! version of this code did. other models choose to set the vertical
+ ! value to the actual surface elevation at this location:
+ ! use_vert_val = phis(lon_index, lat_index) / gravity
+ else
+ ! assume other 2d fields are integrated quantities with no vertical
+ ! location. if there are other real surface fields in the state
+ ! add their quantitys to the if() test above.
+ use_vert_type = VERTISUNDEF
+ use_vert_val = MISSING_R8
+ endif
endif
-if (state_num_3d > 0) then
- f_dim_max(1:4, 3) = maxval(f_dim_3d, dim=2) ! gets the max values of f_dim_3d (1:4, :)
-else
- f_dim_max(1:4, 3) = 0
-endif
+! the horizontal location depends on whether this quantity is on the
+! mass point grid or staggered in either lat or lon.
-if (print_details .and. output_task0 ) then
- if (state_num_1d > 0) then
- write(string1,*) 'f_dim_1d = ',f_dim_1d
- write(string2,*) (f_dim_max(i,1),i=1,3)
- call error_handler(E_MSG, 'read_cam_init_size', string1,source,revision,revdate, text2=string2)
- endif
+select case (grid_stagger%qty_stagger(q))
+ case (STAGGER_U)
+ get_location_from_index = set_location(grid_data%lon%vals(i), &
+ grid_data%slat%vals(j), &
+ use_vert_val, use_vert_type)
- do i=1,2
- write(string1,*) 'f_dim_2d = ',(f_dim_2d(i,j),j=1,state_num_2d),'f_dim_max = ',f_dim_max(i,2)
- call error_handler(E_MSG, 'read_cam_init_size', string1,source,revision,revdate)
- enddo
+ case (STAGGER_V)
+ ! the first staggered longitude is negative. dart requires lons
+ ! be between 0 and 360.
+ slon_val = grid_data%slon%vals(i)
+ if (slon_val < 0) slon_val = slon_val + 360.0_r8
+ get_location_from_index = set_location(slon_val, &
+ grid_data%lat%vals(j), &
+ use_vert_val, use_vert_type)
+
+ !>@todo not sure what to do yet. ? +-1/2 ?
+ case (STAGGER_W)
+ get_location_from_index = set_location(grid_data%lon%vals(i), &
+ grid_data%lat%vals(j), &
+ use_vert_val - 0.5_r8, use_vert_type)
+ ! no stagger - cell centers
+ case default
+ get_location_from_index = set_location(grid_data%lon%vals(i), &
+ grid_data%lat%vals(j), &
+ use_vert_val, use_vert_type)
- do i=1,3
- write(string1,'(A,(10I4))') 'f_dim_3d = ',(f_dim_3d(i,j),j=1,state_num_3d)
- write(string2,'(A,(10I4))') 'f_dim_max = ',f_dim_max(i,3)
- call error_handler(E_MSG, 'read_cam_init_size', string1,source,revision,revdate, text2=string2)
- enddo
-endif
+end select
-end subroutine read_cam_init_size
+end function get_location_from_index
!-----------------------------------------------------------------------
+!> this routine should be called to compute a value that comes from an
+!> unstaggered grid but needs to correspond to a staggered grid.
+!> e.g. you need the surface pressure under a V wind point.
-subroutine read_coord(nc_file_ID)
-
-! Figure out which coordinates are lon, lat, lev, based on CAM version
-! from the namelist, which has form #.#[.#[.#]].
+subroutine get_staggered_values_from_qty(ens_handle, ens_size, qty, lon_index, lat_index, &
+ lev_index, stagger_qty, vals, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: qty
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: lev_index
+integer, intent(in) :: stagger_qty
+real(r8), intent(out) :: vals(ens_size)
+integer, intent(out) :: my_status
-integer, intent(in) :: nc_file_ID
+integer :: next_lat, prev_lon, stagger
+real(r8) :: vals1(ens_size), vals2(ens_size)
-! local workspace
-character(len=4) :: form_version = '(I0)'
-character(len=4) :: char_version
-integer :: part, nchars, tot_chars, i, j, k, varid, next
-integer :: int_version(4)
+vals(:) = MISSING_R8
+stagger = grid_stagger%qty_stagger(stagger_qty)
-int_version = (/ (0,i=1,4) /)
+!> latitudes: staggered value N is between N and (N + 1) on the unstaggered grid
+!> longitudes: staggered value N is between N and (N - 1) on the unstaggered grid
-! Choose order . . . no longer needed because this model_mod is specialized to
-! CAM-FV in CESM1.x and later.
+select case (stagger)
+ case (STAGGER_U)
+ call quad_index_neighbors(lon_index, lat_index, prev_lon, next_lat)
-! Cycle through each field's dimension IDs.
-! Pick the dimensions needed out of dim_sizes, using the dimension names in dim_names.
-! Fill the state dimids according to the order model_mod wants to see. (lev, lon, lat).
+ call get_values_from_single_level(ens_handle, ens_size, qty, lon_index, lat_index, lev_index, &
+ vals1, my_status)
+ if (my_status /= 0) return
+ call get_values_from_single_level(ens_handle, ens_size, qty, lon_index, next_lat, lev_index, &
+ vals2, my_status)
+ if (my_status /= 0) return
-! 3D
-if (state_num_3d > 0) then
- allocate(f_dim_3d(4,state_num_3d), f_dimid_3d(4,state_num_3d))
- f_dim_3d = 0
- f_dimid_3d = 0
-endif
+ vals = (vals1 + vals2) * 0.5_r8
-do i = 1,state_num_3d
- ! Get variable id for a 3d field
- call nc_check(nf90_inq_varid(nc_file_ID, state_names_3d(i), varid), &
- 'trans_coord', 'inq_varid '//trim(state_names_3d(i)))
- ! Get dimension ids for the dimensions of the field
- call nc_check(nf90_inquire_variable(nc_file_ID, varid, dimids=f_dimid_3d(1:4,i)), &
- 'trans_coord', 'inquire_variable'//trim(state_names_3d(i)))
-
- Alldim3: do j = 1,4 ! time and 3 space
- k = f_dimid_3d(j,i) ! shorthand; the dimid of this fields current dim
- f_dim_3d(j,i) = dim_sizes(k)
- enddo Alldim3
-
- if ( f_dim_3d(1,i) == 0 .or. f_dim_3d(2,i) == 0 .or. f_dim_3d(3,i) == 0 ) then
- call error_handler(E_ERR, 'trans_coord', &
- 'num_[lons,lats,levs] was not assigned and = 0' , source, revision, revdate)
- endif
-enddo
+ case (STAGGER_V)
+ call quad_index_neighbors(lon_index, lat_index, prev_lon, next_lat)
-! 2D
-if (state_num_2d > 0) then
- allocate(f_dim_2d(3,state_num_2d), f_dimid_2d(3,state_num_2d))
- f_dim_2d = 0; f_dimid_2d = 0;
-endif
+ call get_values_from_single_level(ens_handle, ens_size, qty, lon_index, lat_index, lev_index, &
+ vals1, my_status)
+ if (my_status /= 0) return
+ call get_values_from_single_level(ens_handle, ens_size, qty, prev_lon, lat_index, lev_index, &
+ vals2, my_status)
+ if (my_status /= 0) return
-do i = 1,state_num_2d
- call nc_check(nf90_inq_varid(nc_file_ID, state_names_2d(i), varid), &
- 'trans_coord', 'inq_varid '//trim(state_names_2d(i)))
- call nc_check(nf90_inquire_variable(nc_file_ID, varid, dimids=f_dimid_2d(1:3,i)), &
- 'trans_coord', 'inquire_variable '//trim(state_names_2d(i)))
-
- ! Extract spatial dimids from the fields dimids
- Alldim2: do j = 1,3 ! time and 2 space
- k = f_dimid_2d(j,i)
- f_dim_2d(j,i) = dim_sizes(k)
- enddo Alldim2
- if ( f_dim_2d(1,i) == 0 .or. f_dim_2d(2,i) == 0 ) then
- call error_handler(E_ERR, 'trans_coord', &
- 'num_[lons,lats,levs] was not assigned and = 0' , source, revision, revdate)
- endif
-enddo
+ vals = (vals1 + vals2) * 0.5_r8
-! 1D
-if (state_num_1d > 0) then
- allocate(f_dim_1d(2,state_num_1d), f_dimid_1d(2,state_num_1d))
- f_dim_1d = 0; f_dimid_1d = 0;
-endif
+ ! no stagger - cell centers, or W stagger
+ case default
+ call get_values_from_single_level(ens_handle, ens_size, qty, lon_index, lat_index, lev_index, &
+ vals, my_status)
+ if (my_status /= 0) return
-do i = 1,state_num_1d
- call nc_check(nf90_inq_varid (nc_file_ID, state_names_1d(i), varid), &
- 'trans_coord', 'inq_varid '//trim(state_names_1d(i)))
- call nc_check(nf90_inquire_variable(nc_file_ID, varid, dimids=f_dimid_1d(1:2,i)), &
- 'trans_coord', 'inq_varid '//trim(state_names_1d(i)))
+end select
- Alldim1: do j = 1,2 ! time and 1 space
- k = f_dimid_1d(j,i)
- f_dim_1d(j,i) = dim_sizes(k)
- enddo Alldim1
+! when you reach here, my_status has been to 0 by the last call
+! to get_values_from_single_level(). if it was anything else
+! it would have already returned.
- if ( f_dim_1d(1, i) == 0 ) then
- write(string1, '(A,I3,A)') ' state 1d dimension(',i,') was not assigned and = 0'
- call error_handler(E_ERR, 'trans_coord',trim(string1), source, revision, revdate)
- endif
-enddo
+end subroutine get_staggered_values_from_qty
-end subroutine read_coord
!-----------------------------------------------------------------------
+!> this routine converts the 3 index values and a quantity into a state vector
+!> offset and gets the ensemble of state values for that offset. this only
+!> gets a single vertical location - if you need to get values which might
+!> have different vertical locations in different ensemble members
+!> see get_values_from_varid() below.
+
+subroutine get_values_from_single_level(ens_handle, ens_size, qty, lon_index, lat_index, lev_index, &
+ vals, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: qty
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: lev_index
+real(r8), intent(out) :: vals(ens_size)
+integer, intent(out) :: my_status
+
+character(len=*), parameter :: routine = 'get_values_from_single_level:'
+
+integer :: varid
+integer(i8) :: state_indx
+
+varid = get_varid_from_kind(domain_id, qty)
+if (varid < 0) then
+ vals(:) = MISSING_R8
+ my_status = 12
+ return
+endif
-subroutine read_cam_2Dreal(file_name, cfield)
-
-! Subroutine to read in a 2D/horizontal CAM field, such as PHIS.
-! Handles both logically rectangular arrays (FV and Eul) and irregular
-! (SE-CAM/cubed-sphere).
-
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-character(len=*), intent(in) :: file_name
-character(len=*), intent(in) :: cfield
+state_indx = get_dart_vector_index(lon_index, lat_index, lev_index, domain_id, varid)
+if (state_indx < 1 .or. state_indx > get_domain_size(domain_id)) then
+ write(string1, *) 'state_index out of range: ', state_indx, ' not between ', 1, get_domain_size(domain_id)
+ call error_handler(E_ERR,routine,string1,source,revision,revdate,text2=string2,text3='should not happen')
+endif
+vals(:) = get_state(state_indx, ens_handle)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+my_status = 0
-integer :: nc_file_ID, nc_var_ID ! NetCDF variables
-integer :: field_dim_IDs(3) ! Array of dimension IDs for cfield
- ! (2 space (FV) and time dimension (CAM .h0. files).
-integer :: i_dim1, i_dim2 ! Variables to reference the dimension(s) of cfield
-integer :: num_dim1, num_dim2 ! NetCDF file variable dimension sizes, for comparison to file_name's
-integer :: slon_index, slat_index, lon_index, lat_index !indices of [s]lon and [s]lat
- ! within the list of dimensions
-integer :: n,m
-character(len=NF90_MAX_NAME) :: name_dim1,name_dim2 ! Names of dimensions of cfield
-real(r8), allocatable :: var(:,:) ! Temp array used by nc_get_var
+end subroutine get_values_from_single_level
-field_dim_IDs = MISSING_I ! Array of dimension IDs for cfield
-if (file_name == cam_phis .and. .not.file_exist(trim(file_name))) then
- write(string1,'(2A)') trim(file_name), &
- ' is missing; trying to find a CAM history file (h0) to provide '//cfield
- call error_handler(E_WARN, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
-endif
+!-----------------------------------------------------------------------
+!> this routine takes care of getting the actual state values. get_state()
+!> communicates with other MPI tasks and can be expensive.
+!>
+!> all ensemble members have the same horizontal location, but different
+!> ensemble members could have different vertical locations and
+!> so be between different vertical layers. this code tries to do the fewest
+!> calls to get_state by only calling it for levels that are actually needed
+!> and setting all members with those same levels in a single pass.
+!>
-! Open the file and get dimension information.
-if (file_exist(trim(file_name))) then
- call nc_check(nf90_open(path=trim(file_name), mode=nf90_nowrite, ncid=nc_file_ID), &
- 'static_init_model:read_cam_2Dreal', 'opening '//trim(file_name))
- if (print_details .and. output_task0) then
- write(string1, *) 'file_name for ',cfield,' is ', trim(file_name)
- call error_handler(E_MSG, 'read_cam_2Dreal', string1,source,revision,revdate)
+subroutine get_values_from_varid(ens_handle, ens_size, lon_index, lat_index, lev_index, varid, &
+ vals, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: lev_index(ens_size)
+integer, intent(in) :: varid
+real(r8), intent(out) :: vals(ens_size)
+integer, intent(out) :: my_status(ens_size)
+
+integer(i8) :: state_indx
+integer :: i, j
+real(r8) :: temp_vals(ens_size)
+logical :: member_done(ens_size)
+
+character(len=*), parameter :: routine = 'get_values_from_varid:'
+
+! as we get the values for each ensemble member, we set the 'done' flag
+! and a good return code.
+my_status(:) = 12
+member_done(:) = .false.
+
+! start with lev_index(1). get the vals into a temp var.
+! run through 2-N. any other member that has the same level
+! set the outgoing values. keep a separate flag for which
+! member(s) have been done. skip to the next undone member
+! and get the state for that level. repeat until all levels done.
+
+do i=1, ens_size
+
+ if (member_done(i)) cycle
+
+ state_indx = get_dart_vector_index(lon_index, lat_index, lev_index(i), domain_id, varid)
+
+ if (state_indx < 0) then
+ write(string1,*) 'Should not happen: could not find dart state index from '
+ write(string2,*) 'lon, lat, and lev index :', lon_index, lat_index, lev_index
+ call error_handler(E_ERR,routine,string1,source,revision,revdate,text2=string2)
+ return
endif
- ! get field id
- call nc_check(nf90_inq_varid(nc_file_ID, trim(cfield), nc_var_ID), &
- 'read_cam_2Dreal', 'inq_varid: '//cfield)
-
- ! get dimension 'id's
- call nc_check(nf90_inquire_variable(nc_file_ID, nc_var_ID, dimids = field_dim_IDs), &
- 'read_cam_2Dreal', 'inquire_variable: '//cfield)
-
- ! get dimension sizes
- ! The first spatial dimension is always present.
- call nc_check(nf90_inquire_dimension(nc_file_ID, field_dim_IDs(1), name_dim1, num_dim1 ), &
- 'read_cam_2Dreal', 'inquire_dimension: '//name_dim1)
- if (field_dim_IDs(2) == MISSING_I) then
- num_dim2 = 1
- name_dim2 = 'no2ndDim'
- else
- call nc_check(nf90_inquire_dimension(nc_file_ID, field_dim_IDs(2), name_dim2, num_dim2 ), &
- 'read_cam_2Dreal', 'inquire_dimension: '//name_dim2)
- endif
+ temp_vals(:) = get_state(state_indx, ens_handle) ! all the ensemble members for level (i)
- ! Check for consistent dimensions between initial file and cam_phis file.
- if (file_name == cam_phis) then
- i_dim1 = dim_sizes(find_name(name_dim1,dim_names))
- if (num_dim1 /= i_dim1) then
- write(string1,'(A,2I8,A)') 'i_dim1, num_dim1, name_dim1 =' ,&
- i_dim1, num_dim1, trim(name_dim1)
- call error_handler(E_MSG, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
- write(string1,'(A,4I12)') 'horizontal dimensions mismatch of initial files and topog ' &
- ,i_dim1, num_dim1
- call error_handler(E_ERR, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
- endif
+ ! start at i, because my ensemble member is clearly at this level.
+ ! then continue on to see if any other members are also at this level.
+ do j=i, ens_size
+ if (member_done(j)) cycle
- if (field_dim_IDs(2) /= MISSING_I) then
- i_dim2 = dim_sizes(find_name(name_dim2,dim_names))
- if (num_dim2 /= i_dim2) then
- write(string1,'(A,2I8,A)') 'i_dim2, num_dim2, name_dim2 =', &
- i_dim2, num_dim2, trim(name_dim2)
- call error_handler(E_MSG, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
- write(string1,'(A,4I12)') 'horizontal dimensions mismatch of initial files and topog ', &
- i_dim2, num_dim2
- call error_handler(E_ERR, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
- endif
+ if (lev_index(j) == lev_index(i)) then
+ vals(j) = temp_vals(j)
+ member_done(j) = .true.
+ my_status(j) = 0
endif
- endif
-else
- write(string1,'(2A)') trim(file_name), &
- ' is missing; I do not know how to find it.'
- call error_handler(E_ERR, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
-endif
-
-! Allocate local arrays, based on size of this variable on the file.
-allocate(var(num_dim1, num_dim2))
+
+ enddo
+enddo
-! Read surface geopotential from cam_phis for use in vertical interpolation in height.
-! Coordinate order not affected by CAM model version.
-call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, var, start=(/ 1, 1 /), &
- count=(/ num_dim1, num_dim2 /)), 'read_cam_2Dreal', trim(cfield))
+end subroutine get_values_from_varid
-! assign values to phis grids for use by the rest of the module.
-if (cfield == 'PHIS') then
+!-----------------------------------------------------------------------
+!> this is just for 3d fields
+
+subroutine get_values_from_nonstate_fields(ens_handle, ens_size, lon_index, lat_index, &
+ lev_index, obs_quantity, vals, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: lev_index(ens_size)
+integer, intent(in) :: obs_quantity
+real(r8), intent(out) :: vals(ens_size)
+integer, intent(out) :: my_status(ens_size)
+
+integer :: imember
+real(r8) :: vals_array(ref_nlevels,ens_size)
+
+character(len=*), parameter :: routine = 'get_values_from_nonstate_fields:'
+
+vals(:) = MISSING_R8
+my_status(:) = 99
+
+select case (obs_quantity)
+ case (QTY_PRESSURE)
+ call cam_pressure_levels(ens_handle, ens_size, &
+ lon_index, lat_index, ref_nlevels, &
+ obs_quantity, vals_array, my_status)
+ if (any(my_status /= 0)) return
+
+ do imember=1,ens_size
+ vals(imember) = vals_array(lev_index(imember), imember)
+ enddo
- if (alloc_phis) allocate(phis(num_dim1, num_dim2))
- ! Don't want to set alloc_phis = false yet; there may be staggered phis to set.
- phis(1:num_dim1,1:num_dim2) = var
+ case (QTY_VERTLEVEL)
+ vals(:) = lev_index(:)
+ my_status(:) = 0
- ! If needed, generate phis on the staggered grids.
- slon_index = find_name('slon',dim_names)
- slat_index = find_name('slat',dim_names)
- lat_index = find_name('lat',dim_names)
- lon_index = find_name('lon',dim_names)
+ case default
+ write(string1,*)'contact dart support. unexpected error for quantity ', obs_quantity
+ call error_handler(E_MSG,routine,string1,source,revision,revdate)
- alloc_phis = .false.
+end select
-endif
+end subroutine get_values_from_nonstate_fields
-call nc_check(nf90_close(nc_file_ID), 'read_cam_2Dreal', 'closing '//trim(file_name))
+!-----------------------------------------------------------------------
+!>
+!> Model interpolate will interpolate any DART state variable
+!> to the given location.
+!>
+!> @param state_handle DART ensemble handle
+!> @param ens_size DART ensemble size
+!> @param location the location of interest
+!> @param obs_qty the DART Quantity of interest
+!> @param interp_vals the estimated value of the DART state at the location
+!> of interest (the interpolated value).
+!> @param istatus interpolation status ... 0 == success, /=0 is a failure
+!>
+!> istatus = 2 asked to interpolate an unknown/unsupported quantity
+!> istatus = 3 cannot locate horizontal quad
+!> istatus = 4 cannot locate enclosing vertical levels
+!> istatus = 5 cannot retrieve state vector values
+!> istatus = 6 cannot get values at quad corners
+!> istatus = 7 unused (error code available)
+!> istatus = 8 cannot interpolate in the quad to get the values
+!> istatus = 9 unused (error code available)
+!> istatus = 10 cannot get vertical levels for an obs on pressure levels
+!> istatus = 11 cannot get vertical levels for an obs on height levels
+!> istatus = 12 cannot get values from obs quantity
+!> istatus = 13 can not interpolate values of this quantity
+!> istatus = 14 obs above user-defined assimilation top pressure
+!> istatus = 15 can not get indices from given state vector index
+!> istatus = 16 cannot do vertical interpolation for bottom layer
+!> istatus = 17 cannot do vertical interpolation for top layer
+!> istatus = 98 unknown error - shouldn't happen
+!> istatus = 99 unknown error - shouldn't happen
+!>
-deallocate(var)
+subroutine model_interpolate(state_handle, ens_size, location, obs_qty, interp_vals, istatus)
-end subroutine read_cam_2Dreal
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+integer, intent(in) :: obs_qty
+real(r8), intent(out) :: interp_vals(ens_size) !< array of interpolated values
+integer, intent(out) :: istatus(ens_size)
-!-----------------------------------------------------------------------
+character(len=*), parameter :: routine = 'model_interpolate:'
-subroutine read_cam_2Dint(file_name, cfield, field, num_dim1, num_dim2)
+integer :: varid, which_vert, status1
+integer :: four_lons(4), four_lats(4)
+integer :: status_array(ens_size)
+real(r8) :: lon_fract, lat_fract
+real(r8) :: lon_lat_vert(3)
+real(r8) :: quad_vals(4, ens_size)
+type(quad_interp_handle) :: interp_handle
-! Read 2d integer field from, e.g., HommeMapping.nc
+if ( .not. module_initialized ) call static_init_model
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-character(len=*), intent(in) :: file_name
-character(len=*), intent(in) :: cfield
-integer, allocatable, intent(out) :: field(:,:)
-integer, intent(out) :: num_dim1 !The dimension(s) of cfield
-integer, intent(out) :: num_dim2
+! Successful istatus is 0
+interp_vals(:) = MISSING_R8
+istatus(:) = 99
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! do we know how to interpolate this quantity?
+call ok_to_interpolate(obs_qty, varid, status1)
-integer :: nc_file_ID, nc_var_ID !NetCDF variables
-integer :: field_dim_IDs(2) !Array of dimension IDs for cfield
-character(len=NF90_MAX_NAME) :: name_dim1,name_dim2 !Names of dimensions of cfield
+if (status1 /= 0) then
+ if(debug_level > 12) then
+ write(string1,*)'did not find observation quantity ', obs_qty, ' in the state vector'
+ call error_handler(E_MSG,routine,string1,source,revision,revdate)
+ endif
+ istatus(:) = status1 ! this quantity not in the state vector
+ return
+endif
-field_dim_IDs = MISSING_I !Array of dimension IDs for cfield
+! get the grid handle for the right staggered grid
+interp_handle = get_interp_handle(obs_qty)
-if (file_exist(file_name)) then
- call nc_check(nf90_open(path=trim(file_name), mode=nf90_nowrite, ncid=nc_file_ID), &
- 'read_cam_2Dint', 'opening '//trim(file_name))
- if (print_details .and. output_task0) then
- write(string1,*) 'file_name for ',cfield,' is ', trim(file_name)
- call error_handler(E_MSG, 'read_cam_2Dint', string1,source,revision,revdate)
- endif
+! unpack the location type into lon, lat, vert, vert_type
+lon_lat_vert = get_location(location)
+which_vert = nint(query_location(location))
- ! get field id
- call nc_check(nf90_inq_varid(nc_file_ID, trim(cfield), nc_var_ID), &
- 'read_cam_2Dint', 'inq_varid: '//cfield)
-
- ! get dimension 'id's
- call nc_check(nf90_inquire_variable(nc_file_ID, nc_var_ID, dimids=field_dim_IDs), &
- 'read_cam_2Dint', 'inquire_variable: '//cfield)
-
- ! get dimension sizes
- ! The first spatial dimension is always present.
- call nc_check(nf90_inquire_dimension(nc_file_ID, field_dim_IDs(1), name_dim1, num_dim1 ), &
- 'read_cam_2Dint', 'inquire_dimension: '//name_dim1)
- if (field_dim_IDs(2) /= MISSING_I) then
- call nc_check(nf90_inquire_dimension(nc_file_ID, field_dim_IDs(2), name_dim2, num_dim2 ), &
- 'read_cam_2Dint', 'inquire_dimension: '//name_dim2)
- else
- num_dim2 = 1
- name_dim2 = 'no2ndDim'
- endif
+! get the indices for the 4 corners of the quad in the horizontal, plus
+! the fraction across the quad for the obs location
+call quad_lon_lat_locate(interp_handle, lon_lat_vert(1), lon_lat_vert(2), &
+ four_lons, four_lats, lon_fract, lat_fract, status1)
+if (status1 /= 0) then
+ istatus(:) = 3 ! cannot locate enclosing horizontal quad
+ return
+endif
- if (print_details .and. output_task0) then
- write(string1,*) cfield,' dimensions num_dim1, num_dim2 = ',num_dim1, num_dim2
- call error_handler(E_MSG, 'read_cam_2Dint', string1,source,revision,revdate)
+! if we are avoiding assimilating obs above a given pressure, test here and return.
+if (discarding_high_obs) then
+ call obs_too_high(lon_lat_vert(3), which_vert, status1)
+ if (status1 /= 0) then
+ istatus(:) = status1
+ return
endif
-else
- write(string1,'(3A)') 'Required file "',trim(file_name),'" is missing.'
- call error_handler(E_ERR, 'read_cam_2Dint', string1, source, revision, revdate)
endif
-! Allocate array, based on size of this variable on the file.
-allocate(field(num_dim1,num_dim2))
+call get_quad_vals(state_handle, ens_size, varid, obs_qty, four_lons, four_lats, &
+ lon_lat_vert, which_vert, quad_vals, status_array)
-if (field_dim_IDs(2) /= MISSING_I) then
- call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, field, start=(/ 1, 1 /), &
- count=(/ num_dim1, num_dim2 /)), 'read_cam_2Dint', trim(cfield))
-else
- call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, field), &
- 'read_cam_2Dint', trim(cfield))
+!>@todo FIXME : Here we are failing if any ensemble member fails. Instead
+!> we should be using track status...
+if (any(status_array /= 0)) then
+ istatus(:) = maxval(status_array) ! cannot get the state values at the corners
+ return
endif
-call nc_check(nf90_close(nc_file_ID), 'read_cam_2Dint', 'closing '//trim(file_name))
+! do the horizontal interpolation for each ensemble member
+call quad_lon_lat_evaluate(interp_handle, lon_fract, lat_fract, ens_size, &
+ quad_vals, interp_vals, status_array)
-end subroutine read_cam_2Dint
+if (any(status_array /= 0)) then
+ istatus(:) = 8 ! cannot evaluate in the quad
+ return
+endif
-!-----------------------------------------------------------------------
+if (using_chemistry) &
+ interp_vals = interp_vals * get_volume_mixing_ratio(obs_qty)
-subroutine nc_read_model_atts(nc_file_ID, att, att_vals)
+! all interp values should be set by now. set istatus
+istatus(:) = 0
-! reads the value of an attribute for each of the fields in cflds.
-!
-! should be called with att = one of the attributes from the program variable
-! input file, which will be written to the Posterior and Prior.nc files
+end subroutine model_interpolate
-integer, intent(in) :: nc_file_ID
-character(len=*), intent(in) :: att
-character(len=nf90_max_name), intent(out) :: att_vals(nflds)
+!-----------------------------------------------------------------------
+!> internal only version of model interpolate.
+!> does not check for locations too high - return all actual values.
-integer :: i, ierr
-integer :: nc_var_ID, att_type
+subroutine interpolate_values(state_handle, ens_size, location, obs_qty, varid, &
+ interp_vals, istatus)
-if (print_details .and. output_task0) then
- write(string1,*) 'nc_read_model_atts: reading ',trim(att)
- call error_handler(E_MSG, 'nc_read_model_atts', string1,source,revision,revdate)
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+integer, intent(in) :: obs_qty
+integer, intent(in) :: varid
+real(r8), intent(out) :: interp_vals(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+character(len=*), parameter :: routine = 'interpolate_values:'
+
+integer :: which_vert, four_lons(4), four_lats(4)
+real(r8) :: lon_fract, lat_fract
+real(r8) :: lon_lat_vert(3), quad_vals(4, ens_size)
+type(quad_interp_handle) :: interp_handle
+
+interp_vals(:) = MISSING_R8
+istatus(:) = 99
+
+interp_handle = get_interp_handle(obs_qty)
+lon_lat_vert = get_location(location)
+which_vert = nint(query_location(location))
+
+call quad_lon_lat_locate(interp_handle, lon_lat_vert(1), lon_lat_vert(2), &
+ four_lons, four_lats, lon_fract, lat_fract, istatus(1))
+if (istatus(1) /= 0) then
+ istatus(:) = 3 ! cannot locate enclosing horizontal quad
+ return
endif
-do i = 1,nflds
- att_vals(i) = ' '
- call nc_check(nf90_inq_varid(nc_file_ID, cflds(i), nc_var_ID), 'nc_read_model_atts', &
- 'inq_varid '//trim(cflds(i)))
-
- ierr = nf90_inquire_attribute(nc_file_ID, nc_var_ID, att)
+call get_quad_vals(state_handle, ens_size, varid, obs_qty, four_lons, four_lats, &
+ lon_lat_vert, which_vert, quad_vals, istatus)
+if (any(istatus /= 0)) return
- if (ierr == nf90_noerr) then
- call nc_check(nf90_get_att(nc_file_ID, nc_var_ID, att, att_vals(i)), &
- 'nc_read_model_atts', 'get_att '//trim(att))
- if (print_details .and. output_task0) then
- write(string1,'(A,1X,I6,1X,A,1X,A)') att, nc_var_ID, cflds(i), trim(att_vals(i))
- call error_handler(E_MSG, 'nc_read_model_atts', string1,source,revision,revdate)
- endif
- endif
-enddo
+call quad_lon_lat_evaluate(interp_handle, lon_fract, lat_fract, ens_size, &
+ quad_vals, interp_vals, istatus)
+if (any(istatus /= 0)) then
+ istatus(:) = 8 ! cannot evaluate in the quad
+ return
+endif
-end subroutine nc_read_model_atts
+end subroutine interpolate_values
!-----------------------------------------------------------------------
+!> return my_status /= 0 if obs is above a user-defined threshold.
+!> intended to be quick (low-cost) and not exact.
-subroutine nc_read_global_int_att(nc_file_ID, att, att_val)
-
-! Reads the value of a global attribute.
+subroutine obs_too_high(vert_value, which_vert, my_status)
+real(r8), intent(in) :: vert_value
+integer, intent(in) :: which_vert
+integer, intent(out) :: my_status
-integer, intent(in) :: nc_file_ID
-character(len=*), intent(in) :: att
-integer, intent(out) :: att_val
+! assume ok to begin with
+my_status = 0
-integer :: ierr
-
-! NF90_GLOBAL is the psuedo-variable name used for global attributes.
-ierr = nf90_inquire_attribute(nc_file_ID, NF90_GLOBAL, att)
-
-if (ierr == nf90_noerr) then
- call nc_check(nf90_get_att(nc_file_ID, NF90_GLOBAL, att, att_val), &
- 'nc_read_global_int_att', 'get_att '//trim(att))
- if (print_details .and. output_task0) then
- write(string1,'(A,I5,2A, I6)') 'nc_read_global_int_att for file ',nc_file_ID, &
- ' attribute and value = ',trim(att), att_val
- call error_handler(E_MSG, 'nc_read_global_int_att', string1,source,revision,revdate)
- endif
+if (which_vert == VERTISPRESSURE) then
+ ! lower pressures are higher; watch the less than/greater than tests
+ if (vert_value < no_assim_above_pressure) my_status = 14
+ return
endif
-end subroutine nc_read_global_int_att
+! these are always ok
+if (which_vert == VERTISSURFACE .or. which_vert == VERTISUNDEF) return
-!-----------------------------------------------------------------------
-
-subroutine read_cam_coord(nc_file_ID, cfield, var)
-
-! read CAM 'initial' file coordinate, i.e. 'lat', 'lon', 'gw', 'hyai',...
-
-integer, intent(in) :: nc_file_ID
-character(len=*), intent(in) :: cfield
-type(grid_1d_type), intent(out) :: var
-
-integer :: i, coord_size ! grid/array indices
-integer :: nc_var_ID ! file and field IDs
-integer :: fld_exist ! grid field may not exist CAM initial file (e.g. slat)
-integer :: ncerr ! other nc errors; don't abort
-integer :: coord_dimid(1) ! Coordinates can have only 1 dimension,
- ! but this must be a vector.
-
-! Some attributes are _Fillvalue (real) which I'll ignore for now.
-! The following are used to repack the attributes I want into a compact form
-integer :: num_atts, keep_atts
-integer :: att_type
-character(len=nf90_max_name) :: att_name
-character(len=nf90_max_name), allocatable :: att_names(:)
-character(len=nf90_max_name), allocatable :: att_vals(:)
-real(r8) :: resol, resol_1, resol_n
-
-! Moving this from the specification statement to here caused it to
-! be initialized every time read_cam_coord is called, and 'broke' it.
-! Previously, P0 may have ended up using the value left over from the last call,
-! which was for one of the initial file dimension variables, which was wrong,
-! but seems to have worked.
-coord_dimid = MISSING_I
-
-fld_exist = nf90_inq_varid(nc_file_ID, cfield, nc_var_ID)
-if (fld_exist /= nf90_noerr ) then
- var%label = ' '
+if (which_vert == VERTISHEIGHT) then
+ if (vert_value > no_assim_above_height) my_status = 14
return
endif
-ncerr = nf90_inquire_variable(nc_file_ID, nc_var_ID, dimids=coord_dimid, nAtts=num_atts)
-if (ncerr /= nf90_noerr ) then
- write(string1,*) 'Variable ',cfield,' dimids = ',coord_dimid(1)
- write(string2,*) 'NetCDF error code = ',nf90_strerror(ncerr)
- call error_handler(E_MSG, 'read_cam_coord', string1,source,revision,revdate, text2=string2)
- var%label = ' '
- var%dim_id = 0
+if (which_vert == VERTISLEVEL) then
+ ! level 1 is top; watch less than/greater than in tests
+ if (vert_value < no_assim_above_level) my_status = 14
return
endif
-if (print_details .and. output_task0) then
- write(string1,*) 'After inquire_variable for ',cfield,' coord_dimid = ',coord_dimid(1)
- call error_handler(E_MSG, 'read_cam_coord', string1,source,revision,revdate)
-endif
-
-if (coord_dimid(1) == MISSING_I) then
- ! to handle P0
- coord_size = 1
- coord_dimid(1) = 0 ! This is the dimid for time, which has length 1,
- ! But time is the record/unlimited dimension, so this may not work.
-else
- coord_size = dim_sizes(coord_dimid(1))
-endif
-
-allocate(att_names(num_atts), att_vals(num_atts))
-
-keep_atts = 0
-do i=1,num_atts
- call nc_check(nf90_inq_attname(nc_file_ID, nc_var_ID, i, att_name), &
- 'read_cam_coord', 'inq_attname '//trim(att_name))
+! for now we haven't run into observations where the vertical coordinate
+! (of the OBS) is in scale height - but if we do it will fall into here.
-! CAM FV initial files have coordinates with attributes that are numerical, not character
-! (_FillValue). These are not used because the coordinates are dimensioned exactly
-! the right size. I'll test for the type of att, and if it's not char, I'll ignore it.
+write(string2, *) 'vertical type: ', which_vert
+call error_handler(E_ERR, 'obs_too_high', 'unrecognized vertical type', &
+ source, revision, revdate, text2=string2)
-! Otherwise I need a var%atts_type and separate var%atts_vals_YYY for each NetCDF
-! external type (6 of them) I might run into.
+end subroutine obs_too_high
- call nc_check(nf90_inquire_attribute(nc_file_ID, nc_var_ID, att_name, xtype=att_type), &
- 'read_cam_coord', 'inquire_attribute '//trim(att_name))
+!-----------------------------------------------------------------------
+!>
- if (att_type == nf90_char) then
- keep_atts = keep_atts + 1
- att_vals(keep_atts) = ' '
- att_names(keep_atts) = att_name
- call nc_check(nf90_get_att(nc_file_ID, nc_var_ID, att_name, att_vals(keep_atts)), &
- 'read_cam_coord', 'get_att '//trim(att_name) )
+subroutine get_quad_vals(state_handle, ens_size, varid, obs_qty, four_lons, four_lats, &
+ lon_lat_vert, which_vert, quad_vals, my_status)
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: varid
+integer, intent(in) :: obs_qty
+integer, intent(in) :: four_lons(4)
+integer, intent(in) :: four_lats(4)
+real(r8), intent(in) :: lon_lat_vert(3)
+integer, intent(in) :: which_vert
+real(r8), intent(out) :: quad_vals(4, ens_size) !< array of interpolated values
+integer, intent(out) :: my_status(ens_size)
+
+integer :: icorner, numdims
+integer :: level_one_array(ens_size)
+integer :: four_levs1(4, ens_size), four_levs2(4, ens_size)
+real(r8) :: four_vert_fracts(4, ens_size)
+
+character(len=*), parameter :: routine = 'get_quad_vals:'
+
+quad_vals(:,:) = MISSING_R8
+my_status(:) = 99
+
+! need to consider the case for 2d vs 3d variables
+numdims = get_dims_from_qty(obs_qty, varid)
+
+! now here potentially we have different results for different
+! ensemble members. the things that can vary are dimensioned by ens_size.
+
+if (numdims == 3) then
+
+ ! build 4 columns to find vertical level numbers
+ do icorner=1, 4
+ call find_vertical_levels(state_handle, ens_size, &
+ four_lons(icorner), four_lats(icorner), lon_lat_vert(3), &
+ which_vert, obs_qty, varid, &
+ four_levs1(icorner, :), four_levs2(icorner, :), &
+ four_vert_fracts(icorner, :), my_status)
+ if (any(my_status /= 0)) return
+
+ enddo
+
+ ! we have all the indices and fractions we could ever want.
+ ! now get the data values at the bottom levels, the top levels,
+ ! and do vertical interpolation to get the 4 values in the columns.
+ ! the final horizontal interpolation will happen later.
+
+ if (varid > 0) then
+
+ call get_four_state_values(state_handle, ens_size, four_lons, four_lats, &
+ four_levs1, four_levs2, four_vert_fracts, &
+ varid, quad_vals, my_status)
+
+ else ! get 3d special variables in another ways ( like QTY_PRESSURE )
+ call get_four_nonstate_values(state_handle, ens_size, four_lons, four_lats, &
+ four_levs1, four_levs2, four_vert_fracts, &
+ obs_qty, quad_vals, my_status)
- else
- if (output_task0) then
- write(string1,*) ' ignoring attribute ',trim(att_name), &
- ' because it is not a character type'
- call error_handler(E_MSG, 'read_cam_coord', string1,source,revision,revdate)
- endif
endif
-enddo
-
-call create_grid_1d_instance(coord_size, keep_atts, var)
-! The rest of this routine populates 'var' with values.
+ if (any(my_status /= 0)) return
-var%label = cfield
-var%dim_id = coord_dimid(1)
+else if (numdims == 2) then
-do i = 1,keep_atts
- var%atts_names(i) = att_names(i)
- var%atts_vals(i) = att_vals(i)
-enddo
+ if (varid > 0) then
+ level_one_array(:) = 1
+ do icorner=1, 4
+ call get_values_from_varid(state_handle, ens_size, &
+ four_lons(icorner), four_lats(icorner), &
+ level_one_array, varid, quad_vals(icorner,:),my_status)
+ if (any(my_status /= 0)) return
-call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, var%vals, start=(/ 1 /), count=(/ coord_size /)), &
- 'read_cam_coord', 'get_var '//cfield)
+ enddo
-! Determine whether coordinate is regularly spaced,
-! If so, store the coordinate resolution in the grid_1d_type.
-if (cfield(1:2) == 'hy' .or. cfield(1:2) == 'P0') then
- var%resolution = MISSING_R8
-else
- resol_1 = var%vals(2) - var%vals(1)
- if (resol_1 /= 0.0_r8) then
- var%resolution = resol_1
-
- ! Test all other coordinate spacings. If any of them differ from the first
- ! by more than epsilon (smallest meaningful number relative to the coordinate spacings)
- ! then spacing is irregular.
- resol = 1.0_r8/resol_1
- Res: do i = 3,coord_size
- resol_n = var%vals(i) - var%vals(i-1)
- if (((resol_n - resol_1) *resol) > epsilon(resol_n)) then
- var%resolution = MISSING_R8
- exit Res
- endif
- enddo Res
- else
- var%resolution = MISSING_R8
+ else ! special 2d case
+ do icorner=1, 4
+ call get_quad_values(ens_size, four_lons(icorner), four_lats(icorner), &
+ obs_qty, obs_qty, quad_vals(icorner,:))
+ enddo
+ ! apparently this can't fail
+ my_status(:) = 0
+
endif
-endif
-if (print_details .and. output_task0) then
- write(string1,'(3A,I6,A,I8,A,1pE12.4)') 'reading ',cfield,' using id ',nc_var_ID, &
- ' size ',coord_size,' resolution ', var%resolution
- write(string2,*) 'first, last val: ', var%vals(1),var%vals(coord_size)
- call error_handler(E_MSG, 'read_cam_coord', string1,source,revision,revdate, text2=string2)
+else
+ write(string1, *) trim(get_name_for_quantity(obs_qty)), ' has dimension ', numdims
+ call error_handler(E_ERR, routine, 'only supports 2D or 3D fields', &
+ source, revision, revdate, text2=string1)
endif
-deallocate(att_names, att_vals)
+! when you get here, my_status() was set either by passing it to a
+! subroutine, or setting it explicitly here. if this routine returns
+! the default value of 99 something went wrong in this logic.
-end subroutine read_cam_coord
+end subroutine get_quad_vals
!-----------------------------------------------------------------------
+!>
+
+subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, &
+ four_levs1, four_levs2, four_vert_fracts, &
+ varid, quad_vals, my_status)
-subroutine create_grid_1d_instance(length, num_atts, var)
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: four_lons(4), four_lats(4)
+integer, intent(in) :: four_levs1(4, ens_size), four_levs2(4, ens_size)
+real(r8), intent(in) :: four_vert_fracts(4, ens_size)
+integer, intent(in) :: varid
+real(r8), intent(out) :: quad_vals(4, ens_size) !< array of interpolated values
+integer, intent(out) :: my_status(ens_size)
+
+integer :: icorner
+real(r8) :: vals1(ens_size), vals2(ens_size)
+
+character(len=*), parameter :: routine = 'get_four_state_values:'
+
+do icorner=1, 4
+ call get_values_from_varid(state_handle, ens_size, &
+ four_lons(icorner), four_lats(icorner), &
+ four_levs1(icorner, :), varid, vals1, &
+ my_status)
+
+ if (any(my_status /= 0)) then
+ my_status(:) = 16 ! cannot retrieve vals1 values
+ return
+ endif
-! Initializes an instance of a cam grid variable
+ call get_values_from_varid(state_handle, ens_size, &
+ four_lons(icorner), four_lats(icorner), &
+ four_levs2(icorner, :), varid, vals2, my_status)
+ if (any(my_status /= 0)) then
+ my_status(:) = 17 ! cannot retrieve top values
+ return
+ endif
-integer, intent(in ) :: length
-integer, intent(in ) :: num_atts
-type(grid_1d_type), intent(inout) :: var
-! Does 'var' need to have the TARGET attribute here?
-! Metcalf p 50 says 'yes'.
-! But Intel says that allocating an object gives it the target attribute:
-! "If an object does not have the TARGET attribute or has not been allocated
-! (using an ALLOCATE statement), no part of it can be accessed by a pointer."
-! And this has worked without specifying the 'target' attribute.
+ call vert_interp(ens_size, vals1, vals2, four_vert_fracts(icorner, :), &
+ quad_vals(icorner, :))
-! Initialize the storage space and return
-allocate(var%vals (length))
-allocate(var%atts_names(num_atts))
-allocate(var%atts_vals (num_atts))
+enddo
-var%length = length
-var%num_atts = num_atts
-end subroutine create_grid_1d_instance
+end subroutine get_four_state_values
!-----------------------------------------------------------------------
+!>
-subroutine end_grid_1d_instance(var)
-
-! Ends an instance of a cam grid_1d variable
+subroutine get_four_nonstate_values(state_handle, ens_size, four_lons, four_lats, &
+ four_levs1, four_levs2, four_vert_fracts, &
+ obs_qty, quad_vals, my_status)
-type(grid_1d_type), intent(inout) :: var
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: four_lons(4), four_lats(4)
+integer, intent(in) :: four_levs1(4, ens_size), four_levs2(4, ens_size)
+real(r8), intent(in) :: four_vert_fracts(4, ens_size)
+integer, intent(in) :: obs_qty
+real(r8), intent(out) :: quad_vals(4, ens_size) !< array of interpolated values
+integer, intent(out) :: my_status(ens_size)
+
+integer :: icorner
+real(r8) :: vals1(ens_size), vals2(ens_size)
+
+character(len=*), parameter :: routine = 'get_four_nonstate_values:'
+
+do icorner=1, 4
+ call get_values_from_nonstate_fields(state_handle, ens_size, &
+ four_lons(icorner), four_lats(icorner), &
+ four_levs1(icorner, :), obs_qty, vals1, my_status)
+ if (any(my_status /= 0)) then
+ my_status(:) = 16 ! cannot retrieve vals1 values
+ return
+ endif
-if (var%label == ' ') return
+ call get_values_from_nonstate_fields(state_handle, ens_size, &
+ four_lons(icorner), four_lats(icorner), &
+ four_levs2(icorner, :), obs_qty, vals2, my_status)
+ if (any(my_status /= 0)) then
+ my_status(:) = 17 ! cannot retrieve top values
+ return
+ endif
-if (.not. allocated(var%vals)) then
- write(string1,*) 'Calling end_grid_1d_instance on an uninitialized grid_1d_type'
- call error_handler(E_ERR,'end_grid_1d_instance',string1, source, revision, revdate)
-endif
+ call vert_interp(ens_size, vals1, vals2, four_vert_fracts(icorner, :), &
+ quad_vals(icorner, :))
-deallocate(var%vals, var%atts_names, var%atts_vals)
+enddo
-end subroutine end_grid_1d_instance
+end subroutine get_four_nonstate_values
!-----------------------------------------------------------------------
+!> figure out whether this is a 2d or 3d field based on the quantity.
+!> if this field is in the state vector, use the state routines.
+!> if it's not, there are cases for known other quantities we can
+!> interpolate and return. add any new non-state fields here.
-subroutine order_state_fields()
-
-! Fills cflds with state_names for use in I/O of caminput.nc.
+function get_dims_from_qty(obs_quantity, var_id)
+integer, intent(in) :: obs_quantity
+integer, intent(in) :: var_id
+integer :: get_dims_from_qty
-integer :: i, i1, nfld
+character(len=*), parameter :: routine = 'get_dims_from_qty:'
-nfld = 0
+if (var_id > 0) then
+ get_dims_from_qty = get_num_dims(domain_id,var_id)
+else
+ select case (obs_quantity)
+ case (QTY_SURFACE_ELEVATION)
+ get_dims_from_qty = 2
+ case (QTY_PRESSURE, QTY_GEOMETRIC_HEIGHT)
+ get_dims_from_qty = 3
+ case default
+ write(string1, *) 'we can not interpolate qty "', get_name_for_quantity(obs_quantity), &
+ '" if the dimension is not known'
+ call error_handler(E_ERR,routine, string1,source,revision,revdate)
+ end select
+endif
-! 0D fields
-do i=1,state_num_0d
- nfld = nfld + 1
- cflds(nfld)(:) = state_names_0d(i)
-enddo
+end function get_dims_from_qty
-! 1D fields (1 spatial *coordinate* on the CAM initial file.
-! The field may have 2 *physical* spatial dimensions.
-do i=1,state_num_1d
- nfld = nfld + 1
- cflds(nfld)(:) = state_names_1d(i)
-enddo
+!-----------------------------------------------------------------------
+!> return 0 (ok) if we know how to interpolate this quantity.
+!> if it is a field in the state, return the variable id from
+!> the state structure. if not in the state, varid will return -1
-! 2D fields
-do i=1,state_num_2d
- nfld = nfld + 1
- cflds(nfld)(:) = state_names_2d(i)
-enddo
+subroutine ok_to_interpolate(obs_qty, varid, my_status)
+integer, intent(in) :: obs_qty
+integer, intent(out) :: varid
+integer, intent(out) :: my_status
-! 3D fields (including q)
-do i=1,state_num_3d
- nfld = nfld + 1
- cflds(nfld)(:) = state_names_3d(i)
-enddo
+! See if the state contains the obs quantity
+varid = get_varid_from_kind(domain_id, obs_qty)
-if (nfld /= nflds) then
- write(string1, *) 'nfld = ',nfld,', nflds = ',nflds,' must be equal '
- call error_handler(E_ERR, 'order_state_fields', string1, source, revision, revdate)
+! in the state vector
+if (varid > 0) then
+ my_status = 0
+ return
endif
+
-if (output_task0) then
- if (print_details) then
- write(string1,'(A)') 'State vector is composed of these fields: '
- call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
- ! write(string1,'((8(A8,1X)))') (cflds(i),i=1,nflds)
- do i=1,state_num_0d
- write(string1,'(A,I4)') cflds(i)
- call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
- end do
- i1 = state_num_0d
- do i=1,state_num_1d
- write(string1,'(A,I4)') cflds(i1+i)
- call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
- end do
- i1 = i1 + state_num_1d
- do i=1,state_num_2d
- write(string1,'(A,I4)') cflds(i1+i)
- call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
- end do
- i1 = i1 + state_num_2d
- do i=1,state_num_3d
- write(string1,'(A,I4)') cflds(i1+i)
- call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
- end do
- else
- call error_handler(E_MSG, 'order_state_fields', 'State vector is composed of these fields: ')
- do i = 1,nflds
- call error_handler(E_MSG, 'order_state_fields', trim(cflds(i)))
- enddo
- endif
-endif
+! add any quantities that can be interpolated to this list if they
+! are not in the state vector.
+select case (obs_qty)
+ case (QTY_SURFACE_ELEVATION, &
+ QTY_PRESSURE, &
+ QTY_GEOMETRIC_HEIGHT, &
+ QTY_VERTLEVEL)
+ my_status = 0
+ case default
+ my_status = 2
+end select
-end subroutine order_state_fields
-!-----------------------------------------------------------------------
+end subroutine ok_to_interpolate
-subroutine map_qtys()
-! ? Should this be a function instead; removes need to dimension obs_loc_in arbitrarily
-! and wastefully. But then it's called millions of times, instead of accessing a small
-! array that's defined once.
+!-----------------------------------------------------------------------
+!>
+!> This is for 2d special observations quantities not in the state
+
+subroutine get_quad_values(ens_size, lon_index, lat_index, obs_quantity, stagger_qty, vals)
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: obs_quantity
+integer, intent(in) :: stagger_qty
+real(r8), intent(out) :: vals(ens_size)
+
+character(len=*), parameter :: routine = 'get_quad_values'
+
+integer :: stagger, prev_lon, next_lat
+real(r8) :: vals1(ens_size), vals2(ens_size)
+
+stagger = grid_stagger%qty_stagger(stagger_qty)
+
+select case (obs_quantity)
+ case (QTY_SURFACE_ELEVATION)
+
+ select case (stagger)
+ case (STAGGER_U)
+ call quad_index_neighbors(lon_index, lat_index, prev_lon, next_lat)
+ vals1(:) = phis(lon_index, lat_index)
+ vals2(:) = phis(lon_index, next_lat)
+
+ vals = (vals1 + vals2) * 0.5_r8
+
+ case (STAGGER_V)
+ call quad_index_neighbors(lon_index, lat_index, prev_lon, next_lat)
+ vals1(:) = phis(lon_index, lat_index)
+ vals2(:) = phis(prev_lon, lat_index)
+
+ vals = (vals1 + vals2) * 0.5_r8
+
+ ! no stagger - cell centers, or W stagger
+ case default
+
+ vals = phis(lon_index, lat_index)
+
+ end select
+
+ !>@todo FIXME:
+ ! should this be using gravity at the given latitude?
+ vals = vals / gravity
+
+ case default
+ write(string1, *) 'we can not interpolate qty', obs_quantity
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
+
+end select
+
+end subroutine get_quad_values
-! Makes an array of 'locations within the state vector' of the obs kinds
-! that come from obs_kind_mod, which we anticipate CAM's model_mod will need.
-! The obs kind that's needed will be the index into this array,
-! the corresponding value will be the name of that field.
-! This name will be used with find_name.
-! This subroutine will be called from static_init_model, so it will not have to be
-! recomputed for every ob.
-! Also maps the model variable names onto the DART QTY_s by the same mechanism.
-! other QTY_ possibilities are listed after the 'use obs_kind_mod' statement
+!-----------------------------------------------------------------------
+!> interpolate in the vertical between 2 arrays of items.
+!>
+!> vert_fracts: 0 is 100% of the first level and
+!> 1 is 100% of the second level
-integer :: i
+subroutine vert_interp(nitems, levs1, levs2, vert_fracts, out_vals)
+integer, intent(in) :: nitems
+real(r8), intent(in) :: levs1(nitems)
+real(r8), intent(in) :: levs2(nitems)
+real(r8), intent(in) :: vert_fracts(nitems)
+real(r8), intent(out) :: out_vals(nitems)
-! Physically 2D fields
+out_vals(:) = (levs1(:) * (1.0_r8-vert_fracts(:))) + &
+ (levs2(:) * vert_fracts(:))
-i = find_name('PS',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SURFACE_PRESSURE) = 'PS'
- cam_to_dart_qtys(i) = QTY_SURFACE_PRESSURE
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+end subroutine vert_interp
-i = find_name('AEROD_v',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_AOD) = 'AEROD_v'
- cam_to_dart_qtys(i) = QTY_AOD
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+!-----------------------------------------------------------------------
+!> given lon/lat indices, add one to lat and subtract one from lon
+!> check for wraparound in lon, and north pole at lat.
+!> intent is that you give the indices into the staggered grid
+!> and the return values are the indices in the original unstaggered
+!> grid that you need to compute the midpoints for the staggers.
+!>@todo FIXME this needs a picture or ascii art
-i = find_name('SFCO',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFCO) = 'SFCO'
- cam_to_dart_qtys(i) = QTY_SFCO
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+subroutine quad_index_neighbors(lon_index, lat_index, prev_lon, next_lat)
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(out) :: prev_lon
+integer, intent(out) :: next_lat
-i = find_name('SFCO01',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFCO01) = 'SFCO01'
- cam_to_dart_qtys(i) = QTY_SFCO01
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+next_lat = lat_index+1
+if (next_lat > grid_data%lat%nsize) next_lat = grid_data%lat%nsize
-i = find_name('SFCO02',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFCO02) = 'SFCO02'
- cam_to_dart_qtys(i) = QTY_SFCO02
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+prev_lon = lon_index-1
+if (prev_lon < 1) prev_lon = grid_data%lon%nsize
-i = find_name('SFCO03',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFCO03) = 'SFCO03'
- cam_to_dart_qtys(i) = QTY_SFCO03
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+end subroutine quad_index_neighbors
-i = find_name('SFOC1',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFOC1) = 'SFOC1'
- cam_to_dart_qtys(i) = QTY_SFOC1
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
-i = find_name('SFOC2',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFOC2) = 'SFOC2'
- cam_to_dart_qtys(i) = QTY_SFOC2
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+!-----------------------------------------------------------------------
+!> given a lon/lat index number, a quantity and a vertical value and type,
+!> return which two levels these are between and the fraction across.
+!>
-i = find_name('SFCB1',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFCB1) = 'SFCB1'
- cam_to_dart_qtys(i) = QTY_SFCB1
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+subroutine find_vertical_levels(ens_handle, ens_size, lon_index, lat_index, vert_val, &
+ which_vert, obs_qty, var_id, levs1, levs2, vert_fracts, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+real(r8), intent(in) :: vert_val
+integer, intent(in) :: which_vert
+integer, intent(in) :: obs_qty
+integer, intent(in) :: var_id
+integer, intent(out) :: levs1(ens_size)
+integer, intent(out) :: levs2(ens_size)
+real(r8), intent(out) :: vert_fracts(ens_size)
+integer, intent(out) :: my_status(ens_size)
+
+character(len=*), parameter :: routine = 'find_vertical_levels:'
+
+integer :: l1, l2, imember, level_one, status1, k
+real(r8) :: fract1
+real(r8) :: surf_pressure ( ens_size )
+real(r8) :: pressure_array( ref_nlevels, ens_size )
+real(r8) :: height_array ( ref_nlevels, ens_size )
+
+! assume the worst
+levs1(:) = MISSING_I
+levs2(:) = MISSING_I
+vert_fracts(:) = MISSING_R8
+my_status(:) = 98
+
+! ref_nlevels is the number of vertical levels (midlayer points)
+
+level_one = 1
+
+select case (which_vert)
+
+ case(VERTISPRESSURE)
+ ! construct a pressure column here and find the model levels
+ ! that enclose this value
+ call get_staggered_values_from_qty(ens_handle, ens_size, QTY_SURFACE_PRESSURE, &
+ lon_index, lat_index, level_one, obs_qty, &
+ surf_pressure, status1)
+ if (status1 /= 0) then
+ my_status(:) = status1
+ return
+ endif
-i = find_name('SFCB2',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFCB2) = 'SFCB2'
- cam_to_dart_qtys(i) = QTY_SFCB2
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ call build_cam_pressure_columns(ens_size, surf_pressure, ref_nlevels, pressure_array)
-i = find_name('SFOC102',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFOC102) = 'SFOC102'
- cam_to_dart_qtys(i) = QTY_SFOC102
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ do imember=1, ens_size
+ call pressure_to_level(ref_nlevels, pressure_array(:, imember), vert_val, &
+ levs1(imember), levs2(imember), &
+ vert_fracts(imember), my_status(imember))
-i = find_name('SFOC202',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFOC202) = 'SFOC202'
- cam_to_dart_qtys(i) = QTY_SFOC202
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ enddo
-i = find_name('SFCB102',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFCB102) = 'SFCB102'
- cam_to_dart_qtys(i) = QTY_SFCB102
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ if (debug_level > 100) then
+ do k = 1,ens_size
+ print*, 'ISPRESSURE levs1(k), levs2(k), vert_fracts(k), vert_val', &
+ levs1(k), levs2(k), vert_fracts(k), vert_val
+ enddo
+ endif
-i = find_name('SFCB202',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SFCB202) = 'SFCB202'
- cam_to_dart_qtys(i) = QTY_SFCB202
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ case(VERTISHEIGHT)
+ ! construct a height column here and find the model levels
+ ! that enclose this value
+ call cam_height_levels(ens_handle, ens_size, lon_index, lat_index, ref_nlevels, obs_qty, &
+ height_array, my_status)
+ if (any(my_status /= 0)) return !>@todo FIXME let successful members continue?
-i = find_name('EFGWORO',cflds)
-if (i/= MISSING_I) then
- dart_to_cam_types( QTY_GRAV_WAVE_DRAG_EFFIC) = 'EFGWORO'
- cam_to_dart_qtys(i) = QTY_GRAV_WAVE_DRAG_EFFIC
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ if (debug_level > 400) then
+ do k = 1,ref_nlevels
+ print*, 'ISHEIGHT: ', k, height_array(k,1)
+ enddo
+ endif
-i = find_name('FRACLDV',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_GRAV_WAVE_STRESS_FRACTION) = 'FRACLDV'
- cam_to_dart_qtys(i) = QTY_GRAV_WAVE_STRESS_FRACTION
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ do imember=1, ens_size
+ call height_to_level(ref_nlevels, height_array(:, imember), vert_val, &
+ levs1(imember), levs2(imember), vert_fracts(imember), &
+ my_status(imember))
+ enddo
+ if (any(my_status /= 0)) return !>@todo FIXME let successful members continue?
-! dart_to_cam_types(QTY_SURFACE_TEMPERATURE ? ) = TYPE_TS
-! dart_to_cam_types(QTY_SEA_SURFACE_TEMPERATURE ? ) = TYPE_TSOCN
-! convert_mmr2vmr(i) = mmr2vmr(i)
+ if (debug_level > 100) then
+ do k = 1,ens_size
+ print*, 'ISHEIGHT ens#, levs1(#), levs2(#), vert_fracts(#), top/bot height(#)', &
+ k, levs1(k), levs2(k), vert_fracts(k), height_array(levs2(k),k), height_array(levs1(k), k)
+ enddo
+ endif
+
+ case(VERTISLEVEL)
+ ! this routine returns false if the level number is out of range.
+ if (.not. check_good_levels(vert_val, ref_nlevels, l1, l2, fract1)) then
+ my_status(:) = 8
+ return
+ endif
-! Physically 3D fields
-i = find_name('T',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_TEMPERATURE) = 'T'
- cam_to_dart_qtys(i) = QTY_TEMPERATURE
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ ! because we're given a model level as input, all the ensemble
+ ! members have the same outgoing values.
+ levs1(:) = l1
+ levs2(:) = l2
+ vert_fracts(:) = fract1
+ my_status(:) = 0
+
+ if (debug_level > 100) then
+ do k = 1,ens_size
+ print*, 'ISLEVEL levs1(k), levs2(k), vert_fracts(k), vert_val', &
+ levs1(k), levs2(k), vert_fracts(k), vert_val
+ enddo
+ endif
-i = find_name('US',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_U_WIND_COMPONENT) = 'US'
- cam_to_dart_qtys(i) = QTY_U_WIND_COMPONENT
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ ! 2d fields
+ case(VERTISUNDEF, VERTISSURFACE)
+ if (get_dims_from_qty(obs_qty, var_id) == 2) then
+ levs1(:) = ref_nlevels - 1
+ levs2(:) = ref_nlevels
+ vert_fracts(:) = 1.0_r8
+ my_status(:) = 0
+ else
+ my_status(:) = 4 ! can not get vertical levels
+ endif
-i = find_name('VS',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_V_WIND_COMPONENT) = 'VS'
- cam_to_dart_qtys(i) = QTY_V_WIND_COMPONENT
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ case default
+ write(string1, *) 'unsupported vertical type: ', which_vert
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
+
+end select
-i = find_name('Q',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_SPECIFIC_HUMIDITY) = 'Q'
- cam_to_dart_qtys(i) = QTY_SPECIFIC_HUMIDITY
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+! by this time someone has already set my_status(), good or bad.
-i = find_name('CLDLIQ',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CLOUD_LIQUID_WATER) = 'CLDLIQ'
- cam_to_dart_qtys(i) = QTY_CLOUD_LIQUID_WATER
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+end subroutine find_vertical_levels
-i = find_name('CLDICE',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CLOUD_ICE) = 'CLDICE'
- cam_to_dart_qtys(i) = QTY_CLOUD_ICE
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
-! dart_to_cam_types(QTY_CLOUD_WATER ? ) = 'LCWAT'
-! cam_to_dart_qtys(i) = QTY_CLOUD_WATER ?
-! convert_mmr2vmr(i) = mmr2vmr(i)
-
-i = find_name('CO',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CO) = 'CO'
- cam_to_dart_qtys(i) = QTY_CO
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+!-----------------------------------------------------------------------
+!> Compute the heights at pressure midpoints
+!>
+!> this version does all ensemble members at once.
-i = find_name('CO01',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CO01) = 'CO01'
- cam_to_dart_qtys(i) = QTY_CO01
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+subroutine cam_height_levels(ens_handle, ens_size, lon_index, lat_index, nlevels, qty, height_array, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: nlevels
+integer, intent(in) :: qty
+real(r8), intent(out) :: height_array(nlevels, ens_size)
+integer, intent(out) :: my_status(ens_size)
-i = find_name('CO02',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CO02) = 'CO02'
- cam_to_dart_qtys(i) = QTY_CO02
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+integer :: k, level_one, imember, status1
+real(r8) :: surface_elevation(1)
+real(r8) :: surface_pressure(ens_size), mbar(nlevels, ens_size)
+real(r8) :: tv(nlevels, ens_size) ! Virtual temperature, top to bottom
-i = find_name('CO03',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CO03) = 'CO03'
- cam_to_dart_qtys(i) = QTY_CO03
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+! this is for surface obs
+level_one = 1
-i = find_name('OC1',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_OC1) = 'OC1'
- cam_to_dart_qtys(i) = QTY_OC1
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+! get the surface pressure from the ens_handle
+call get_staggered_values_from_qty(ens_handle, ens_size, QTY_SURFACE_PRESSURE, &
+ lon_index, lat_index, level_one, qty, surface_pressure, status1)
-i = find_name('OC2',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_OC2) = 'OC2'
- cam_to_dart_qtys(i) = QTY_OC2
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+! get the surface elevation from the phis, including stagger if needed
+call get_quad_values(1, lon_index, lat_index, QTY_SURFACE_ELEVATION, qty, surface_elevation)
-i = find_name('CB1',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CB1) = 'CB1'
- cam_to_dart_qtys(i) = QTY_CB1
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+call compute_virtual_temperature(ens_handle, ens_size, lon_index, lat_index, nlevels, qty, tv, status1)
-i = find_name('CB2',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CB2) = 'CB2'
- cam_to_dart_qtys(i) = QTY_CB2
- convert_mmr2vmr(i) = mmr2vmr(i)
+if (status1 /= 0) then
+ my_status = status1
+ return
endif
-i = find_name('OC102',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_OC102) = 'OC102'
- cam_to_dart_qtys(i) = QTY_OC102
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+if (use_variable_mean_mass) then
+ call compute_mean_mass(ens_handle, ens_size, lon_index, lat_index, nlevels, qty, mbar, status1)
-i = find_name('OC202',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_OC202) = 'OC202'
- cam_to_dart_qtys(i) = QTY_OC202
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ if (status1 /= 0) then
+ my_status = status1
+ return
+ endif
-i = find_name('CB102',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CB102) = 'CB102'
- cam_to_dart_qtys(i) = QTY_CB102
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+ ! compute the height columns for each ensemble member - passing mbar() array in.
+ do imember = 1, ens_size
+ call build_heights(nlevels, surface_pressure(imember), surface_elevation(1), &
+ tv(:, imember), height_array(:, imember), mbar=mbar(:, imember))
+ enddo
-i = find_name('CB202',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CB202) = 'CB202'
- cam_to_dart_qtys(i) = QTY_CB202
- convert_mmr2vmr(i) = mmr2vmr(i)
+else
+ ! compute the height columns for each ensemble member - no mbar() argument here.
+ ! (you cannot just pass 1.0 in for the mbar() array; it uses a different gas constant
+ ! in the variable mean mass case.)
+ do imember = 1, ens_size
+ call build_heights(nlevels, surface_pressure(imember), surface_elevation(1), &
+ tv(:, imember), height_array(:, imember))
+ enddo
endif
-i = find_name('CO2',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CO2) = 'CO2'
- cam_to_dart_qtys(i) = QTY_CO2
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
-i = find_name('NO',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_NO) = 'NO'
- cam_to_dart_qtys(i) = QTY_NO
- convert_mmr2vmr(i) = mmr2vmr(i)
+if (debug_level > 100) then
+ do imember = 1, ens_size
+ print *, ''
+ print *, 'geopotential, member: ', imember
+ do k = 1, nlevels
+ print*, 'tv(level) ', k, tv(k, imember)
+ enddo
+ do k = 1, nlevels
+ print*, 'height(level)', k, height_array(k, imember)
+ enddo
+ enddo
endif
-i = find_name('NO2',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_NO2) = 'NO2'
- cam_to_dart_qtys(i) = QTY_NO2
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+! convert entire array to geometric height (from potential height)
+call gph2gmh(height_array, grid_data%lat%vals(lat_index))
-i = find_name('CH4',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_CH4) = 'CH4'
- cam_to_dart_qtys(i) = QTY_CH4
- convert_mmr2vmr(i) = mmr2vmr(i)
+if (debug_level > 100) then
+ do imember = 1, ens_size
+ print *, ''
+ print *, 'geometric, member: ', imember
+ do k = 1, nlevels
+ print*, 'height(level)', k, height_array(k, imember)
+ enddo
+ enddo
endif
-i = find_name('NH3',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_NH3) = 'NH3'
- cam_to_dart_qtys(i) = QTY_NH3
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+my_status(:) = 0
-! i = find_name('O',cflds)
-! if (i /= MISSING_I) then
-! dart_to_cam_types( QTY_O) = 'O'
-! cam_to_dart_qtys(i) = QTY_O
-! endif
-
-i = find_name('O3',cflds)
-if (i /= MISSING_I) then
- dart_to_cam_types( QTY_O3) = 'O3'
- cam_to_dart_qtys(i) = QTY_O3
- convert_mmr2vmr(i) = mmr2vmr(i)
-endif
+end subroutine cam_height_levels
+
+!-----------------------------------------------------------------------
+!> Compute the pressures at the layer midpoints for multiple columns
+
+subroutine build_cam_pressure_columns(ens_size, surface_pressure, n_levels, pressure_array)
+
+integer, intent(in) :: ens_size
+real(r8), intent(in) :: surface_pressure(:) ! in pascals
+integer, intent(in) :: n_levels
+real(r8), intent(out) :: pressure_array(:,:)
+
+integer :: j, k
+! Set midpoint pressures. This array mirrors the order of the
+! cam model levels: 1 is the model top, N is the bottom.
-if (print_details .and. output_task0) then
- write(string1,*) 'OBS_QTY FIELD_TYPE'
- call error_handler(E_MSG, 'map_qtys', string1,source,revision,revdate)
- do i=1,300
- if (dart_to_cam_types(i) /= '') then
- write(string1,'(I8,A)') i, dart_to_cam_types(i)
- call error_handler(E_MSG, 'map_qtys', string1,source,revision,revdate)
- end if
- end do
-end if
+do j=1, ens_size
+ do k=1,n_levels
+ pressure_array(k, j) = ref_surface_pressure * grid_data%hyam%vals(k) + &
+ surface_pressure(j) * grid_data%hybm%vals(k)
+ enddo
+enddo
+
+end subroutine build_cam_pressure_columns
-end subroutine map_qtys
!-----------------------------------------------------------------------
-! CAM-chem 3))
-! Function to calculate the unit conversion factors, which make
-! estimated obs have units consistent with actual obs in model_interpolate.
+!> Compute column of pressures at the layer midpoints for the given
+!> surface pressure.
+!>
+!> to get pressure on layer interfaces, the computation would be identical
+!> but use hyai, hybi. (also have n_levels+1)
-function mmr2vmr(var_index)
+subroutine single_pressure_column(surface_pressure, n_levels, pressure_array)
-integer, intent(in) :: var_index
+real(r8), intent(in) :: surface_pressure ! in pascals
+integer, intent(in) :: n_levels
+real(r8), intent(out) :: pressure_array(n_levels)
-real(r8) :: mmr2vmr
-integer :: chem_index
+integer :: k
-mmr2vmr = 1.0_r8
-do chem_index=1,chemical_list
- if ( cflds(var_index) .eq. solsym(chem_index) ) then
- mmr2vmr = molar_mass_dry_air/adv_mass(chem_index)
- write(string1,'(2A,I4)') 'State field(= chemical name), mmr2vmr = ', &
- solsym(chem_index), mmr2vmr
- call error_handler(E_MSG, 'mmr2vmr', string1,source,revision,revdate)
- exit
- endif
+! Set midpoint pressures. This array mirrors the order of the
+! cam model levels: 1 is the model top, N is the bottom.
+
+do k=1, n_levels
+ pressure_array(k) = ref_surface_pressure * grid_data%hyam%vals(k) + &
+ surface_pressure * grid_data%hybm%vals(k)
enddo
-end function mmr2vmr
+end subroutine single_pressure_column
!-----------------------------------------------------------------------
+!> Compute pressure at one level given the surface pressure
+!> cam model levels: 1 is the model top, N is the bottom.
+!> in this version of the routine level is integer/whole value
-! End of static_init_model section
-!#######################################################################
+function single_pressure_value_int(surface_pressure, level)
-! Module I/O to/from DART and files
+real(r8), intent(in) :: surface_pressure ! in pascals
+integer, intent(in) :: level
+real(r8) :: single_pressure_value_int
-!-----------------------------------------------------------------------
+! cam model levels: 1 is the model top, N is the bottom.
-subroutine read_cam_init(file_name, var, model_time)
-
-! Fill the model_type 'var' using fields from a CAM initial file.
-! Init_model_instance must be called before this subroutine.
-
-! CAM initial files are used instead of restart files for (at least) 6 reasons.
-! 1) The contents of the restart files vary depending on both the model release version
-! and the physics packages selected.
-! 2) There is no metadata on the restart files describing the variables.
-! Some information can be tracked down in the atm.log file, but not all of it.
-! 3) The restart files (for non-chemistry model versions) are much larger than the
-! initial files (and we need to deal with an ensemble of them).
-! 4) The temperature on the restart files is virtual equivalent potential temperature (?),
-! which requires (at least) surface pressure, specific humidity, and sensible temperature
-! to calculate.
-! 5) CAM does not call the initialization routines when restart files are used,
-! so fields which are not modified by DART may be inconsistent with fields which are.
-! 6) If DART modifies the contents of the .r. restart file, it might also need to
-! modify the contents of the .rs. restart file, which has similar characteristics
-! (1-3 above) to the .r. file.
-
-character(len=*), intent(in) :: file_name
-type(model_type), intent(inout) :: var
-type(time_type), intent(inout) :: model_time
-
-integer :: i, k, n, m, ifld
-integer :: nc_file_ID, nc_var_ID, dimid, varid, dimlen
-integer :: iyear, imonth, iday, ihour, imin, isec, rem
-integer :: timestep
-integer, allocatable :: datetmp(:), datesec(:)
-real(r8), allocatable :: temp_3d(:,:,:), temp_2d(:,:)
-
-! read CAM 'initial' file domain info
-call nc_check(nf90_open(path=file_name, mode=nf90_nowrite, ncid=nc_file_ID), &
- 'read_cam_init', 'opening '//trim(file_name))
-
-! Read the time of the current state.
-! CAM initial files have two variables of length 'time' (the unlimited dimension): date, datesec
-! The rest of the routine presumes there is but one time in the file -
-
-call nc_check(nf90_inq_dimid(nc_file_ID, 'time', dimid), &
- 'read_cam_init', 'inq_dimid time '//trim(file_name))
-call nc_check(nf90_inquire_dimension(nc_file_ID, dimid, len=dimlen), &
- 'read_cam_init', 'inquire_dimension time '//trim(file_name))
-
-if (dimlen /= 1) then
- write(string1,*)trim(file_name),' has',dimlen,'times. Require exactly 1.'
- call error_handler(E_ERR, 'read_cam_init', string1, source, revision, revdate)
-endif
+single_pressure_value_int = ref_surface_pressure * grid_data%hyam%vals(level) + &
+ surface_pressure * grid_data%hybm%vals(level)
-allocate(datetmp(dimlen), datesec(dimlen))
+end function single_pressure_value_int
-call nc_check(nf90_inq_varid(nc_file_ID, 'date', varid), &
- 'read_cam_init', 'inq_varid date '//trim(file_name))
-call nc_check(nf90_get_var(nc_file_ID, varid, values=datetmp), &
- 'read_cam_init', 'get_var date '//trim(file_name))
+!-----------------------------------------------------------------------
+!> Compute pressure at one level given the surface pressure
+!> cam model levels: 1 is the model top, N is the bottom.
+!> fraction = 0 is full level 1, fraction = 1 is full level 2
+!> level is real/fractional value
-call nc_check(nf90_inq_varid(nc_file_ID, 'datesec', varid), &
- 'read_cam_init', 'inq_varid datesec '//trim(file_name))
-call nc_check(nf90_get_var(nc_file_ID, varid, values=datesec), &
- 'read_cam_init', 'get_var datesec '//trim(file_name))
-! for future extensibility, presume we find a 'timeindex' that we want.
-! Since we only support 1 timestep in the file, this is easy.
+function single_pressure_value_real(surface_pressure, level)
-timestep = 1
+real(r8), intent(in) :: surface_pressure ! in pascals
+real(r8), intent(in) :: level
+real(r8) :: single_pressure_value_real
-! The 'date' is YYYYMMDD ... datesec is 'current seconds of current day'
-iyear = datetmp(timestep) / 10000
-rem = datetmp(timestep) - iyear*10000
-imonth = rem / 100
-iday = rem - imonth*100
+integer :: k
+real(r8) :: fract, pres1, pres2
-ihour = datesec(timestep) / 3600
-rem = datesec(timestep) - ihour*3600
-imin = rem / 60
-isec = rem - imin*60
+k = int(level)
+fract = level - int(level)
-deallocate(datetmp, datesec)
+if (k /= ref_nlevels) then
+ pres1 = single_pressure_value_int(surface_pressure, k)
+ pres2 = single_pressure_value_int(surface_pressure, k+1)
+else
+ pres1 = single_pressure_value_int(surface_pressure, k-1)
+ pres2 = single_pressure_value_int(surface_pressure, k)
+ fract = 1.0_r8
+endif
-! some cam files are from before the start of the gregorian calendar.
-! since these are 'arbitrary' years, just change the offset.
+single_pressure_value_real = (pres1 * (1.0_r8 - fract)) + &
+ pres2 * (fract)
-if (iyear < 1601) then
- write(string1,*)' '
- write(string2,*)'WARNING - ',trim(file_name),' changing year from ',iyear,'to',iyear+1601
- call error_handler(E_MSG, 'read_cam_init', string1, source, revision, &
- revdate, text2=string2,text3='to make it a valid Gregorian date.')
- write(string1,*)' '
- call error_handler(E_MSG, 'read_cam_init', string1, source, revision)
- iyear = iyear + 1601
-endif
+end function single_pressure_value_real
-model_time = set_date(iyear,imonth,iday,ihour,imin,isec)
+!-----------------------------------------------------------------------
+!> return the level indices and fraction across the level.
+!> level 1 is model top, level N is model bottom.
+!> pressure is smallest at the top, so the values are not inverted
+!> in the array.
+!> fract = 0 means full lev1 value,
+!> fract = 1 means full lev2 value.
+!> return non-zero if value outside valid range.
-if (output_task0) then
- call print_date(model_time,' read_cam_init ... input date')
- call print_time(model_time,' read_cam_init ... input time')
- call print_date(model_time,' read_cam_init ... input date',logfileunit)
- call print_time(model_time,' read_cam_init ... input time',logfileunit)
-endif
+subroutine pressure_to_level(nlevels, pressures, p_val, &
+ lev1, lev2, fract, my_status)
-! The temporary arrays into which fields are read are dimensioned by the largest values of
-! the sizes of the dimensions listed in f_dim_RANKd
-! f_dim_max contents assume that time is always the last dimension on NetCDF files,
-! so f_dim_max(4,3) and f_dim_max(3,2) are the non-spatial dimensions to ignore here.
-allocate(temp_3d(f_dim_max(1,3),f_dim_max(2,3),f_dim_max(3,3)), &
- temp_2d(f_dim_max(1,2),f_dim_max(2,2)) )
-
-ifld = 0
-!0d fields; scalars are recognized and handled differently than vectors by NetCDF
-do i= 1, state_num_0d
- ifld = ifld + 1
- call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
- 'read_cam_init', 'inq_varid '//trim(cflds(ifld)))
- if (print_details .and. output_task0) then
- write(string1,*) 'reading ',cflds(ifld),' using id ',nc_var_ID
- call error_handler(E_ERR, 'read_cam_init', string1,source,revision,revdate)
- endif
+integer, intent(in) :: nlevels
+real(r8), intent(in) :: pressures(:)
+real(r8), intent(in) :: p_val
+integer, intent(out) :: lev1
+integer, intent(out) :: lev2
+real(r8), intent(out) :: fract
+integer, intent(out) :: my_status
- ! Fields on file are 1D; TIME(=1)
- call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, var%vars_0d(i) ), &
- 'read_cam_init', 'get_var '//trim(cflds(ifld)))
-enddo
+call find_enclosing_indices(nlevels, pressures, p_val, lev1, lev2, fract, my_status, &
+ inverted = .false., log_scale = use_log_vertical_scale)
+if (my_status /= 0) my_status = 10
-!1d fields
-do i= 1, state_num_1d
- ifld = ifld + 1
- call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
- 'read_cam_init', 'inq_varid '//trim(cflds(ifld)))
- if (print_details .and. output_task0) then
- write(string1,*) 'reading ',cflds(ifld),' using id ',nc_var_ID
- call error_handler(E_MSG, 'read_cam_init', string1,source,revision,revdate)
- endif
+end subroutine pressure_to_level
- ! s_dim_1d should = f_dim_1d
- call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, var%vars_1d(1:f_dim_1d(1, i), i), &
- start=(/ 1, timestep /), count=(/ f_dim_1d(1,i), 1/) ), &
- 'read_cam_init', 'get_var '//trim(cflds(ifld)))
-enddo
+!-----------------------------------------------------------------------
+!> return the level indices and fraction across the level.
+!> level 1 is model top, level N is model bottom.
+!> height is largest at the top, so the values *are* inverted
+!> in the array.
+!> fract = 0 means full lev1 value,
+!> fract = 1 means full lev2 value.
+!> return non-zero if value outside valid range.
-!2d fields on file are 3D; 2 spatial dimensions, then TIME(=1).
-do i= 1, state_num_2d
- ifld = ifld + 1
- call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
- 'read_cam_init', 'inq_varid '//trim(cflds(ifld)))
- if (print_details .and. output_task0) then
- write(string1,*) 'reading ',cflds(ifld),' using id ',nc_var_ID
- call error_handler(E_MSG, 'read_cam_init', string1,source,revision,revdate)
- endif
+subroutine height_to_level(nlevels, heights, h_val, &
+ lev1, lev2, fract, my_status)
- ! Need to use temp_Nd; I am coding for not knowing what the 2 spatial dimensions of this field.
- call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, temp_2d(1:f_dim_2d(1,i), 1:f_dim_2d(2,i)), &
- start=(/ 1, 1, timestep/) ,count=(/ f_dim_2d(1,i), f_dim_2d(2,i), 1/) ), &
- 'read_cam_init', 'get_var '//trim(cflds(ifld)))
+integer, intent(in) :: nlevels
+real(r8), intent(in) :: heights(:)
+real(r8), intent(in) :: h_val
+integer, intent(out) :: lev1
+integer, intent(out) :: lev2
+real(r8), intent(out) :: fract
+integer, intent(out) :: my_status
- var%vars_2d(1:f_dim_2d(1,i),1:f_dim_2d(2,i),i) = &
- temp_2d(1:f_dim_2d(1,i),1:f_dim_2d(2,i))
+character(len=*), parameter :: routine = 'height_to_level:'
-enddo
+call find_enclosing_indices(nlevels, heights, h_val, lev1, lev2, fract, my_status, &
+ inverted = .true., log_scale = .false.)
-! Spatially 3d fields on file are 4D; lon, lev, lat, TIME(=1)
-! or; lon, lat, lev, TIME
-do i=1, state_num_3d
- ifld = ifld + 1
- call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
- 'read_cam_init', 'inq_varid '//trim(cflds(ifld)))
- if (print_details .and. output_task0) then
- write(string1,*) 'reading ',cflds(ifld),' using id ',nc_var_ID
- call error_handler(E_MSG, 'read_cam_init', string1,source,revision,revdate)
- endif
+if (my_status /= 0) my_status = 11
- call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, &
- temp_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i)), start=(/ 1, 1, 1, timestep/), &
- count=(/ f_dim_3d(1,i), f_dim_3d(2,i), f_dim_3d(3,i), 1 /) ), &
- 'read_cam_init', 'get_var '//trim(cflds(ifld)))
+end subroutine height_to_level
- var%vars_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i),i) = &
- temp_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i))
+!-----------------------------------------------------------------------
+!> in cam level 1 is at the model top, level N is the lowest level
+!> our convention in this code is: between levels a fraction of 0
+!> is 100% level 1, and fraction of 1 is 100% level 2.
-enddo
+function check_good_levels(vert_value, valid_range, l1, l2, fract)
+real(r8), intent(in) :: vert_value
+integer, intent(in) :: valid_range
+integer, intent(out) :: l1
+integer, intent(out) :: l2
+real(r8), intent(out) :: fract
+logical :: check_good_levels
-call nc_check(nf90_close(nc_file_ID), 'read_cam_init', 'closing '//trim(file_name))
+integer :: integer_level
+real(r8) :: fract_level
-deallocate(temp_3d,temp_2d)
+! be a pessimist, then you're never disappointed
+check_good_levels = .false.
+l1 = MISSING_I
+l2 = MISSING_I
+fract = MISSING_R8
-end subroutine read_cam_init
+! out of range checks
+if (vert_value < 1.0_r8 .or. vert_value > valid_range) return
-!-----------------------------------------------------------------------
+integer_level = floor(vert_value)
+fract_level = vert_value - integer_level
-subroutine write_cam_coord_def(nc_file_ID, c_name, coord, dim_id, c_id)
+! cam levels start at the top so level 1 is
+! the highest level and increases on the way down.
-integer, intent(in) :: nc_file_ID
-character(len=*), intent(in) :: c_name
-type(grid_1d_type), intent(in) :: coord
-integer, intent(in) :: dim_id
-integer, intent(out) :: c_id
+!>might want to allow extrapolation - which means
+!>allowing out of range values here and handling
+!>them correctly in the calling and vert_interp() code.
-integer :: i
+if (vert_value /= valid_range) then
+ l1 = integer_level
+ l2 = integer_level + 1
+ fract = fract_level
+else
+ ! equal to the largest level number
+ l1 = integer_level - 1
+ l2 = integer_level
+ fract = 1.0_r8
+endif
-call nc_check(nf90_def_var(nc_file_ID, name=c_name, xtype=nf90_double, dimids=dim_id, &
- varid=c_id), 'write_cam_coord_def', 'def_var '//trim(c_name))
+check_good_levels = .true.
-do i=1,coord%num_atts
- call nc_check(nf90_put_att(nc_file_ID, c_id, coord%atts_names(i), coord%atts_vals(i)), &
- 'write_cam_coord_def', 'put_att '//trim(coord%atts_names(i)))
-enddo
+end function check_good_levels
-end subroutine write_cam_coord_def
!-----------------------------------------------------------------------
+!> based on the stagger that corresponds to the given quantity,
+!> return the handle to the interpolation grid
+
+
+function get_interp_handle(obs_quantity)
+integer, intent(in) :: obs_quantity
+type(quad_interp_handle) :: get_interp_handle
+
+character(len=*), parameter :: routine = 'get_interp_handle:'
+
+select case (grid_stagger%qty_stagger(obs_quantity))
+ case ( STAGGER_U )
+ get_interp_handle = interp_u_staggered
+ case ( STAGGER_V )
+ get_interp_handle = interp_v_staggered
+ case ( STAGGER_NONE )
+ get_interp_handle = interp_nonstaggered
+ case ( STAGGER_W )
+ write(string1,*) 'w stagger -- not supported yet'
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
+ case ( STAGGER_UV )
+ write(string1,*) 'uv stagger -- not supported yet'
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
+ case default
+ write(string1,*) 'unknown stagger -- this should never happen'
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
+end select
+
+end function get_interp_handle
-subroutine write_cam_init(file_name, model_time, var)
+!-----------------------------------------------------------------------
+!>
+!> Set the desired minimum model advance time. This is generally NOT the
+!> dynamical timestep of the model, but rather the shortest forecast length
+!> you are willing to make. This impacts how frequently the observations
+!> may be assimilated.
+!>
+!>
-! Write CAM 'initial' file fields (from var) that have been updated
-! to a CAM initial file.
+function shortest_time_between_assimilations()
-character(len=*), intent(in) :: file_name
-type(time_type), intent(in) :: model_time
-type(model_type), intent(inout) :: var
+character(len=*), parameter :: routine = 'shortest_time_between_assimilations:'
-type(time_type) :: CAM_time
-integer :: i, k, n, m, ifld
-integer :: nc_file_ID, nc_var_ID
-integer :: dimid, dimlen, varid
-integer :: iyear, imonth, iday, ihour, imin, isec, leftover
-integer :: itime, timeindex
+type(time_type) :: shortest_time_between_assimilations
-integer, allocatable :: datetmp(:), datesec(:)
-real(r8), allocatable :: temp_3d(:,:,:), temp_2d(:,:)
+if ( .not. module_initialized ) call static_init_model
-if (.not. module_initialized) call static_init_model()
+shortest_time_between_assimilations = set_time(assimilation_period_seconds, &
+ assimilation_period_days)
-call nc_check(nf90_open(path=trim(file_name), mode=nf90_write, ncid=nc_file_ID), &
- 'write_cam_init', 'opening '//trim(file_name))
+write(string1,*)'assimilation period is ',assimilation_period_days, ' days ', &
+ assimilation_period_seconds,' seconds'
+call error_handler(E_MSG,routine,string1,source,revision,revdate)
-! Need to figure out which timeslot to update in the CAM initial file.
-! It is not likely, but possible, that the initial file will have multiple
-! timesteps in it. We have to figure out which slot matches the DART model time.
-! the 'date' and 'datesec' variables contain the CAM state time.
+end function shortest_time_between_assimilations
-call nc_check(nf90_inq_dimid(nc_file_ID, 'time', dimid), &
- 'write_cam_init', 'inq_dimid time '//trim(file_name))
-call nc_check(nf90_inquire_dimension(nc_file_ID, dimid, len=dimlen), &
- 'write_cam_init', 'inquire_dimension time '//trim(file_name))
-if (dimlen /= 1) then
- write(string1,*)'UNUSUAL - ',trim(file_name),' has',dimlen,'times. Expected 1.'
- call error_handler(E_MSG, 'write_cam_init', string1, source, revision, revdate, &
- text2='Searching for a matching time ...')
-endif
-allocate(datetmp(dimlen), datesec(dimlen))
-call nc_check(nf90_inq_varid(nc_file_ID, 'date', varid), &
- 'write_cam_init', 'inq_varid date '//trim(file_name))
-call nc_check(nf90_get_var(nc_file_ID, varid, values=datetmp), &
- 'write_cam_init', 'get_var date '//trim(file_name))
+!-----------------------------------------------------------------------
+!>
+!> Does any shutdown and clean-up needed for model.
+!>
-call nc_check(nf90_inq_varid(nc_file_ID, 'datesec', varid), &
- 'write_cam_init', 'inq_varid datesec '//trim(file_name))
-call nc_check(nf90_get_var(nc_file_ID, varid, values=datesec), &
- 'write_cam_init', 'get_var datesec '//trim(file_name))
+subroutine end_model()
-timeindex = -1
-TIMELOOP: do itime = 1,dimlen
+! deallocate arrays from grid and anything else
- iyear = datetmp(itime)/10000
- leftover = datetmp(itime) - iyear*10000
- imonth = leftover/100
- iday = leftover - imonth*100
- ihour = datesec(itime)/3600
- leftover = datesec(itime) - ihour*3600
- imin = leftover/60
- isec = leftover - imin*60
+call free_cam_grid(grid_data)
- CAM_time = set_date(iyear, imonth, iday, ihour, imin, isec)
+call free_std_atm_tables()
- if (CAM_time == model_time) then
- if (dimlen /= 1) then
- write(string1,*)'Found matching time at index ',itime
- call error_handler(E_MSG, 'write_cam_init', string1, source, revision, revdate)
- endif
+call finalize_quad_interp(interp_nonstaggered)
+call finalize_quad_interp(interp_u_staggered)
+call finalize_quad_interp(interp_v_staggered)
- timeindex = itime
- exit TIMELOOP
- endif
+if (using_chemistry) call finalize_chem_tables()
-enddo TIMELOOP
+end subroutine end_model
-deallocate(datetmp, datesec)
-if (timeindex < 1) then
+!-----------------------------------------------------------------------
+!>
+!> Writes the model-specific attributes to a DART 'diagnostic' netCDF file.
+!> This includes coordinate variables and some metadata, but NOT the
+!> actual DART state.
+!>
+!> @param ncid the netCDF handle of the DART diagnostic file opened by
+!> assim_model_mod:init_diag_output
- call get_date(model_time, iyear, imonth, iday, ihour, imin, isec)
+subroutine nc_write_model_atts(ncid, dom_id)
- write(string1,*)trim(file_name),' had no times that matched the model time.'
- write(string2,*)'model_time (YYYY MM DD) is ',iyear, imonth, iday
- write(string3,*)'model_time (SSSSS) is ',isec + imin*60 + ihour*3600
- call error_handler(E_ERR, 'write_cam_init', string1, source, revision, revdate, &
- text2=string2,text3=string3)
-endif
+integer, intent(in) :: ncid ! netCDF file identifier
+integer, intent(in) :: dom_id ! not used since there is only one domain
-! So now we know that the right timeslot is 'timeindex'.
+!----------------------------------------------------------------------
+! local variables
+!----------------------------------------------------------------------
-! The temporary arrays into which fields are read are dimensioned by the largest values of
-! the sizes of the dimensions listed in coord_RANKd
-allocate(temp_3d(f_dim_max(1,3),f_dim_max(2,3),f_dim_max(3,3)))
-allocate(temp_2d(f_dim_max(1,2),f_dim_max(2,2)))
+character(len=*), parameter :: routine = 'nc_write_model_atts'
-if (print_details .and. output_task0) then
- write(string1,*) 'write_cam_init; f_dim_max(:2) = ',f_dim_max(1,2),f_dim_max(2,2)
- call error_handler(E_MSG, 'write_cam_init', string1,source,revision,revdate)
-endif
+if ( .not. module_initialized ) call static_init_model
-ifld = 0
+!-------------------------------------------------------------------------------
+! Write Global Attributes
+!-------------------------------------------------------------------------------
-! 0d fields are first ... there is no concern about shape or dimensions
-do i = 1, state_num_0d
- ifld = ifld + 1
- call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
- 'write_cam_init', 'inq_var '//trim(cflds(ifld)))
- call nc_check(nf90_put_var(nc_file_ID, nc_var_ID, var%vars_0d(i) ), &
- 'write_cam_init', 'put_var '//trim(cflds(ifld)))
-enddo
+call nc_begin_define_mode(ncid, routine)
-! 1d fields
-do i = 1, state_num_1d
- ! CS added this from 2d loop below.
- ! special code: check and error out if the PS field has gone negative
- if (state_names_1d(i) == 'PS') then
- if (minval(var%vars_1d(:,i)) < 0.0_r8) then
- write(string1, *)'PS has negative values; should not happen'
- call error_handler(E_ERR, 'write_cam_init', string1, source, revision, revdate)
- endif
- endif
- ifld = ifld + 1
- call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
- 'write_cam_init', 'inq_var '//trim(cflds(ifld)))
- call nc_check(nf90_put_var(nc_file_ID, nc_var_ID, var%vars_1d(1:f_dim_1d(1, i),i), &
- start=(/ 1, timeindex /), count = (/ f_dim_1d(1, i), 1 /)), &
- 'write_cam_init', 'put_var '//trim(cflds(ifld)))
-enddo
+call nc_add_global_creation_time(ncid, routine)
-do i = 1, state_num_2d
- ! special code: check and error out if the PS field has gone negative
- if (state_names_2d(i) == 'PS') then
- if (minval(var%vars_2d(:,:,i)) < 0.0_r8) then
- write(string1, *)'PS has negative values; should not happen'
- call error_handler(E_ERR, 'write_cam_init', string1, source, revision, revdate)
- endif
- endif
+call nc_add_global_attribute(ncid, "model_source", source, routine)
+call nc_add_global_attribute(ncid, "model_revision", revision, routine)
+call nc_add_global_attribute(ncid, "model_revdate", revdate, routine)
- ! 2d fields ; tricky because coordinates may have been rearranged.
+call nc_add_global_attribute(ncid, "model", "CAM", routine)
- temp_2d(1:f_dim_2d(1, i),1:f_dim_2d(2,i)) = &
- var%vars_2d(1:f_dim_2d(1, i),1:f_dim_2d(2,i), i )
+! this option is for users who want the smallest output
+! or diagnostic files - only the state vector data will
+! be written. otherwise, if you want to plot this data
+! the rest of this routine writes out enough grid info
+! to make the output file look like the input.
+if (suppress_grid_info_in_output) then
+ call nc_end_define_mode(ncid, routine)
+ return
+endif
- ifld = ifld + 1
- call nc_check(nf90_inq_varid(nc_file_ID, trim(cflds(ifld)), nc_var_ID), &
- 'write_cam_init','inq_varid '//trim(cflds(ifld)))
- call nc_check(nf90_put_var(nc_file_ID, nc_var_ID, temp_2d(1:f_dim_2d(1, i),1:f_dim_2d(2,i)), &
- start=(/ 1, 1, timeindex /), count = (/ f_dim_2d(1, i), f_dim_2d(2,i), 1/)), &
- 'write_cam_init','put_var '//trim(cflds(ifld)))
-enddo
+!----------------------------------------------------------------------------
+! Output the grid variables.
+!----------------------------------------------------------------------------
+! Define the new dimensions IDs
+!----------------------------------------------------------------------------
-do i = 1, state_num_3d
- ! special code: set a minimum threshold for certain variables
- if (state_names_3d(i) == 'Q') then
- where (var%vars_3d(:,:,:,i) < 1.0e-12_r8) var%vars_3d(:,:,:,i) = 1.0e-12_r8
- elseif (state_names_3d(i) == 'CLDLIQ' .or. &
- state_names_3d(i) == 'CLDICE') then
- where (var%vars_3d(:,:,:,i) < 0.0_r8) var%vars_3d(:,:,:,i) = 0.0_r8
- elseif (state_names_3d(i) == 'T') then
- if (minval(var%vars_3d(:,:,:,i)) < 0.0_r8) then
- write(string1, *)'T has negative values; should not happen'
- call error_handler(E_ERR, 'write_cam_init', string1, source, revision, revdate)
- endif
- endif
+call nc_define_dimension(ncid, 'lon', grid_data%lon%nsize, routine)
+call nc_define_dimension(ncid, 'lat', grid_data%lat%nsize, routine)
+call nc_define_dimension(ncid, 'slon', grid_data%slon%nsize, routine)
+call nc_define_dimension(ncid, 'slat', grid_data%slat%nsize, routine)
+call nc_define_dimension(ncid, 'lev', grid_data%lev%nsize, routine)
+call nc_define_dimension(ncid, 'ilev', grid_data%ilev%nsize, routine)
+call nc_define_dimension(ncid, 'gw', grid_data%gw%nsize, routine)
+call nc_define_dimension(ncid, 'hyam', grid_data%hyam%nsize, routine)
+call nc_define_dimension(ncid, 'hybm', grid_data%hybm%nsize, routine)
+call nc_define_dimension(ncid, 'hyai', grid_data%hyai%nsize, routine)
+call nc_define_dimension(ncid, 'hybi', grid_data%hybi%nsize, routine)
- temp_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i)) = &
- var%vars_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i),i)
-
- ifld = ifld + 1
- call nc_check(nf90_inq_varid(nc_file_ID, trim(cflds(ifld)), nc_var_ID), &
- 'write_cam_init', 'inq_varid '//trim(cflds(ifld)))
- call nc_check(nf90_put_var(nc_file_ID, nc_var_ID, &
- temp_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i)), &
- start=(/ 1, 1, 1, timeindex /), &
- count=(/ f_dim_3d(1,i), f_dim_3d(2,i), f_dim_3d(3,i), 1/)), &
- 'write_cam_init', 'put_var '//trim(cflds(ifld)))
-enddo
+!----------------------------------------------------------------------------
+! Create the Coordinate Variables and the Attributes
+! The contents will be written in a later block of code.
+!----------------------------------------------------------------------------
-call nc_check(nf90_close(nc_file_ID), 'write_cam_init', 'close cam initial file')
+! U,V Grid Longitudes
+call nc_define_real_variable( ncid, 'lon', (/ 'lon' /), routine)
+call nc_add_attribute_to_variable(ncid, 'lon', 'long_name', 'longitude', routine)
+call nc_add_attribute_to_variable(ncid, 'lon', 'units', 'degrees_east', routine)
-deallocate(temp_3d, temp_2d)
-end subroutine write_cam_init
+call nc_define_real_variable( ncid, 'slon', (/ 'slon' /), routine)
+call nc_add_attribute_to_variable(ncid, 'slon', 'long_name', 'staggered longitude', routine)
+call nc_add_attribute_to_variable(ncid, 'slon', 'units', 'degrees_east', routine)
-!-----------------------------------------------------------------------
+! U,V Grid Latitudes
+call nc_define_real_variable( ncid, 'lat', (/ 'lat' /), routine)
+call nc_add_attribute_to_variable(ncid, 'lat', 'long_name', 'latitude', routine)
+call nc_add_attribute_to_variable(ncid, 'lat', 'units', 'degrees_north', routine)
-subroutine write_cam_times(model_time, adv_time)
-! Not needed in CESM+DART framework
-! Writes model time and advance time into a file called 'times',
-! which is simply numbers. A script reads those and passes them to CAM's build-namelist.
-! -namelist "&camexp START_YMD=$times[3] START_TOD=$times[4]
-! STOP_YMD=$times[1] STOP_TOD=$times[2] NHTFRQ=$times[5] "
-! End time is first, then beginning time
+call nc_define_real_variable( ncid, 'slat', (/ 'slat' /), routine)
+call nc_add_attribute_to_variable(ncid, 'slat', 'long_name', 'staggered latitude', routine)
+call nc_add_attribute_to_variable(ncid, 'slat', 'units', 'degrees_north', routine)
-type(time_type), intent(in) :: model_time
-type(time_type), intent(in) :: adv_time
+! Vertical Grid Latitudes
+call nc_define_real_variable( ncid, 'lev', (/ 'lev' /), routine)
+call nc_add_attribute_to_variable(ncid, 'lev', 'long_name', 'hybrid level at midpoints (1000*(A+B))', routine)
+call nc_add_attribute_to_variable(ncid, 'lev', 'units', 'level', routine)
+call nc_add_attribute_to_variable(ncid, 'lev', 'positive', 'down', routine)
+call nc_add_attribute_to_variable(ncid, 'lev', 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate', routine)
+call nc_add_attribute_to_variable(ncid, 'lev', 'formula_terms', 'a: hyam b: hybm p0: P0 ps: PS', routine)
-integer :: tfile_unit, cam_date, cam_tod, nhtfrq
-integer :: year, month, day, hour, minute, second
-type(time_type) :: forecast_length
-if (.not. module_initialized) call static_init_model()
+call nc_define_real_variable( ncid, 'ilev', (/ 'ilev' /), routine)
+call nc_add_attribute_to_variable(ncid, 'ilev', 'long_name', 'hybrid level at interfaces (1000*(A+B))', routine)
+call nc_add_attribute_to_variable(ncid, 'ilev', 'units', 'level', routine)
+call nc_add_attribute_to_variable(ncid, 'ilev', 'positive', 'down', routine)
+call nc_add_attribute_to_variable(ncid, 'ilev', 'standard_name', 'atmosphere_hybrid_sigma_pressure_coordinate', routine)
+call nc_add_attribute_to_variable(ncid, 'ilev', 'formula_terms', 'a: hyai b: hybi p0: P0 ps: PS', routine)
-! calculate number of hours in forecast, and pass to history tape
-! write frequency
+! Hybrid Coefficients
+call nc_define_real_variable( ncid, 'hyam', (/ 'lev' /), routine)
+call nc_add_attribute_to_variable(ncid, 'hyam', 'long_name', 'hybrid A coefficient at layer midpoints', routine)
-forecast_length = adv_time - model_time
+call nc_define_real_variable( ncid, 'hybm', (/ 'lev' /), routine)
+call nc_add_attribute_to_variable(ncid, 'hybm', 'long_name', 'hybrid B coefficient at layer midpoints', routine)
-call get_time(forecast_length, second, day)
-hour = second/3600
-minute = mod(second,3600)
-if (minute/=0) &
- call error_handler(E_ERR, 'write_cam_times', &
- ' not integer number of hours; nhtfrq error', source, revision, revdate);
+call nc_define_real_variable( ncid, 'hyai', (/ 'ilev' /), routine)
+call nc_add_attribute_to_variable(ncid, 'hyai', 'long_name', 'hybrid A coefficient at layer interfaces', routine)
-! convert to hours, and negative to signal units are hours
-nhtfrq = -1*(day*24 + hour)
+call nc_define_real_variable( ncid, 'hybi', (/ 'ilev' /), routine)
+call nc_add_attribute_to_variable(ncid, 'hybi', 'long_name', 'hybrid B coefficient at layer interfaces', routine)
+! Gaussian Weights
+call nc_define_real_variable( ncid, 'gw', (/ 'lat' /), routine)
+call nc_add_attribute_to_variable(ncid, 'gw', 'long_name', 'gauss weights', routine)
-tfile_unit = open_file("times", "formatted", "write")
+call nc_define_real_scalar( ncid, 'P0', routine)
+call nc_add_attribute_to_variable(ncid, 'P0', 'long_name', 'reference pressure', routine)
+call nc_add_attribute_to_variable(ncid, 'P0', 'units', 'Pa', routine)
-call get_date(adv_time, year, month, day, hour, minute, second)
+! Finished with dimension/variable definitions, must end 'define' mode to fill.
-cam_date = year*10000 + month*100 + day
-cam_tod = hour*3600 + minute*60 + second
+call nc_end_define_mode(ncid, routine)
-write(tfile_unit,'(I8.8,1X,I8)') cam_date, cam_tod
+!----------------------------------------------------------------------------
+! Fill the coordinate variables
+!----------------------------------------------------------------------------
+
+call nc_put_variable(ncid, 'lon', grid_data%lon%vals, routine)
+call nc_put_variable(ncid, 'lat', grid_data%lat%vals, routine)
+call nc_put_variable(ncid, 'slon', grid_data%slon%vals, routine)
+call nc_put_variable(ncid, 'slat', grid_data%slat%vals, routine)
+call nc_put_variable(ncid, 'lev', grid_data%lev%vals, routine)
+call nc_put_variable(ncid, 'ilev', grid_data%ilev%vals, routine)
+call nc_put_variable(ncid, 'gw', grid_data%gw%vals, routine)
+call nc_put_variable(ncid, 'hyam', grid_data%hyam%vals, routine)
+call nc_put_variable(ncid, 'hybm', grid_data%hybm%vals, routine)
+call nc_put_variable(ncid, 'hyai', grid_data%hyai%vals, routine)
+call nc_put_variable(ncid, 'hybi', grid_data%hybi%vals, routine)
+call nc_put_variable(ncid, 'P0', grid_data%P0%vals, routine)
+
+! flush any pending i/o to disk
+call nc_synchronize_file(ncid, routine)
+end subroutine nc_write_model_atts
-call get_date(model_time, year, month, day, hour, minute, second)
+!-----------------------------------------------------------------------
+!> writes CAM's model date and time of day into file. CAM uses
+!> integer date values and interger time of day measured in seconds
+!>
+!> @param ncid name of the file
+!> @param model_time the current time of the model state
+!>
-cam_date = year*10000 + month*100 + day
-cam_tod = hour*3600 + minute*60 + second
+subroutine write_model_time(ncid, model_time)
+integer, intent(in) :: ncid
+type(time_type), intent(in) :: model_time
-write(tfile_unit,'(I8.8,1X,I8)') cam_date, cam_tod
+integer :: iyear, imonth, iday, ihour, iminute, isecond
+integer :: cam_date(1), cam_tod(1)
-write(tfile_unit,'(I8)') nhtfrq
+character(len=*), parameter :: routine = 'write_model_time'
-close(tfile_unit)
+if ( .not. module_initialized ) call static_init_model
+call get_date(model_time, iyear, imonth, iday, ihour, iminute, isecond)
-end subroutine write_cam_times
+cam_date = iyear*10000 + imonth*100 + iday
+cam_tod = ihour*3600 + iminute*60 + isecond
-!-----------------------------------------------------------------------
+! if the file doesn't already have a "date" variable make one
+if (.not. nc_variable_exists(ncid, "date")) then
+ call nc_begin_define_mode(ncid, routine)
+ call nc_define_integer_variable(ncid, 'date', (/ 'time' /), routine)
+ call nc_end_define_mode(ncid, routine)
+ call nc_put_variable(ncid, 'date', cam_date, routine)
+endif
+
+! if the file doesn't already have a "datesec" variable make one
+if (.not. nc_variable_exists(ncid, "datesec")) then
+ call nc_begin_define_mode(ncid, routine)
+ call nc_define_integer_variable(ncid, 'datesec', (/ 'time' /), routine)
+ call nc_end_define_mode(ncid, routine)
+ call nc_put_variable(ncid, 'datesec', cam_tod, routine)
+endif
+
+end subroutine write_model_time
+
+!--------------------------------------------------------------------
!>
-!> Subroutine get_state_meta_data
-!> Given an integer index into the state vector structure,
-!> returns the associated location and vertical location type 'which_vert'.
-!> Optionally returns the DART QTY of the variable.
-!>
-!> @param[in] index_in
-!> The 'index' of a variable in the state vector, whose physical location
-!> and possibly variable kind are needed,
+!> Read the time from the input file
+!>
+!> @param filename name of file that contains the time
!>
-!> @param[inout] location
-!> The DART location_type location of the variable denoted by 'index'
-!>
-!> @param[out] var_kind
-!> The optional argument which can return the DART QTY of the variable.
+function read_model_time(filename)
-subroutine get_state_meta_data(index_in, location, var_kind)
+character(len=*), intent(in) :: filename
+type(time_type) :: read_model_time
-! Given an integer index into the state vector structure, returns the
-! associated location.
-! The location may have components that are MISSING_R8 values, since some fields
-! don't have locations in all three dimensions, i.e. PS has no vertical level,
-! and other fiendish fields to be devised by parameterization studies may not
-! have a longitude, or latitude. The which_vert should take care of the vertical
-! coordinate (it will be ignored), but the others will require more interesting fixes.
-! See order_state_fields for the QTY_s (and corresponding model variable names).
+integer :: ncid
+integer :: cam_date, cam_tod
+integer :: iyear, imonth, iday, ihour, imin, isec, rem
-integer(i8), intent(in) :: index_in
-type(location_type), intent(out) :: location
-integer, optional, intent(out) :: var_kind
+character(len=*), parameter :: routine = 'read_model_time'
-integer :: which_vert
-integer :: i, indx, index_1, index_2, index_3, nfld
-integer :: box, slice
-logical :: lfound
+if ( .not. module_initialized ) call static_init_model
-real(r8) :: lon_val, lat_val, lev_val
-integer :: ip, jp, kp, dom_id
-integer :: ndims
+if ( .not. file_exist(filename) ) then
+ write(string1,*) trim(filename), ' does not exist.'
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
+endif
-if (.not. module_initialized) call static_init_model()
+ncid = nc_open_file_readonly(filename, routine)
-lon_val = MISSING_R8
-lat_val = MISSING_R8
-lev_val = MISSING_R8
+! CAM initial files have two variables of length
+! 'time' (the unlimited dimension): date, datesec
-! get the state indices from dart index
-! RMA-KR; Will this work for cubed sphere or other 'unstructured' grids?
-! I think so; ip, jp, and kp are interpreted according to the dimension
-! name in the coord_val calls, next.
-call get_model_variable_indices(index_in, ip ,jp ,kp ,var_id=nfld, dom_id=dom_id)
+call nc_get_variable(ncid, 'date', cam_date, routine)
+call nc_get_variable(ncid, 'datesec', cam_tod, routine)
-! convert to lat, lon, lev coordinates
-call coord_val(get_dim_name(dom_id,nfld,3), kp, lon_val, lat_val, lev_val)
-call coord_val(get_dim_name(dom_id,nfld,2), jp, lon_val, lat_val, lev_val)
-call coord_val(get_dim_name(dom_id,nfld,1), ip, lon_val, lat_val, lev_val)
+! 'date' is YYYYMMDD
+! 'cam_tod' is seconds of current day
+iyear = cam_date / 10000
+rem = cam_date - iyear*10000
+imonth = rem / 100
+iday = rem - imonth*100
-ndims = get_num_dims(dom_id, nfld)
+ihour = cam_tod / 3600
+rem = cam_tod - ihour*3600
+imin = rem / 60
+isec = rem - imin*60
-! RMA-KR; This will need to be changed for CAM-SE; 1d and 2d
-if( ndims == 2 ) then
- which_vert = which_vert_2d(nfld)
-else
- which_vert = which_vert_3d(nfld-state_num_2d)
-endif
+! some cam files are from before the start of the gregorian calendar.
+! since these are 'arbitrary' years, just change the offset.
+if (iyear < 1601) then
+ write(string1,*)' '
+ write(string2,*)'WARNING - ',trim(filename),' changing year from ', &
+ iyear,'to',iyear+1601
-! This routine should error out for fields that have MISSING_R8 in lat_val or lon_val.
-if (lon_val == MISSING_R8 .or. lat_val == MISSING_R8 ) then
- write(string1, *) 'Field ',cflds(nfld),' has no lon or lat dimension. ', &
- 'What should be specified for it in the call to location?'
- call error_handler(E_ERR, 'get_state_meta_data', string1, source, revision, revdate)
-else
- location = set_location(lon_val, lat_val, lev_val, which_vert)
-endif
+ call error_handler(E_MSG, routine, string1, source, revision, &
+ revdate, text2=string2,text3='to make it a valid Gregorian date.')
-! If the type is wanted, return it
-if (present(var_kind)) then
- ! used by call from assim_tools_mod:filter_assim, which wants the DART QTY_
- var_kind = cam_to_dart_qtys(nfld)
+ write(string1,*)' '
+ call error_handler(E_MSG, routine, string1, source, revision)
+ iyear = iyear + 1601
endif
-end subroutine get_state_meta_data
+read_model_time = set_date(iyear,imonth,iday,ihour,imin,isec)
-!-----------------------------------------------------------------------
-!>
-!> Function get_model_size assigns the 'model_size' calculated in static_init_model
-!> to the function result 'get_model_size'.
+call nc_close_file(ncid, routine)
-function get_model_size()
+end function read_model_time
-integer(i8) :: get_model_size
+!--------------------------------------------------------------------
+!> if the namelist is set to not use this custom routine, the default
+!> dart routine will add 'pert_amp' of noise to every field in the state
+!> to generate an ensemble from a single member. if it is set to true
+!> this routine will be called. the pert_amp will be ignored, and the
+!> given list of quantities will be perturbed by the given amplitude
+!> (which can be different for each field) to generate an ensemble.
-if (.not. module_initialized) call static_init_model()
+subroutine pert_model_copies(state_ens_handle, ens_size, pert_amp, interf_provided)
+type(ensemble_type), intent(inout) :: state_ens_handle
+integer, intent(in) :: ens_size
+real(r8), intent(in) :: pert_amp ! ignored in this version
+logical, intent(out) :: interf_provided
-get_model_size = model_size
+type(random_seq_type) :: seq
-end function get_model_size
+integer :: iloc, jloc, vloc, myqty
+integer :: max_qtys, j
-!-----------------------------------------------------------------------
-!>
-!> Function shortest_time_between_assimilations assigns the 'Time_step_atmos' calculated in
-!> static_init_model to the function result 'shortest_time_between_assimilations'.
+integer(i8) :: i, state_items
+integer(i8), allocatable :: my_vars(:)
-function shortest_time_between_assimilations()
+logical, allocatable :: do_these_qtys(:)
+real(r8), allocatable :: perturb_by(:)
-! Returns the shortest time you want to ask the model to
-! advance in a single step
+character(len=*), parameter :: routine = 'pert_model_copies:'
-type(time_type) :: shortest_time_between_assimilations
+! set by namelist to select using the default routine in filter
+! (adds the same noise to all parts of the state vector)
+! or the code here that lets you specify which fields get perturbed.
+if (custom_routine_to_generate_ensemble) then
+ interf_provided = .true.
+else
+ interf_provided = .false.
+ return
+endif
-if (.not. module_initialized) call static_init_model()
+! make sure each task is using a different random sequence
+call init_random_seq(seq, my_task_id())
-shortest_time_between_assimilations = Time_step_atmos
+max_qtys = get_num_quantities()
+allocate(do_these_qtys(0:max_qtys), perturb_by(0:max_qtys))
+
+do_these_qtys(:) = .false.
+perturb_by(:) = 0.0_r8
+
+! this loop is over the number of field names/perturb values
+! in the namelist. it quits when it finds a blank field name.
+do i=1, MAX_PERT
+ if (fields_to_perturb(i) == '') exit
+
+ myqty = get_index_for_quantity(fields_to_perturb(i))
+ if (myqty < 0) then
+ string1 = 'unrecognized quantity name in "fields_to_perturb" list: ' // &
+ trim(fields_to_perturb(i))
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
+ endif
+
+ do_these_qtys(myqty) = .true.
+ perturb_by(myqty) = perturbation_amplitude(i)
+enddo
+
+! get the global index numbers of the part of the state that
+! we have in this task. here is an example of how to work with
+! just the part of the state that is on the current task.
+state_items = get_my_num_vars(state_ens_handle)
+allocate(my_vars(state_items))
+call get_my_vars(state_ens_handle, my_vars)
+
+! this loop is over all the subset of the state items
+! that are on this MPI task.
+do i=1, state_items
+
+ ! for each global index number in the state vector find
+ ! what quantity it is. (iloc,jloc,vloc are unused here)
+ call get_model_variable_indices(my_vars(i), iloc, jloc, vloc, kind_index=myqty)
+
+ ! if myqty is in the namelist, perturb it. otherwise cycle
+ if (.not. do_these_qtys(myqty)) cycle
+
+ ! this loop is over the number of ensembles
+ do j=1, ens_size
+ state_ens_handle%copies(j, i) = random_gaussian(seq, state_ens_handle%copies(j, i), perturb_by(myqty))
+ enddo
+
+enddo
+
+deallocate(my_vars)
+deallocate(do_these_qtys, perturb_by)
+
+end subroutine pert_model_copies
-end function shortest_time_between_assimilations
+
+!-----------------------------------------------------------------------
+! The remaining (private) interfaces come last.
+! None of the private interfaces need to call static_init_model()
+!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!>
-!> nc_write_model_atts
-!> writes the model-specific attributes to a netCDF file.
-!>
-!> @param[in] ncid
-!> netCDF file identifier
+!> Fill the array of requested variables, dart kinds, possible min/max
+!> values and whether or not to update the field in the output file.
+!> Then calls 'add_domain()' to tell the DART code which variables to
+!> read into the state vector after this code returns.
!>
-!> @param[in] domain_id
-!> domain identifier (CAM has only 1 domain).
+!>@param variable_array the list of variables and kinds from model_mod_nml
+!>@param nfields the number of variable/Quantity pairs specified
-subroutine nc_write_model_atts( ncid, domain_id )
+subroutine set_cam_variable_info( variable_array, nfields )
+character(len=*), intent(in) :: variable_array(:)
+integer, intent(out) :: nfields
-integer, intent(in) :: ncid ! netCDF file identifier
-integer, intent(in) :: domain_id
+character(len=*), parameter :: routine = 'set_cam_variable_info:'
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+integer :: i
+integer, parameter :: MAX_STRING_LEN = 128
-integer :: n_dims, n_vars, n_attribs, unlimited_dim_ID
-integer :: member_dim_ID, state_var_dim_ID, time_dim_ID,scalar_dim_ID
-integer :: x_var_ID,state_var_ID, state_var_var_ID
-! Add 1 to num_dims, for P0.
-! This hard-wiring should be replaced if more D0 'coordinates' are added.
-integer :: P_id(num_dims+1)
-integer :: i, ifld, dim_id, g_id
-integer :: grid_id(grid_num_1d)
+character(len=MAX_STRING_LEN) :: varname ! column 1, NetCDF variable name
+character(len=MAX_STRING_LEN) :: dartstr ! column 2, DART Quantity
+character(len=MAX_STRING_LEN) :: minvalstr ! column 3, Clamp min val
+character(len=MAX_STRING_LEN) :: maxvalstr ! column 4, Clamp max val
+character(len=MAX_STRING_LEN) :: updatestr ! column 5, Update output or not
-if (.not. module_initialized) call static_init_model()
+character(len=vtablenamelength) :: var_names(MAX_STATE_VARIABLES) = ' '
+logical :: update_list(MAX_STATE_VARIABLES) = .FALSE.
+integer :: kind_list(MAX_STATE_VARIABLES) = MISSING_I
+real(r8) :: clamp_vals(MAX_STATE_VARIABLES,2) = MISSING_R8
-! Write Global Attributes
-call nc_begin_define_mode(ncid)
+nfields = 0
+ParseVariables : do i = 1, MAX_STATE_VARIABLES
-call nc_add_global_creation_time(ncid)
+ varname = variable_array(num_state_table_columns*i-4)
+ dartstr = variable_array(num_state_table_columns*i-3)
+ minvalstr = variable_array(num_state_table_columns*i-2)
+ maxvalstr = variable_array(num_state_table_columns*i-1)
+ updatestr = variable_array(num_state_table_columns*i )
-call nc_add_global_attribute(ncid, "model_source", source)
-call nc_add_global_attribute(ncid, "model_revision", revision)
-call nc_add_global_attribute(ncid, "model_revdate", revdate)
+ if ( varname == ' ' .and. dartstr == ' ' ) exit ParseVariables ! Found end of list.
-call nc_add_global_attribute(ncid, "model", "CAM")
+ if ( varname == ' ' .or. dartstr == ' ' ) then
+ string1 = 'model_nml:model "state_variables" not fully specified'
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
+ endif
-! Define the new dimensions IDs
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-! They have different dimids for this file than they had for caminput.nc
-! P_id serves as a map between the 2 sets.
-if (print_details .and. output_task0) then
- write(string1,*) 'num_dims = ',num_dims
- write(string2,*) ' dimens, name, size, cam dim_id, P[oste]rior id'
- call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate, text2=string2)
-endif
+ ! Make sure DART kind is valid
-! P_id debug
-! This loops over the number of DIMENSIONS/COORDINATES on the file, not including P0.
-! So P_id needs to be defined for P0 after this loop.
-do i = 1,num_dims
- if (trim(dim_names(i)) /= 'time') then
- call nc_check(nf90_def_dim(ncid, name=trim(dim_names(i)), len=dim_sizes(i), &
- dimid=P_id(i)), 'nc_write_model_atts','def_dim '//trim(dim_names(i)))
- else
- ! time, not P0
- P_id(i) = 0
+ if( get_index_for_quantity(dartstr) < 0 ) then
+ write(string1,'(3A)') 'there is no obs_kind "', trim(dartstr), '" in obs_kind_mod.f90'
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
endif
- if (print_details .and. output_task0) then
- write(string1,'(I5,1X,A13,1X,2(I7,2X))') i,trim(dim_names(i)),dim_sizes(i), P_id(num_dims)
- call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate)
- endif
-enddo
-call nc_check(nf90_def_dim(ncid, name="scalar", len=1, dimid=scalar_dim_ID) &
- ,'nc_write_model_atts', 'def_dim scalar')
-call nc_check(nf90_def_dim(ncid, name="P0", len=1, dimid=P_id(num_dims+1)) &
- ,'nc_write_model_atts', 'def_dim scalar')
-if (print_details .and. output_task0) then
- write(string1,'(I5,1X,A13,1X,2(I7,2X))') i,'P0',P0%length, P_id(i)
- call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate)
-endif
+ call to_upper(minvalstr)
+ call to_upper(maxvalstr)
+ call to_upper(updatestr)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Create the (empty) Coordinate Variables and their attributes
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ var_names( i) = varname
+ kind_list( i) = get_index_for_quantity(dartstr)
+ clamp_vals(i,1) = string_to_real(minvalstr)
+ clamp_vals(i,2) = string_to_real(maxvalstr)
+ update_list( i) = string_to_logical(updatestr, 'UPDATE')
-! grid longitudes, latitudes, levels, and other coordinates.
-! grid_id() is filled here; it's the dimid of the desired coordinate *on this P_Diag.nc file*.
-! It's used to write coordinates. ! There's some overlap of names, unfortunately.
-! The argument after the 'xxx ' label is a structure with all the relevant info in it.
-! The structures are defined in "Grid fields" and filled by calls to create_grid_1d_instance
-! in read_cam_coord.
+ nfields = nfields + 1
-grid_id = MISSING_I
+enddo ParseVariables
-if (lon%label /= ' ') then
- dim_id = P_id(lon%dim_id)
- g_id = find_name('lon',grid_names_1d)
- call write_cam_coord_def(ncid,'lon',lon , dim_id, grid_id(g_id))
-endif
-if (lat%label /= ' ') then
- dim_id = P_id(lat%dim_id)
- g_id = find_name('lat',grid_names_1d)
- call write_cam_coord_def(ncid,'lat',lat , dim_id, grid_id(g_id))
-endif
-if (lev%label /= ' ') then
- dim_id = P_id(lev%dim_id)
- g_id = find_name('lev',grid_names_1d)
- call write_cam_coord_def(ncid,'lev',lev , dim_id, grid_id(g_id))
-! Gaussian weights -- because they're there.
-endif
-if (gw%label /= ' ') then
- dim_id = P_id(gw%dim_id)
- g_id = find_name('gw',grid_names_1d)
- call write_cam_coord_def(ncid,'gw',gw , dim_id, grid_id(g_id))
-! Hybrid grid level coefficients, parameters
-endif
-if (hyam%label /= ' ') then
- dim_id = P_id(hyam%dim_id)
- g_id = find_name('hyam',grid_names_1d)
- call write_cam_coord_def(ncid,'hyam',hyam, dim_id, grid_id(g_id))
-endif
-if (hybm%label /= ' ') then
- dim_id = P_id(hybm%dim_id)
- g_id = find_name('hybm',grid_names_1d)
- call write_cam_coord_def(ncid,'hybm',hybm, dim_id, grid_id(g_id))
-endif
-if (hyai%label /= ' ') then
- dim_id = P_id(hyai%dim_id)
- g_id = find_name('hyai',grid_names_1d)
- call write_cam_coord_def(ncid,'hyai',hyai, dim_id, grid_id(g_id))
-endif
-if (hybi%label /= ' ') then
- dim_id = P_id(hybi%dim_id)
- g_id = find_name('hybi',grid_names_1d)
- call write_cam_coord_def(ncid,'hybi',hybi, dim_id, grid_id(g_id))
-endif
-if (slon%label /= ' ') then
- dim_id = P_id(slon%dim_id)
- g_id = find_name('slon',grid_names_1d)
- call write_cam_coord_def(ncid,'slon',slon, dim_id, grid_id(g_id))
-endif
-if (slat%label /= ' ') then
- dim_id = P_id(slat%dim_id)
- g_id = find_name('slat',grid_names_1d)
- call write_cam_coord_def(ncid,'slat',slat, dim_id, grid_id(g_id))
-endif
-if (ilev%label /= ' ') then
- dim_id = P_id(ilev%dim_id)
- g_id = find_name('ilev',grid_names_1d)
- call write_cam_coord_def(ncid,'ilev',ilev, dim_id, grid_id(g_id))
-endif
-if (P0%label /= ' ') then
- dim_id = P_id(num_dims+1)
- ! At some point, replace the kluge of putting P0 in with 'coordinates'
- ! by defining grid_0d_kind, etc.
- g_id = find_name('P0',grid_names_1d)
- call write_cam_coord_def(ncid,'P0',P0 , dim_id, grid_id(g_id))
-endif
+if (nfields == MAX_STATE_VARIABLES) then
+ write(string1,'(2A)') 'WARNING: There is a possibility you need to increase ', &
+ 'MAX_STATE_VARIABLES in the global variables in model_mod.f90'
-if (print_details .and. output_task0) then
- write(string1,*) '1d field#, grid_id, grid_names_1d'
- call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate)
- do i=1,grid_num_1d
- write(string1,*) 'grid_ = ', i, grid_id(i), trim(grid_names_1d(i))
- call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate)
- enddo
+ write(string2,'(A,i4,A)') 'WARNING: you have specified at least ', nfields, &
+ ' perhaps more'
+
+ call error_handler(E_MSG,routine,string1,source,revision,revdate,text2=string2)
endif
-! Leave define mode so we can fill variables
-call nc_end_define_mode(ncid)
+! CAM only has a single domain (only a single grid, no nests or multiple grids)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Fill the coordinate variables
-! Each 'vals' vector has been dimensioned to the right size for its coordinate.
-! The default values of 'start' and 'count' write out the whole thing.
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-if (lon%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('lon',grid_names_1d)), lon%vals) &
- ,'nc_write_model_atts', 'put_var lon')
-if (lat%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('lat',grid_names_1d)), lat%vals) &
- ,'nc_write_model_atts', 'put_var lat')
-if (lev%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('lev',grid_names_1d)), lev%vals) &
- ,'nc_write_model_atts', 'put_var lev')
-if (gw%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('gw',grid_names_1d)), gw%vals) &
- ,'nc_write_model_atts', 'put_var gw')
-if (hyam%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('hyam',grid_names_1d)), hyam%vals) &
- ,'nc_write_model_atts', 'put_var hyam')
-if (hybm%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('hybm',grid_names_1d)), hybm%vals) &
- ,'nc_write_model_atts', 'put_var hybm')
-if (hyai%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('hyai',grid_names_1d)), hyai%vals) &
- ,'nc_write_model_atts', 'put_var hyai')
-if (hybi%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('hybi',grid_names_1d)), hybi%vals) &
- ,'nc_write_model_atts', 'put_var hybi')
-if (slon%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('slon',grid_names_1d)), slon%vals) &
- ,'nc_write_model_atts', 'put_var slon')
-if (slat%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('slat',grid_names_1d)), slat%vals) &
- ,'nc_write_model_atts', 'put_var slat')
-if (ilev%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('ilev',grid_names_1d)), ilev%vals) &
- ,'nc_write_model_atts', 'put_var ilev')
-if (P0%label /= ' ') &
- call nc_check(nf90_put_var(ncid, grid_id(find_name('P0',grid_names_1d)), P0%vals) &
- ,'nc_write_model_atts', 'put_var P0')
-
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! Flush the buffer and leave netCDF file open
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-call nc_synchronize_file(ncid)
+domain_id = add_domain(cam_template_filename, nfields, var_names, kind_list, &
+ clamp_vals, update_list)
-end subroutine nc_write_model_atts
+call fill_cam_stagger_info(grid_stagger)
-! End of Module I/O
+if (debug_level > 100) call state_structure_info(domain_id)
-!#######################################################################
+end subroutine set_cam_variable_info
-! model_interpolate section
!-----------------------------------------------------------------------
!>
-!> Subroutine model_interpolate
-!> Interpolates the provided state vector (on model grid points) to an arbitrary
-!> location in the atmosphere (e.g. where an observation is).
-!>
-!> @param[in] state_handle
-!> The DART ensemble_type structure which gives access to the ensemble of model states.
+!> Fill the qty_stagger array to tell what type of stagger each variable
+!> has. This will be useful for interpolating observations.
+!> This currently doesn't support both slon/slat stagger - but cam-fv
+!> doesn't have any fields like that.
!>
-!> @param[in] :: ens_size
-!> The size of the ensemble.
-!>
-!> @param[in] :: location
-!> The DART location_type 'location' of the desired state estimate.
-!>
-!> @param[in] :: obs_kind
-!> The DART QTY of the variable being estimated.
-!>
-!> @param[out] :: expected_obs
-!> The ensemble state estimate of the 'obs_kind' at 'location'.
-!>
-!> @param[out] :: istatus
-!> A flag to signal the success of the interpolation.
+subroutine fill_cam_stagger_info(stagger)
+type(cam_stagger), intent(inout) :: stagger
-subroutine model_interpolate(state_handle, ens_size, location, obs_kind, expected_obs, istatus)
+integer :: ivar, jdim, qty_index
-! This subroutine is now a short routine that calls
-! either a rectangular grid version for eul/FV
-! or non-rectangular for cubed-sphere code.
-! This does get QTYs from filter, not specific obs TYPEs.
+allocate(stagger%qty_stagger(0:get_num_quantities()))
-! Model_interpolate must return a positive value for istatus for a failure.
-! 0 means success, negative values are reserved for DART internal use.
+stagger%qty_stagger = STAGGER_NONE
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: ens_size
-type(location_type), intent(in) :: location ! The DART location_type 'location' of the desired state estimate.
-integer, intent(in) :: obs_kind ! The DART QTY of the variable being estimated.
-real(r8), intent(out) :: expected_obs(ens_size) ! The state estimate of the 'obs_kind' at 'location'
-integer, intent(out) :: istatus(ens_size) ! A flag to signal the success of the interpolation.
+do ivar = 1, get_num_variables(domain_id)
+ do jdim = 1, get_num_dims(domain_id, ivar)
-! FIXME; In future DARTs it may be useful to return the DART QTY too.
-! also convert to a field name (DART subroutine (get_raw_...?)).
+ if (get_dim_name(domain_id, ivar, jdim) == 'slat') then
+ qty_index = get_kind_index(domain_id, ivar)
+ stagger%qty_stagger(qty_index) = STAGGER_U
+ endif
-if (.not. module_initialized) call static_init_model()
+ if (get_dim_name(domain_id, ivar, jdim) == 'slon') then
+ qty_index = get_kind_index(domain_id, ivar)
+ stagger%qty_stagger(qty_index) = STAGGER_V
+ endif
-! FIXME; Tim test for ob being out of bounds (horizontally, vertically?)
-! and return if it is.
-! But interp_yyy might need to be called anyway (in the future), to get the value,
-! even if it won't be assimilated.
-! Also, lat bounds could be enforced here with a small amount of code,
-! but enforcing vertical bounds would require bringing lots of code from interp_yyy up here,
-! and have if-tests to separate out the lonlat from the cubed_sphere.
+ if (get_dim_name(domain_id, ivar, jdim) == 'ilev') then
+ qty_index = get_kind_index(domain_id, ivar)
+ stagger%qty_stagger(qty_index) = STAGGER_W
+ endif
-! FIXME; Tim Also add an argument to inter_XXX to tell it what to do when the ob
-! is out of bounds, but still calculatable.
+ enddo
+enddo
-call interp_lonlat(state_handle, ens_size, location, obs_kind, expected_obs, istatus)
+end subroutine fill_cam_stagger_info
-end subroutine model_interpolate
!-----------------------------------------------------------------------
+!> Read in the grid information from the given CAM restart file.
+!> Note that none of the data will be used from this file; just the
+!> grid size and locations. Also read in the elevation information
+!> from the "PHIS' file.
-recursive subroutine interp_lonlat(state_handle, ens_size, obs_loc, obs_kind, interp_val, istatus)
-
-! Find the 4 corners of the lon-lat grid cell that encloses an ob at 'obs_loc'
-! and interpolate the values of obs_kind to that location.
-
-! istatus meaning return expected obs? assimilate?
-! 0 obs and model are fine; yes yes
-! 1 fatal problem; no no
-! 2 exclude valid obs yes no (ob > ! highest_obs_X)
-! 3 unfamiliar obs type no no
-! 4 ob excl by namelist(lat) yes no
-! NM 2 digit number means more than one namelist reason to exclude from assim.
-
-! Any value > 0 will not be assimilated (---> QC non-0).
-! Do we want some istatus values to tell filter to evaluate (---> QC of 1)?
-! That would be nice, but filter has no convention for understanding non-0
-! values from model_mod (from all the available models). So all non-0 values of
-! istatus ---> QC = 4.
-
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: ens_size
-type(location_type), intent(in) :: obs_loc
-integer, intent(in) :: obs_kind
-real(r8), intent(out) :: interp_val(ens_size)
-integer, intent(out) :: istatus(ens_size)
-
-! FIXME; In future DARTs it may be useful to return the DART QTY too.
-! also convert to a field name (DART subroutine (get_raw_...?)).
-
-integer :: i, vstatus(ens_size), cur_vstatus(ens_size)
-real(r8) :: bot_lon, top_lon, delta_lon, &
- lon_below, lat_below, lat_above, lev_below, &
- lon_fract, lat_fract, temp_lon, a(ens_size, 2), &
- lon_lat_lev(3), convert_units
-real(r8), dimension(ens_size) :: val_11, val_12, val_21, val_22
-
-! FIXME: Positions within the rank 2 and 3 fields. I don't remember the issue...
-integer :: s_type, s_type_01d,s_type_2d,s_type_3d, &
- lon_ind_below, lon_ind_above, lat_ind_below, lat_ind_above, &
- num_lons
-character(len=8) :: lon_name, lat_name, lev_name
-
-! FIXME; idea of right number of dimensions for each field...
-! These are observations and will have 2d or 3d locations, but the
-! corresponding state-vector component could be missing one of the dimensions.
-! Surface pressure is the obvious example, but parameterization tuning might
-! introduce others.
-! Such artificial fields would not have observations associated with them.
-! So assume that observed fields are not missing any dimensions.
-
-! Start with failure, then change as warranted.
-istatus(:) = 1
-cur_vstatus(:) = 1
-vstatus(:) = 0 ! Assume good so you can keep track of vstatus
-val_11(:) = MISSING_R8
-val_12(:) = MISSING_R8
-val_21(:) = MISSING_R8
-val_22(:) = MISSING_R8
-interp_val(:) = MISSING_R8
-! Get the observation (horizontal) position, in degrees
-lon_lat_lev = get_location(obs_loc)
-
-! Check whether model_mod can interpolate the requested variable.
-! Pressure (3d) can't be specified as a state vector field (so s_type will = MISSING_I),
-! but can be calculated for CAM, so obs_kind = QTY_PRESSURE is acceptable.
-! obs_kind truly is a DART QTY variable, generally passed from
-! obs_def/obs_def_XXX.f90: call interpolate.
-! HK I think s_type is the index in cflds
-! RMA-KR; use a new mechanism to define s_type (as in 'clm_variables')
-! > > > Just loop through cflds until I find it.
-! Need the state_name of this obs_kind
-! CLM uses obs_kind. Is there a 1 to 1 match of CAM variables and DART QTYs?
-! > > >It requires hard-wiring all of the potential QTYs in the 'select case (obs_kind)' structure.
-! Could still have dart_to_cam?
-! Does paradigm of separating vars into 0d, 1d, 2d, and 3d make sense?
-s_type = find_name(dart_to_cam_types(obs_kind),cflds)
-
-if (s_type == MISSING_I) then
- if (obs_kind /= QTY_PRESSURE .and. obs_kind /= QTY_SURFACE_ELEVATION) then
- write(string1,*) 'Wrong type of obs = ', obs_kind,' "',trim(get_name_for_quantity(obs_kind)),'"'
- write(string2,*) 'Only QTY_PRESSURE and QTY_SURFACE_ELEVATION are supported.'
- call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate, text2=string2)
- return
- else
- ! CAM-chem 5))
- ! This will be used when interp_val is calculated,
- ! but define it here, as soon as it can be.
- ! Define for the non-chemical, non-state QTYs.
- convert_units = 1.0_r8
- endif
-else
- ! CAM-chem Define it here for state variables
- convert_units = convert_mmr2vmr(s_type)
-endif
+subroutine read_grid_info(grid_file, grid)
+character(len=*), intent(in) :: grid_file
+type(cam_grid), intent(out) :: grid
-! Get lon and lat dimension names.
-
-! Set [lon,lat,lev] names to a default, which will be overwritten for variables
-! in the state vector, but not for other acceptable variables (3D pressure, surface
-! elevation, ...?)
-lon_name = 'lon'
-lat_name = 'lat'
-if (obs_kind == QTY_SURFACE_ELEVATION) then
- lev_name = 'none'
-elseif (obs_kind == QTY_PRESSURE) then
- lev_name = 'lev'
-! else
-! set below
-endif
+! Get the grid info plus additional non-state arrays
+call get_cam_grid(grid_file, grid)
-! Need to get lon, lat, lev dimension names for this field
-
-
-! DART can't handle any 0d or 1d ob fields, so lump them together for elimination in this search.
-s_type_01d = state_num_0d + state_num_1d
-s_type_2d = s_type - s_type_01d
-s_type_3d = s_type_2d - state_num_2d
-
-! HK This if statement is just finding the rank of the variable (0D, 1D, 2D, 3D).
-if (s_type == MISSING_I .and. &
- (obs_kind == QTY_PRESSURE) .or. (obs_kind == QTY_SURFACE_ELEVATION)) then
- ! use defaults lon_name and lat_name set above
-elseif (s_type <= state_num_0d + state_num_1d) then
- ! error; can't deal with observed variables that are 0 or 1D in model_mod.
-! istatus = 1
-! interp_val = MISSING_R8
- write(string1,*) 'DART cannot handle 0d or 1d observations of ', cflds(s_type), &
- ' because DART requires a (lon,lat) location for each observation '
- write(string2,*) 'Skipping this observation'
- call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate, text2=string2)
- return
-elseif (s_type_2d > 0 .and. s_type_2d <= state_num_2d) then
- lon_name = get_lon_name(s_type)
- lat_name = get_lat_name(s_type)
- lev_name = 'none'
-elseif (s_type_3d > 0 .and. s_type_3d <= state_num_3d) then
- lon_name = get_lon_name(s_type)
- lat_name = get_lat_name(s_type)
- lev_name = get_lev_name(s_type)
-else
-! istatus = 1
-! interp_val = MISSING_R8
- write(string1,*) 'Unexpected state type value, s_type = ', s_type
- call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate)
- return
-endif
+! This non-state variable is used to compute surface elevation.
+call read_cam_phis_array(cam_phis_filename)
+! Set up the interpolation structures for later
+call setup_interpolation(grid)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! staggered longitudes; slon (4x5 fv grid) = [-2.5, 2.5,...,352.5] !
-! lon ( " ) = [ 0., 5.,..., 355.]
-! This is a complication for lon = 359, for example. It's not in the range of slon.
-! coord_index handles it.
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-! Compute bracketing lon indices
-! Define a local longitude to deal with CAM-FV's staggered, longitude grid.
-temp_lon = lon_lat_lev(1)
-
-if (lon_name == 'lon') then
- num_lons = lon%length
- bot_lon = lon%vals(1)
- top_lon = lon%vals(num_lons)
- delta_lon = lon%vals(2) - lon%vals(1)
-elseif (lon_name == 'slon') then
- num_lons = slon%length
- bot_lon = slon%vals(1)
- top_lon = slon%vals(num_lons)
- delta_lon = slon%vals(2) - slon%vals(1)
- ! Make certain longitudes conform to the CAM staggered grid.
- if ((lon_lat_lev(1) - top_lon) >= delta_lon) temp_lon = lon_lat_lev(1) - 360.0_r8
-endif
+end subroutine read_grid_info
-if (temp_lon >= bot_lon .and. temp_lon < top_lon) then
- ! adding the 1 makes up for subtracting the bot_lon.
- lon_ind_below = int((temp_lon - bot_lon) / delta_lon) + 1
- lon_ind_above = lon_ind_below + 1
- lon_fract = (temp_lon - ((lon_ind_below - 1) * delta_lon + bot_lon)) / delta_lon
-else
- ! At wraparound point
- lon_ind_above = 1
- lon_ind_below = num_lons
- lon_fract = (temp_lon - top_lon) / delta_lon
-endif
+!-----------------------------------------------------------------------
+!> Read the data from the various cam grid arrays
+!>
+!>@todo FIXME not all of these are used. can we either
+!> not read them in, or make them optional? this does affect
+!> what we can write out in the diagnostic file. if we have
+!> to have them in the diag files then we have to read them all
+!> even if we never use them. both ilev and gw currently fall
+!> into this category.
+!>
-! Next, compute neighboring lat rows
-! NEED TO BE VERY CAREFUL ABOUT POLES; WHAT'S BEING DONE MAY BE WRONG
-! Inefficient search used for latitudes in Gaussian grid. Might want to speed up.
-! CAM-FV; lat = -90., ... ,90.
-! slat = -88.,...,88.
-
-call coord_index(lat_name, lon_lat_lev(2), lat_ind_above, lat_ind_below)
-
-! FIXME; maybe move this into coord_index
-! Probably not; coord_index sometimes returns the single closest index,
-! which will always be the first index returned.
-! I suppose there could be a flag argument telling coord_index
-! whether to return 1 or a pair, with the 2nd index always > first
-! (or vice versa).
-! calculate and return fraction too?
-if (lat_ind_above == lat_ind_below) then
- if (lat_ind_above == 1) then
- lat_fract = 0.0_r8
- else !both must be equal to the max (s)lat index
- lat_fract = 1.0_r8
- endif
-else
- if (lat_ind_above < lat_ind_below) then
- ! switch order
- i = lat_ind_above
- lat_ind_above = lat_ind_below
- lat_ind_below = i
- endif
- ! only lat_xxx is changed by these calls
- call coord_val(lat_name, lat_ind_below, lon_below, lat_below, lev_below)
- call coord_val(lat_name, lat_ind_above, lon_below, lat_above, lev_below)
- lat_fract = (lon_lat_lev(2) - lat_below) / (lat_above - lat_below)
-endif
+subroutine get_cam_grid(grid_file, grid)
+character(len=*), intent(in) :: grid_file
+type(cam_grid), intent(out) :: grid
-! Find the values for the four corners
-
-! Determine the vertical coordinate: model level, pressure, or height
-if (obs_kind == QTY_SURFACE_ELEVATION) then
- ! Acceptable field that's not in the state vector, same across the ensemble
- ! convert from geopotential height to real height in meters
- val_11(:) = phis(lon_ind_below, lat_ind_below) / gravity_const
- val_12(:) = phis(lon_ind_below, lat_ind_above) / gravity_const
- val_21(:) = phis(lon_ind_above, lat_ind_below) / gravity_const
- val_22(:) = phis(lon_ind_above, lat_ind_above) / gravity_const
- if (val_11(1) == MISSING_R8 .or. &
- val_12(1) == MISSING_R8 .or. &
- val_21(1) == MISSING_R8 .or. &
- val_22(1) == MISSING_R8 ) then
- vstatus(:) = 1
- write(string1,*) 'interp_lonlat: val_##(mem1) = MISSING_R* for ',&
- 'lon, lat near ',lon_ind_above, lat_ind_above
- call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate)
- endif
+character(len=*), parameter :: routine = 'get_cam_grid:'
-elseif (is_vertical(obs_loc, "LEVEL")) then
- ! Pobs
- ! FIXME; I may want to change get_val_level to accept REAL level, not INT.
- ! What's the benefit?
- ! But it would be inconsistent with lon_ and lat_ indices,
- ! and I'd have to create an integer level anyway.
- ! May also want to handle staggered vertical grid (ilev).
- call get_val_level(state_handle, ens_size, lon_ind_below, lat_ind_below, nint(lon_lat_lev(3)), obs_kind, val_11, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_level(state_handle, ens_size, lon_ind_below, lat_ind_above, nint(lon_lat_lev(3)), obs_kind, val_12, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_level(state_handle, ens_size, lon_ind_above, lat_ind_below, nint(lon_lat_lev(3)), obs_kind, val_21, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_level(state_handle, ens_size, lon_ind_above, lat_ind_above, nint(lon_lat_lev(3)), obs_kind, val_22, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
-
-
-elseif (is_vertical(obs_loc, "PRESSURE")) then
- call get_val_pressure(state_handle, ens_size,lon_ind_below,lat_ind_below,lon_lat_lev(3),obs_kind,val_11,cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_pressure(state_handle, ens_size,lon_ind_below,lat_ind_above,lon_lat_lev(3),obs_kind,val_12,cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_pressure(state_handle, ens_size,lon_ind_above,lat_ind_below,lon_lat_lev(3),obs_kind,val_21,cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_pressure(state_handle, ens_size,lon_ind_above,lat_ind_above,lon_lat_lev(3),obs_kind,val_22,cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
-
-elseif (is_vertical(obs_loc, "HEIGHT")) then
- call get_val_height(state_handle, ens_size, lon_ind_below, lat_ind_below, lon_lat_lev(3), obs_loc, obs_kind, val_11, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_height(state_handle, ens_size, lon_ind_below, lat_ind_above, lon_lat_lev(3), obs_loc, obs_kind, val_12, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_height(state_handle, ens_size,lon_ind_above, lat_ind_below, lon_lat_lev(3), obs_loc, obs_kind, val_21, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_height(state_handle, ens_size,lon_ind_above, lat_ind_above, lon_lat_lev(3), obs_loc, obs_kind, val_22, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
-
-elseif (is_vertical(obs_loc, "SURFACE")) then
- ! The 'lev' argument is set to 1 because there is no level for these types, and 'lev' will be
- ! ignored.
- call get_val(state_handle, ens_size, lon_ind_below, lat_ind_below, 1, obs_kind, val_11, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val(state_handle, ens_size, lon_ind_below, lat_ind_above, 1, obs_kind, val_12, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val(state_handle, ens_size, lon_ind_above, lat_ind_below, 1, obs_kind, val_21, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val(state_handle, ens_size, lon_ind_above, lat_ind_above, 1, obs_kind, val_22, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
-
-! This needs to be at the end of the block. Otherwise, it short circuits GPS
-! which asks for pressures on heights.
-! elseif (obs_kind == QTY_PRESSURE) then
-! ! Calculate pressures from surface pressures and A and B coeffs.
-! write(string1,'(A)') 'No code available yet for obs_kind = QTY_PRESSURE '
-! call error_handler(E_ERR, 'interp_lon_lat', string1)
-
-elseif (is_vertical(obs_loc, "SCALE_HEIGHT")) then
- ! Need option for this case
- write(string1,*)'Scale height is not an acceptable vert coord yet. Skipping observation'
- call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate)
- return
+integer :: ncid
-! Need option for is_vertical("UNDEFINED")
-else
- write(string1,*) ' No vert option chosen!'
- call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate)
- return
+! put this in a subroutine that deals with the grid
+ncid = nc_open_file_readonly(grid_file, routine)
-endif
+call fill_cam_1d_array(ncid, 'lon', grid%lon)
+call fill_cam_1d_array(ncid, 'lat', grid%lat)
+call fill_cam_1d_array(ncid, 'lev', grid%lev)
+call fill_cam_1d_array(ncid, 'ilev', grid%ilev) ! for staggered vertical grid
+call fill_cam_1d_array(ncid, 'slon', grid%slon)
+call fill_cam_1d_array(ncid, 'slat', grid%slat)
+call fill_cam_1d_array(ncid, 'gw', grid%gw) ! gauss weights
+call fill_cam_1d_array(ncid, 'hyai', grid%hyai)
+call fill_cam_1d_array(ncid, 'hybi', grid%hybi)
+call fill_cam_1d_array(ncid, 'hyam', grid%hyam)
+call fill_cam_1d_array(ncid, 'hybm', grid%hybm)
-! Conundrum (but unimportant for now): an ob could be excluded for > 1 reason.
-! E.g. it's too far north and it's above the highest_obs_pressure_Pa.
-! What istatus to return? a 2 (or more) digit number? Like vstatus*10 + 4?
-! RMA-KR; Note that there's no early return based on an interpolation failure.
-! The interpolation is done for those members for whom it's possible
-! and the others get 'failed' istatus, which is returned to the calling routine.
-
-if (abs(lon_lat_lev(2)) > max_obs_lat_degree) then
- ! Define istatus to be a combination of vstatus (= 0 or 2 (for higher than highest_obs...))
- ! and whether the ob is poleward of the limits set in the namelist (+ 4).
- ! Too confusing for now;
- ! istatus(:) = 10*vstatus + 4
- istatus(:) = 2
-else
- istatus(:) = vstatus(:)
-endif
+! P0 is a scalar with no dimensionality
+call fill_cam_0d_array(ncid, 'P0', grid%P0)
-where (istatus == 0 .or. istatus == 2) ! These are success codes
- ! indices of vals are (longitude, latitude)
- a(:, 1) = lon_fract * val_21 + (1.0_r8 - lon_fract) * val_11
- a(:, 2) = lon_fract * val_22 + (1.0_r8 - lon_fract) * val_12
+call nc_close_file(ncid, routine)
- ! CAM-chem 6)); multiply the result by the unit conversion factor
- interp_val(:) = (lat_fract * a(:, 2) + (1.0_r8 - lat_fract) * a(:, 1)) * convert_units
-endwhere
+end subroutine get_cam_grid
-end subroutine interp_lonlat
!-----------------------------------------------------------------------
+!>
+!> allocate space for a scalar variable and read values into the grid_array
+!>
-! Pobs
-subroutine get_val_level(state_handle, ens_size, lon_index, lat_index, level, obs_kind, val, istatus)
-! Gets the value on level for variable obs_kind
-! at lon_index, lat_index horizontal grid point
-!
-! written by Kevin Raeder, based on code from Hui Liu 4/28/2006 and get_val_pressure
-! from Jeff Anderson
-!
-! This routine indicates things with the return code:
-! istatus 0 - success
-! istatus 1 - failure (e.g. above or below highest/lowest level, or can't
-! interpolate the value)
-! istatus 2 - val is set successfully, but level is above highest_obs_level
-!
-! This routine assumes level is an integer value. To make it work for
-! fractional levels (some models do support this) the code would have to be
-! altered to find the value at the level below and above, and interpolate in
-! the vertical.
+subroutine fill_cam_1d_array(ncid, varname, grid_array)
+integer, intent(in) :: ncid
+character(len=*), intent(in) :: varname
+type(cam_1d_array), intent(inout) :: grid_array
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: ens_size
-integer, intent(in) :: lon_index
-integer, intent(in) :: lat_index
-integer, intent(in) :: level
-integer, intent(in) :: obs_kind
-real(r8), intent(out) :: val(ens_size)
-integer, intent(out) :: istatus(ens_size)
-
-integer :: vstatus(ens_size), i, indx
-real(r8) :: p_surf(ens_size), threshold
-integer :: imem
-real(r8), allocatable :: p_col(:)
-
-! Start with failure condition
-istatus(:) = 1
-vstatus(:) = 1
-val(:) = MISSING_R8
-
-! This assumes that all variables are defined on model levels, not on interface levels.
-! Exclude obs below the model's lowest level and above the highest level,
-! but go ahead with surface fields (level = no_lev).
-if (level /= no_lev .and. (level > lev%length .or. level < 1)) return
-allocate(p_col(lev%length))
-
-! Interpolate in vertical to get two bounding levels, but treat pressure
-! specially since it has to be computed from PS instead of interpolated.
-
-if (obs_kind == QTY_PRESSURE) then
-
- ! p_surf is returned in pascals, which is the right units for plevs_cam() below.
- ! RMA-KR; level is irrelevant for PS, and should not cause a failure even now that
- ! io/state_structure_mod.f90:get_dart_vector_index is the eventual recipient of that index.
- ! Only lon and lat dimensions will be used to find the index into the state vector;
- ! 'level' will not be used. Same for the pre-RMA trunk version.
- call get_val(state_handle, ens_size, lon_index, lat_index, no_lev, QTY_SURFACE_PRESSURE, p_surf, vstatus)
- if (all(vstatus /= 0)) then
- deallocate(p_col)
- return
- endif
- ! Next, get the values on the levels for this PS.
- do imem = 1, ens_size
- if (vstatus(imem) == 0) then
- call plevs_cam (p_surf(imem), lev%length, p_col)
- val(imem) = p_col(level)
- endif
- enddo
+character(len=*), parameter :: routine = 'fill_cam_1d_array'
-else
+!>@todo do we need to check that this exists? if all cam input
+!> files will have all the arrays we are asking for, then no.
- call get_val(state_handle, ens_size, lon_index, lat_index, level, obs_kind, val, vstatus)
+call nc_get_variable_size(ncid, varname, grid_array%nsize)
+allocate(grid_array%vals(grid_array%nsize))
-endif
+call nc_get_variable(ncid, varname, grid_array%vals, routine)
-! if this routine is called with a location that has a vertical level above
-! the pressure cutoff, go ahead and compute the value but return an istatus=2
-! (unless some other error occurs later in this routine). note that smaller
-! level numbers are higher up in the atmosphere; level 1 is at the top.
+if (debug_level > 80) call array_dump(grid_array%vals, label=varname)
-if (level < highest_obs_level) then
- istatus(:) = 2
-else
- istatus(:) = vstatus
-endif
+end subroutine fill_cam_1d_array
-deallocate(p_col)
-
-end subroutine get_val_level
!-----------------------------------------------------------------------
+!>
+!> allocate space for a scalar variable and read values into the grid_array
+!>
-subroutine get_val_pressure(state_handle, ens_size, lon_index, lat_index, pressure, obs_qty, val, istatus)
-! Gets the vertically interpolated value on pressure for variable obs_qty
-! at lon_index, lat_index horizontal grid point
-!
-! This routine indicates things with the return code:
-! istatus 0 - success
-! istatus 1 - failure (e.g. above or below highest/lowest level, or can't
-! interpolate the value)
-! istatus 2 - val is set successfully, but vert is above highest_obs_pressure
-!
-! Excludes observations below lowest level pressure and above highest level pressure.
+subroutine fill_cam_0d_array(ncid, varname, grid_array)
+integer, intent(in) :: ncid
+character(len=*), intent(in) :: varname
+type(cam_1d_array), intent(inout) :: grid_array
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: ens_size
-real(r8), intent(in) :: pressure
-integer, intent(in) :: lon_index
-integer, intent(in) :: lat_index
-integer, intent(in) :: obs_qty
-real(r8), intent(out) :: val(ens_size)
-integer, intent(out) :: istatus(ens_size)
-
-real(r8), dimension(ens_size) :: bot_val, top_val, p_surf, frac
-real(r8), dimension(ens_size) :: ps_local(ens_size, 2)
-integer, dimension(ens_size) :: top_lev, bot_lev, vstatus, cur_vstatus
-! RMA-KR; cur_vstatus was explicitly dimensioned (ens_size), which was redundant.
-integer :: fld_index
-integer(i8) :: i, imem
-real(r8), allocatable :: p_col(:,:)
-
-! Start with error condition.
-istatus(:) = 1
-cur_vstatus(:) = 1
-vstatus(:) = 0 ! so you can track statuses
-val(:) = MISSING_R8
-p_surf(:) = MISSING_R8
-
-! Need to get the surface pressure at this point.
-! Find out whether the observed field is a staggered field in CAM.
-! Check whether the state vector has wind components on staggered grids, i.e. whether CAM is FV.
-! find_name returns 0 if the field name is not found in the cflds list.
-
-fld_index = find_name('PS',cflds)
-i = index_from_grid(1,lon_index,lat_index, fld_index)
-ps_local(:, 1) = get_state(i, state_handle)
-
-if (obs_qty == QTY_U_WIND_COMPONENT .and. find_name('US', cflds) /= 0) then
- ! ps defined on lat grid (-90...90, nlat = nslat + 1),
- ! need it on staggered lat grid, which starts half a grid spacing north.
-
- i = index_from_grid(1,lon_index,lat_index+1,fld_index)
- ps_local(:, 2) = get_state(i, state_handle)
- p_surf(:) = (ps_local(:, 1) + ps_local(:, 2))* 0.5_r8
-elseif (obs_qty == QTY_V_WIND_COMPONENT .and. find_name('VS', cflds) /= 0) then
- ! lon = 0... 255 (for 5 degree grid)
- !slon = -2.5 ... 252.5
- if (lon_index == slon%length) then
- i = index_from_grid(1,1, lat_index ,fld_index)
- else
- i = index_from_grid(1,lon_index+1,lat_index ,fld_index)
- endif
- ps_local(:, 2) = get_state(i, state_handle)
- p_surf(:) = (ps_local(:, 1) + ps_local(:, 2))* 0.5_r8
-else
- ! A-grid ps can be retrieved from state vector, which was used to define ps on entry to
- ! model_interpolate.
- p_surf(:) = ps_local(:, 1)
-endif
+character(len=*), parameter :: routine = 'fill_cam_0d_array'
-! Next, get the pressures on the levels for this ps
-! Assuming we'll only need pressures on model mid-point levels, not interface levels.
-! This pressure column will be for the correct grid for obs_qty, since p_surf was taken
-! from the grid-correct ps[_stagr] grid
-allocate(p_col(lev%length, ens_size))
-p_col(:,:) = MISSING_R8
-do imem = 1, ens_size
- call plevs_cam(p_surf(imem), lev%length, p_col(:, imem))
-enddo
+grid_array%nsize = 1
+allocate(grid_array%vals(grid_array%nsize))
-do imem = 1, ens_size
- if (pressure <= p_col(1, imem) .or. pressure >= p_col(lev%length, imem)) then
- vstatus(imem) = 1
- ! Exclude obs below the model's lowest level and above the highest level
- ! We *could* possibly use ps and p(lev%length) to interpolate for points below the lowest level.
- !return
- endif
-enddo
+call nc_get_variable(ncid, varname, grid_array%vals, routine)
-! Interpolate in vertical to get two bounding levels
-
-! Search down through pressures for each ensemble member
-do imem = 1, ens_size
- if (vstatus(imem) == 0) then
- levloop: do i = 2, lev%length
- if (pressure < p_col(i, imem)) then
- top_lev(imem) = i -1
- bot_lev(imem) = i
- frac(imem) = (p_col(i, imem) - pressure) / &
- (p_col(i, imem) - p_col(i - 1, imem))
- exit levloop
- endif
- enddo levloop
- else
- ! This is to avoid top_lev and bot_lev getting nonsense values
- top_lev(imem) = 1
- bot_lev(imem) = 2
- endif
-enddo
+if (debug_level > 80) print*, 'variable name ', trim(varname), grid_array%vals
-if (obs_qty == QTY_PRESSURE) then
- ! can't get pressure on levels from state vector; get it from p_col instead
- do imem = 1, ens_size
- bot_val(imem) = p_col(bot_lev(imem), imem)
- top_val(imem) = p_col(top_lev(imem), imem)
- enddo
-else
- call get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, bot_lev, obs_qty, bot_val, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, top_lev, obs_qty, top_val, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
-endif
+end subroutine fill_cam_0d_array
+!-----------------------------------------------------------------------
+!>
+!> free space in the various grid arrays
+!>
-! Failed to get value for interpolation; return istatus = 1
-where (vstatus == 0)
- istatus = 0
- val = (1.0_r8 - frac) * bot_val + frac * top_val
-elsewhere
- istatus = 1
- val = MISSING_R8
-endwhere
-
-! if this routine is called with a location that has a vertical pressure above
-! the pressure cutoff, go ahead and compute the value but return an istatus=2
-! (unless some other error occurs later in this routine).
-if (pressure < highest_obs_pressure_Pa) then
- where (istatus == 0) istatus = 2
-endif
-
-deallocate(p_col)
+subroutine free_cam_grid(grid)
-end subroutine get_val_pressure
+type(cam_grid), intent(inout) :: grid
-!-----------------------------------------------------------------------
+call free_cam_1d_array(grid%lon)
+call free_cam_1d_array(grid%lat)
+call free_cam_1d_array(grid%lev)
+call free_cam_1d_array(grid%ilev)
+call free_cam_1d_array(grid%slon)
+call free_cam_1d_array(grid%slat)
+call free_cam_1d_array(grid%gw)
+call free_cam_1d_array(grid%hyai)
+call free_cam_1d_array(grid%hybi)
+call free_cam_1d_array(grid%hyam)
+call free_cam_1d_array(grid%hybm)
-subroutine get_val_height(state_handle, ens_size, lon_index, lat_index, height, location, obs_kind, val, istatus)
+call free_cam_1d_array(grid%P0)
-! Gets the vertically interpolated value on height for variable obs_kind
-! at lon_index, lat_index horizontal grid point
-!
-! written by Kevin Raeder, based on code from Hui Liu 4/28/2006 and get_val_pressure
-! from Jeff Anderson
-!
-! This routine indicates things with the return code:
-! istatus 0 - success
-! istatus 1 - failure (e.g. above or below highest/lowest level, or can't
-! interpolate the value)
-! istatus other - val is set successfully, but obs is excluded according to namelist restrictions.
+deallocate(phis)
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: ens_size
-integer, intent(in) :: lon_index
-integer, intent(in) :: lat_index
-real(r8), intent(in) :: height
-type(location_type), intent(in) :: location
-integer, intent(in) :: obs_kind
-real(r8), intent(out) :: val(ens_size)
-integer, intent(out) :: istatus(ens_size)
-
-integer :: i, fld_index
-integer, dimension(ens_size) :: top_lev, bot_lev, vstatus, cur_vstatus
-real(r8), dimension(ens_size) :: bot_val, top_val, frac
-integer(i8) :: ind
-real(r8) :: p_surf(ens_size), ps_local(ens_size, 2)
-logical :: stagr_lon, stagr_lat
-real(r8), allocatable :: p_col(:, :), model_h(:, :) !(lev%length, ens_size)
-integer :: imem
-
-! Start with error condition.
-! RMA-KR; should vstatus start with 1? Then change comment to 'start with error condition'.
-! vstatus is first passed to model_heights, which sets it to 1, so this is irrelevant.
-istatus(:) = 1
-vstatus(:) = 1
-cur_vstatus(:) = 1
-val(:) = MISSING_R8
-stagr_lon = .false.
-stagr_lat = .false.
-
-! Assuming we'll only need pressures on model mid-point levels, not interface levels.
-allocate(p_col(lev%length, ens_size))
-allocate(model_h(lev%length, ens_size))
-! Need to get the surface pressure at this point.
-! Check whether the state vector has wind components on staggered grids, i.e. whether CAM is FV.
-! See get_val_pressure for more documentation.
-fld_index = find_name('PS',cflds)
-ind = index_from_grid(1,lon_index,lat_index, fld_index)
-ps_local(:, 1) = get_state(ind, state_handle)
-
-! find_name returns 0 if the field name is not found in the cflds list.
-if (obs_kind == QTY_U_WIND_COMPONENT .and. find_name('US', cflds) /= 0) then
- stagr_lat = .true.
- ind = index_from_grid(1,lon_index,lat_index+1,fld_index)
- ps_local(:,2) = get_state(ind, state_handle)
- p_surf(:) = (ps_local(:,1) + ps_local(:,2))* 0.5_r8
-elseif (obs_kind == QTY_V_WIND_COMPONENT .and. find_name('VS', cflds) /= 0) then
- stagr_lon = .true.
- if (lon_index == slon%length) then
- ind = index_from_grid(1,1, lat_index ,fld_index)
- else
- ind = index_from_grid(1,lon_index+1,lat_index ,fld_index)
- endif
- ps_local(:, 2) = get_state(ind, state_handle)
- p_surf(:) = (ps_local(:, 1) + ps_local(:, 2))* 0.5_r8
-else
- p_surf(:) = ps_local(:, 1)
-endif
+end subroutine free_cam_grid
-! Next, get the heights on the levels for this ps
-! We want to use the new vec for each new ob on height because the state was updated
-! for all previous obs, and we want to use the most up to date state to get the best location.
-! The above comment is untrue - the state is not updated, either it is the forward operator
-! before assimilation, or it is the mean (not updated during assimilation)
-call model_heights(state_handle, ens_size, lev%length, p_surf, location, model_h, vstatus)
-if (all(vstatus == 1)) return ! Failed to get model heights; return istatus = 1
+!-----------------------------------------------------------------------
+!>
+!>
+!>
-! Exclude obs below the model's lowest level and above the highest level
-do imem = 1, ens_size
- if (height >= model_h(1, imem) .or. height <= model_h(lev%length, imem)) vstatus(imem) = 1 ! Fail
-enddo
+subroutine free_cam_1d_array(grid_array)
+type(cam_1d_array), intent(inout) :: grid_array
-! ? Implement 3Dp here? or should/can it not use the ens mean PS field?
-do imem = 1, ens_size
- call plevs_cam(p_surf(imem), lev%length, p_col(:, imem))
-enddo
+deallocate(grid_array%vals)
+grid_array%nsize = -1
-! The highest_obs_pressure_Pa has already been checked to ensure it's a valid value.
-! So this loop will always set the highest_obs_height_m before exiting.
-! This could be refined to interpolate between the p_col to highest_obs_pressure_Pa.
-! Also, if using the nearest lower model level is good enough, then it might be good
-! enough to only calculate highest_obs_height_m once; put if (highest_obs_height_m == MISSING_R8)
-! around the loop.
-! Actually, I see in gph2gmh that the heights in model_h are relative to mean sea level,
-! so they will be independent from the surface height and vertical coordinate system.
-! They will vary slightly with surface pressure.
-! So I think that highest_obs_height_m could be calculated once
-! HK You have a highest_obs_height_m for each ensemble member. Is this what you want?
-! HK The trunk will ens up with highest_obs_height_m equal to its first ensemble
-! member at the first obseravation location.
-!> @todo The location used in the distributed forward operator will be different
-!> on each task for the highest_obs_height_calculation
-if (highest_obs_height_m == MISSING_R8) then
- ! Search until we find a good member
- memloop: do imem = 1, ens_size
- if (vstatus(imem) == 0) then
- levloop: do i=2,lev%length
- if (p_col(i, imem) > highest_obs_pressure_Pa) then
- ! highest_obs_height_m = model_h(i)
- highest_obs_height_m = model_h(i, imem) + (model_h(i-1, imem)-model_h(i, imem))* &
- ((p_col(i, imem)-highest_obs_pressure_Pa) / &
- (p_col(i, imem)-p_col(i-1, imem)))
- write(string1, *) 'highest_obs_height_m = ',highest_obs_height_m
- call error_handler(E_MSG,'get_val_height', string1, &
- source, revision, revdate)
- exit memloop
- endif
- enddo levloop
- endif
- enddo memloop
-endif
+end subroutine free_cam_1d_array
+!-----------------------------------------------------------------------
+!> convert from string to integer, and set in the dart code the
+!> vertical type we are going to want to localize in.
+!>
-! Interpolate in vertical to get two bounding levels.
-! Search down through heights and set the enclosing level numbers
-! and the fraction between them. There has already been a test to
-! ensure the height is between the levels (and has discarded values
-! exactly equal to the limits), so this will always succeed.
-do imem = 1, ens_size
- if (vstatus(imem) == 0) then
- lev2loop: do i = 2, lev%length
- if (height > model_h(i, imem)) then
- top_lev(imem) = i -1
- bot_lev(imem) = i
- frac(imem) = (model_h(i, imem) - height ) / &
- (model_h(i, imem) - model_h(i-1, imem))
- exit lev2loop
- endif
- enddo lev2loop
- else ! This is so you can make a call to get_val_array_of_levels without
- ! looking at the vstatus of each ensemble member.
- bot_lev(imem) = 2
- top_lev(imem) = 1
- endif
-enddo
+subroutine set_vert_localization(typename)
+character(len=*), intent(in) :: typename
-if (obs_kind == QTY_PRESSURE) then
- do imem = 1, ens_size
- bot_val(imem) = p_col(bot_lev(imem), imem)
- top_val(imem) = p_col(top_lev(imem), imem)
- enddo
-else
- call get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, bot_lev, obs_kind, bot_val, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- call get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, top_lev, obs_kind, top_val, cur_vstatus)
- call update_vstatus(ens_size, cur_vstatus, vstatus)
- ! Failed to get a value to use in interpolation
- !if (vstatus == 1) return
-endif
+character(len=*), parameter :: routine = 'set_vert_localization'
-istatus(:) = vstatus(:)
+character(len=32) :: ucasename
+integer :: vcoord
-where (istatus == 0)
- val = (1.0_r8 - frac) * bot_val + frac * top_val
-endwhere
+ucasename = typename
+call to_upper(ucasename)
-if (height > highest_obs_height_m ) then
- ! if this routine is called with a location that has a vertical height above
- ! the pressure cutoff, pass back the value but return an istatus=2
- ! (Only for successful forward operators)
- where(istatus == 0) istatus = 2
-endif
+select case (ucasename)
+ case ("PRESSURE")
+ vcoord = VERTISPRESSURE
+ case ("HEIGHT")
+ vcoord = VERTISHEIGHT
+ case ("SCALEHEIGHT", "SCALE_HEIGHT", "SCALE HEIGHT")
+ vcoord = VERTISSCALEHEIGHT
+ case ("LEVEL", "MODEL_LEVEL", "MODEL LEVEL")
+ vcoord = VERTISLEVEL
+ case default
+ write(string1,*)'unrecognized vertical localization coordinate type: '//trim(typename)
+ write(string2,*)'valid values are: PRESSURE, HEIGHT, SCALEHEIGHT, LEVEL'
+ call error_handler(E_ERR,routine,string1,source,revision,revdate,text2=string2)
+end select
+
+! during assimilation, when get_close() is called to compute the separation distance
+! between items, convert all state and obs to use this vertical type if vertical localization
+! is enabled (usually true for cam).
+call set_vertical_localization_coord(vcoord)
-deallocate(p_col, model_h)
+! save in module global for later use.
+vertical_localization_type = vcoord
-end subroutine get_val_height
+end subroutine set_vert_localization
!-----------------------------------------------------------------------
+!>
+!>
+!>
-subroutine get_val(state_handle, ens_size, lon_index, lat_index, level, obs_kind, val, istatus)
+subroutine setup_interpolation(grid)
+type(cam_grid), intent(in) :: grid
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: ens_size
-integer, intent(in) :: lon_index
-integer, intent(in) :: lat_index
-integer, intent(in) :: level
-integer, intent(in) :: obs_kind
-real(r8), intent(out) :: val(ens_size)
-integer, intent(out) :: istatus(ens_size)
+!>@todo FIXME the cam fv grid is really evenly spaced in lat and lon,
+!>even though they provide full lon() and lat() arrays. providing the deltas
+!>between each pair would be slightly faster inside the interp code.
-integer(i8) :: indx
-integer :: field_type
+!print *, 'setting up interpolation: lon/lat sizes = ', grid%lon%nsize, grid%lat%nsize, &
+! grid%slon%nsize, grid%slat%nsize
-! Start with error condition.
-istatus(:) = 1
-val(:) = MISSING_R8
+! mass points at cell centers
+call init_quad_interp(GRID_QUAD_IRREG_SPACED_REGULAR, grid%lon%nsize, grid%lat%nsize, &
+ QUAD_LOCATED_CELL_CENTERS, &
+ global=.true., spans_lon_zero=.true., pole_wrap=.true., &
+ interp_handle=interp_nonstaggered)
+call set_quad_coords(interp_nonstaggered, grid%lon%vals, grid%lat%vals)
-field_type = find_name(dart_to_cam_types(obs_kind),cflds)
-if (field_type <= 0 .or. field_type > nflds) return
+! U stagger
+call init_quad_interp(GRID_QUAD_IRREG_SPACED_REGULAR, grid%lon%nsize, grid%slat%nsize, &
+ QUAD_LOCATED_CELL_CENTERS, &
+ global=.true., spans_lon_zero=.true., pole_wrap=.true., &
+ interp_handle=interp_u_staggered)
+call set_quad_coords(interp_u_staggered, grid%lon%vals, grid%slat%vals)
-indx = index_from_grid(level, lon_index, lat_index, field_type)
-!> @todo pull this check out or error
-! HK: This check is not correct for XCESM
-! RMA-KR; is this check related to synthetic obs, which have state indices < 0?
-!if (indx > 0 .and. indx <= model_size) then
- istatus(:) = 0
- val = get_state(indx, state_handle)
-!endif
-
-end subroutine get_val
+! V stagger
+call init_quad_interp(GRID_QUAD_IRREG_SPACED_REGULAR, grid%slon%nsize, grid%lat%nsize, &
+ QUAD_LOCATED_CELL_CENTERS, &
+ global=.true., spans_lon_zero=.true., pole_wrap=.true., &
+ interp_handle=interp_v_staggered)
+call set_quad_coords(interp_v_staggered, grid%slon%vals, grid%lat%vals)
+end subroutine setup_interpolation
!-----------------------------------------------------------------------
-!> Same as get val but accepts an array of levels
-subroutine get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, levels, obs_kind, val, istatus)
+!>
+!>
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: ens_size
-integer, intent(in) :: lon_index
-integer, intent(in) :: lat_index
-integer, intent(in) :: levels(ens_size)
-integer, intent(in) :: obs_kind
-real(r8), intent(out) :: val(ens_size)
-integer, intent(out) :: istatus(ens_size)
+subroutine read_cam_phis_array(phis_filename)
+character(len=*), intent(in) :: phis_filename
-integer(i8) :: indx(ens_size)
-integer :: field_type
-integer :: imem
+character(len=*), parameter :: routine = 'read_cam_phis_array'
-! Start with error condition.
-istatus(:) = 1
-val(:) = MISSING_R8
+integer :: ncid, nsize(3) ! lon, lat, time
-field_type = find_name(dart_to_cam_types(obs_kind),cflds)
-if (field_type <= 0 .or. field_type > nflds) return
+ncid = nc_open_file_readonly(phis_filename, routine)
-do imem = 1, ens_size
- indx(imem) = index_from_grid(levels(imem), lon_index, lat_index, field_type)
-enddo
-! HK: This check is not correct for XCESM.
-! RMA-KR; is this check related to synthetic obs, which have state indices < 0?
-!if (indx > 0 .and. indx <= model_size) then
- istatus(:) = 0
- call get_state_array(val, indx, state_handle)
-!endif
+call nc_get_variable_size(ncid, 'PHIS', nsize(:), routine)
+allocate( phis(nsize(1), nsize(2)) )
-end subroutine get_val_array_of_levels
+call nc_get_variable(ncid, 'PHIS', phis, routine)
+call nc_close_file(ncid, routine)
-!-----------------------------------------------------------------------
+end subroutine read_cam_phis_array
-subroutine set_highest_obs_limit()
-! Verify that the value for highest_obs_pressure_Pa in the namelist is ok.
-!
-! If this routine detects an error it calls the error handler with a
-! fatal error. If it returns, the namelist value is ok.
-!
-! Sets the module global variable 'highest_obs_level', and references
-! the hybm array.
-
-integer :: i, lowest_ok
-real(r8) :: p_surf, top
-real(r8), allocatable :: p_col(:)
-! This assumes that all variables are defined on model levels, not on interface levels.
-allocate(p_col(lev%length))
-
-! This code determines the model level that is below but closest to the
-! 'highest obs pressure' limit that was set in the namelist. It is counting
-! on the limit being set high enough that the level heights are
-! determined solely by the pressure values with no contribution from the terrain.
-! Instead of computing a surface pressure from an ensemble member at a particular
-! longitude and latitude, assume a surface pressure of 1000 mb and compute
-! a pressure column based on that. Then, verify that the 'hybm' value at
-! the selected level is 0 - otherwise the levels still have a contribution
-! based on terrain and cannot be solely determined based on pressure.
-! Then we can use this single level value for any lat/lon/ensemble member.
-
-! Compute a pressure column based on a 1000 mb (*100 = pascals) surface pressure
-call plevs_cam(P0%vals(1), lev%length, p_col)
-
-! Loop downwards through pressure values (1 = model top, lev%length = bottom).
-! The level is set to the highest level which is below the given threshold.
-
-
-! RMA-KR; this lev%length condition was added to ensure that highest_obs_level
-! doesn't end up with value lev%length+1 due to the loop running all the way through.
-High: do highest_obs_level=1,lev%length
- if (p_col(highest_obs_level) > highest_obs_pressure_Pa .or. &
- highest_obs_level == lev%length) exit High
-enddo High
-
-! Test whether user has set highest_obs_pressure_Pa to be uselessly small (high),
-! which causes problems for setting highest_obs_height_m.
-! highest model level (mid-layer) pressure:
-top = hyam%vals(1)*P0%vals(1)
-if (highest_obs_pressure_Pa < top) then
- write(string1, '(2A)') 'Namelist variable "highest_obs_pressure_Pa" is too small', &
- ' (located above the model atmosphere)'
- write(string2, '(A,1pe15.5)') ' Reset to at least ',top
- call error_handler(E_ERR, 'set_highest_obs_limit', string1, source, revision, revdate, text2=string2)
-endif
+!-----------------------------------------------------------------------
+!> Compute the virtual temperature at the midpoints
+!>
+!> this version does all ensemble members at once.
+!>
-! Test to be sure user hasn't set level so low that contributions from
-! terrain are going to be an issue. If they do, tell them in the error
-! message what the valid limit is.
-if (hybm%vals(highest_obs_level) > 0.0_r8) then
- lowest_ok = 1
- findzero: do i=2, lev%length
- if (hybm%vals(i) > 0.0_r8) then
- lowest_ok = i-1
- exit findzero
- endif
- enddo findzero
- write(string1, '(A)') 'invalid value for namelist "highest_obs_pressure_Pa"'
- write(string2, '(A)') 'value is too large (located out of the pure pressure levels of the atmosphere)'
- write(string3, '(A,F9.3,A)') 'must specify a value located above pressure ', p_col(lowest_ok), ' Pascals'
- call error_handler(E_ERR, 'set_highest_obs_limit', string1, source, revision, revdate, &
- text2=string2, text3=string3)
-endif
+subroutine compute_virtual_temperature(ens_handle, ens_size, lon_index, lat_index, nlevels, qty, tv, istatus)
-deallocate(p_col)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: nlevels
+integer, intent(in) :: qty
+real(r8), intent(out) :: tv(nlevels, ens_size)
+integer, intent(out) :: istatus
-end subroutine set_highest_obs_limit
+integer :: k
+real(r8) :: temperature(ens_size), specific_humidity(ens_size)
-! End of model_interpolate section
+!>@todo this should come from a model specific constant module.
+!> the forward operators and model_mod should use it.
+real(r8), parameter :: rd = 287.05_r8 ! dry air gas constant
+real(r8), parameter :: rv = 461.51_r8 ! wet air gas constant
+real(r8), parameter :: rr_factor = (rv/rd) - 1.0_r8
-!#######################################################################
-! Vector-field translations
+! construct a virtual temperature column, one for each ensemble member
+do k = 1, nlevels
+ ! temperature
+ call get_staggered_values_from_qty(ens_handle, ens_size, QTY_TEMPERATURE, &
+ lon_index, lat_index, k, qty, temperature, istatus)
-!-----------------------------------------------------------------------
+ if (istatus < 0) return
-subroutine prog_var_to_vector(var, st_vec)
+ ! specific humidity
+ call get_staggered_values_from_qty(ens_handle, ens_size, QTY_SPECIFIC_HUMIDITY, &
+ lon_index, lat_index, k, qty, specific_humidity, istatus)
+ if (istatus < 0) return
-type(model_type), intent(in) :: var
-real(r8), intent(out) :: st_vec(:)
+ !>tv == virtual temperature.
+ tv(k,:) = temperature(:)*(1.0_r8 + rr_factor*specific_humidity(:))
+ !print*, 'tv(levels)', k,tv(k,1), temperature(1), specific_humidity(1)
+enddo
-integer :: i, j, k, nf, indx
-! Load components of state vector, starting with scalars (0D) and finishing with 3D
-! A whole field will be loaded (by columns for 3D) before the next field is started.
-! This is completely different than the B-grid organization, which loaded all the fields
-! at a point before moving on to the next point. The motivations for this change are:
-! 1) This easily allows fields with the same rank, but different sizes to be loaded into
-! the vector (i.e. U_staggered and T in the cam-fv)
-! 2) The dominant form of access into the state vector is vertical interpolations in
-! get_expected_val and computation of columns of virtual temperature from T and Q
-! in model_heights. model_get_close_states, which searched for all variables close
-! to an obs, is not part of the MPI DART, so spatially co-located variables don't
-! need to be close to each other in memory.
+end subroutine compute_virtual_temperature
-if (.not. module_initialized) call static_init_model()
-indx = 0
+!-----------------------------------------------------------------------
+!> loop through all levels to get the mean mass.
+!>
-! 0d variables
-do nf = 1, state_num_0d
- indx = indx + 1
- st_vec(indx) = var%vars_0d(nf)
-enddo
+subroutine compute_mean_mass(ens_handle, ens_size, lon_index, lat_index, nlevels, qty, mbar, istatus)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: nlevels
+integer, intent(in) :: qty
+real(r8), intent(out) :: mbar(nlevels, ens_size)
+integer, intent(out) :: istatus
+
+integer :: k, this_qty
+real(r8) :: mmr_o1(ens_size, nlevels), &
+ mmr_o2(ens_size, nlevels), &
+ mmr_h1(ens_size, nlevels), &
+ mmr_n2(ens_size, nlevels)
+real(r8) :: O_molar_mass, O2_molar_mass, H_molar_mass, N2_molar_mass
+
+! do this outside the subroutine? it never changes throughout the
+! run of the program
+O_molar_mass = get_molar_mass(QTY_ATOMIC_OXYGEN_MIXING_RATIO)
+O2_molar_mass = get_molar_mass(QTY_MOLEC_OXYGEN_MIXING_RATIO)
+H_molar_mass = get_molar_mass(QTY_ATOMIC_H_MIXING_RATIO)
+N2_molar_mass = get_molar_mass(QTY_NITROGEN)
+
-! 1d variables
-do nf = 1, state_num_1d
- do i=1,f_dim_1d(1,nf)
- indx = indx + 1
- st_vec(indx) = var%vars_1d(i, nf)
- enddo
-enddo
-! 2d variables
-do nf = 1, state_num_2d
- do j=1,f_dim_2d(2,nf)
- do i=1,f_dim_2d(1,nf)
- indx = indx + 1
- st_vec(indx) = var%vars_2d(i, j, nf)
- enddo
- enddo
-enddo
+! High topped models (WACCM-X) need to account for the changing composition
+! of the atmosphere with height. This requires several variables from the
+! initial file, which may not be available from low topped models.
+do k = 1, nlevels
-! 3D fields
-! This section is only entered for models with logically rectangular grids,
-! which will have dimensions level, longitude, and latitude.
-! RMA-KR; the indices in vars_3d are reversed compared to the non-RMA trunk,
-! due to no longer re-ordering dimensions to a standard order.
-do nf= 1, state_num_3d
- do k=1,f_dim_3d(3,nf)
- do j=1,f_dim_3d(2,nf)
- do i=1,f_dim_3d(1,nf)
- indx = indx + 1
- st_vec(indx) = var%vars_3d(i, j, k, nf)
- enddo
- enddo
- enddo
+ this_qty = QTY_ATOMIC_OXYGEN_MIXING_RATIO
+ call get_staggered_values_from_qty(ens_handle, ens_size, this_qty, &
+ lon_index, lat_index, k, qty, mmr_o1(:, k), istatus)
+ if (istatus /= 0) return
+ !print *, 'mmr: ', trim(get_name_for_quantity(this_qty)), mmr_o1(1, k)
+
+ this_qty = QTY_MOLEC_OXYGEN_MIXING_RATIO
+ call get_staggered_values_from_qty(ens_handle, ens_size, this_qty, &
+ lon_index, lat_index, k, qty, mmr_o2(:, k), istatus)
+ if (istatus /= 0) return
+ !print *, 'mmr: ', trim(get_name_for_quantity(this_qty)), mmr_o2(1, k)
+
+ this_qty = QTY_ATOMIC_H_MIXING_RATIO
+ call get_staggered_values_from_qty(ens_handle, ens_size, this_qty, &
+ lon_index, lat_index, k, qty, mmr_h1(:, k), istatus)
+ if (istatus /= 0) return
+ !print *, 'mmr: ', trim(get_name_for_quantity(this_qty)), mmr_h1(1, k)
+
+ mmr_n2(:,k) = 1.0_r8 - (mmr_o1(:,k) + mmr_o2(:,k) + mmr_h1(:,k))
+ mbar(k,:) = 1.0_r8/( mmr_o1(:,k)/O_molar_mass &
+ + mmr_o2(:,k)/O2_molar_mass &
+ + mmr_h1(:,k)/H_molar_mass &
+ + mmr_n2(:,k)/N2_molar_mass)
enddo
-if (indx /= model_size) then
- write(string1, *) 'Number of elements copied = ',indx,', must equal model_size, ',model_size
- call error_handler(E_ERR, 'prog_var_to_vector', string1, source, revision, revdate)
-endif
-
-end subroutine prog_var_to_vector
+end subroutine compute_mean_mass
!-----------------------------------------------------------------------
+!> This code is using a finite difference method to evaluate an
+!> integral to solve the hydrostatic equation.
+!>
+!> The details are in the reference given below.
+!> Don't change this code until you have read the paper and
+!> understand what they're doing. The paper uses a matrix
+!> while this code gets away with ignoring 'l' and evaluating
+!> the 'k' vector directly.
+!>
+!> Equation references are to "Hybrid Coordinates for CCM1"
+!> https://opensky.ucar.edu/islandora/object/technotes%3A149/datastream/PDF/view
+!>
+!> Here is a comment from the NCL function that does the
+!> same thing for them.
+!>
+!> Purpose:
+!> To compute geopotential height using the CCM2 hybrid coordinate
+!> vertical slice. Since the vertical integration matrix is a
+!> function of latitude and longitude, it is not explicitly
+!> computed as for sigma coordinates. The integration algorithm
+!> is derived from Boville's mods in the ibm file hybrid 1mods
+!> (6/17/88). All vertical slice arrays are oriented top to
+!> bottom as in CCM2. This field is on full model levels (aka
+!> "midpoints") not half levels.
+!>
+!> careful - if the calling code passes in the mbar() parameter a different gas
+!> constant is used instead. an mbar() array of 1.0 is not the same
+!> as no parameter specified.
-subroutine vector_to_prog_var(st_vec, var)
-
-real(r8), intent(in) :: st_vec(:)
-type(model_type), intent(inout) :: var
-
-integer :: i, j, k, nf, indx
+subroutine build_heights(nlevels,p_surf,h_surf,virtual_temp,height_midpts,height_interf,mbar)
-if (.not. module_initialized) call static_init_model()
+integer, intent(in) :: nlevels ! Number of vertical levels
+real(r8), intent(in) :: p_surf ! Surface pressure (pascals)
+real(r8), intent(in) :: h_surf ! Surface height (m)
+real(r8), intent(in) :: virtual_temp( nlevels) ! Virtual Temperature
+real(r8), intent(out) :: height_midpts(nlevels) ! Geopotential height at midpoints, top to bottom
+real(r8), intent(out), optional :: height_interf(nlevels+1) ! Geopotential height at interfaces, top to bottom
+real(r8), intent(in), optional :: mbar(nlevels) ! Factor to support for variable gas constant
-indx = 0
+! Local variables
+!>@todo FIXME can we use the types_mod values here? or have a model constants module?
+real(r8), parameter :: const_r = 287.04_r8 ! Different than model_heights (dry air gas constant)
+real(r8), parameter :: universal_gas_constant = 8314.0_r8 ! [J/K/kmol]
+real(r8), parameter :: g0 = 9.80616_r8 ! Different than model_heights (gph2gmh:G) !
-! 0d arrays
-do nf = 1, state_num_0d
- indx = indx + 1
- var%vars_0d(nf) = st_vec(indx)
-enddo
+integer :: k,l
-! 1d fields
-do nf = 1, state_num_1d
- do i=1,f_dim_1d(1, nf)
- indx = indx + 1
- var%vars_1d(i, nf) = st_vec(indx)
- enddo
-enddo
+! an array now: real(r8), parameter :: rbyg=r/g0
+real(r8) :: pterm(nlevels) ! vertical scratch space, to improve computational efficiency
+real(r8) :: r_g0_tv(nlevels) ! rbyg=r/g0 * tv
+real(r8) :: pm_ln(nlevels+1) ! logs of midpoint pressures plus surface interface pressure
-! 2d fields
-do nf = 1, state_num_2d
- do j = 1, f_dim_2d(2,nf)
- do i = 1, f_dim_2d(1,nf)
- indx = indx + 1
- var%vars_2d(i, j, nf) = st_vec(indx)
- enddo
- enddo
-enddo
+! cam uses a uniform gas constant value, but high top
+! models like waccm change the gas constant with height.
+! allow for the calling code to pass in an array of r.
-! 3D fields; see comments in prog_var_to_vect
-! RMA-KR; the indices in vars_3d are reversed compared to the non-RMA trunk,
-! due to no longer re-ordering dimensions to a standard order.
-do nf = 1, state_num_3d
- do k = 1, f_dim_3d(3,nf)
- do j = 1, f_dim_3d(2,nf)
- do i = 1, f_dim_3d(1,nf)
- indx = indx + 1
- var%vars_3d(i, j, k, nf) = st_vec(indx)
- enddo
- enddo
- enddo
-enddo
+! if mbar() array is present notice that the units are different
+! for the gas constants, so an mbar() array of 1.0s will NOT give
+! the same results as if it isn't present.
-if (indx /= model_size) then
- write(string1, *) 'Number of elements copied = ',indx,', must equal model_size, ',model_size
- call error_handler(E_ERR, 'vector_to_prog_var', string1, source, revision, revdate)
+if (present(mbar)) then
+ r_g0_tv(:) = (universal_gas_constant / (mbar(:)*g0)) * virtual_temp(:)
+else
+ r_g0_tv(:) = (const_r / g0) * virtual_temp(:)
endif
-end subroutine vector_to_prog_var
+! calculate the log of the pressure column midpoints.
+! items 1:nlevels are the midpoints, but NOTICE THAT
+! the pressure at nlevels+1 is the pressure of the
+! actual surface interface, not a midpoint!!
-! End of Vector-field translations
+call single_pressure_column(p_surf, nlevels, pm_ln)
+
+pm_ln(nlevels+1) = p_surf * grid_data%hybi%vals(nlevels+1) ! surface interface
+
+where (pm_ln > 0.0_r8)
+ pm_ln = log(pm_ln)
+else where (pm_ln <= 0.0_r8)
+ pm_ln = 0
+end where
+
+!debug
+!200 format (I3, 6(1X, F24.16))
+!201 format (A, 1X, I3, 6(1X, F24.16))
+!202 format (A, 6(1X, F24.16))
+!203 format (6(1X, F24.16))
+!
+!print *, 'pm_ln: '
+!do i=1, nlevels+1
+! write(*, 200) i, pm_ln(i)
+!enddo
+!end debug
+
+! height_midpts(1)=top -> height_midpts(nlevels)=bottom
+!
+! level
+! 1/2 ---------------------------------------------------------------
+! 1 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - top
+! 3/2 ---------------------------------------------------------------
+!
+! ---------------------------------------------
+! --------/ \--------
+! - - - - - - - - - - - - - - - - - - - - - - - -
+! NL - - - / \ - - - bottom
+! ---------------------------------------------------
+! NL+1/2 -----/|||||||||||||||||||||||||||||||||||||||||||||||||||\-----
-!#######################################################################
-! get_close section
+! now the finite differences.
+! Eq 3.a.109 has 5 piecewise (PW) terms. The numbers below refer to each of these terms
+! in the order they're listed in the paper.
-!-----------------------------------------------------------------------
-!>
-!> Subroutine get_close_obs
-!>
-!> get_close_obs takes as input an "observation" location, a DART TYPE (not QTY),
-!> and a list of all potentially close locations and QTYs on this task.
-!>
-!> get_close_obs
-!> *) converts vertical coordinates as needed to vert_coord,
-!> *) calls location_mod/threed_sphere:get_close_obs,
-!> to which it sends this (converted) array of locations,
-!> *) gets back the distances and indices of those locations that are
-!> "close" to the base observation.
-!> *) tests for being above the highest_obs_pressure_Pa threshold,
-!> and increases the vertical distance based on height above highest_*.
-!>
-!> @param[in] filt_gc
-!> The DART get_close_type containing the state variables which are potentially close to 'location'
-!>
-!> @param[in] base_loc
-!> The DART location_type location of the observation, which is the target of *get_close_obs*
-!>
-!> @param[in] base_type
-!> The DART TYPE (not QTY) of the observation
-!>
-!> @param[inout] locs(:)
-!> The DART location_type locations of the potentially close state variables
-!>
-!> @param[in] kinds(:)
-!> The DART QTYs of the potentially close state variables
-!>
-!> @param[out] num_close
-!> The number of state variables which are deemed to be close to the observation
-!> after get_close_obs has evaluated them
-!>
-!> @param[out] close_indices(:)
-!> The state vector indices of the close state variables.
-!>
-!> @param[out] distances(:)
-!> The distances of the close state variables from the observation.
-!>
-!> @param[in] state_handle
-!> The DART ensemble_type structure which gives access to the ensemble of model states.
-
-subroutine get_close_obs(filt_gc, base_loc, base_type, locs, loc_qtys, loc_types, &
- num_close, close_indices, distances, state_handle)
-
-type(get_close_type), intent(in) :: filt_gc
-type(location_type), intent(in) :: base_loc
-integer, intent(in) :: base_type
-type(location_type), intent(inout) :: locs(:)
-integer, intent(in) :: loc_qtys(:)
-integer, intent(in) :: loc_types(:)
-integer, intent(out) :: num_close
-integer, intent(out) :: close_indices(:)
-real(r8), intent(out), optional :: distances(:)
-type(ensemble_type), intent(in), optional :: state_handle
-
-call get_close(filt_gc, base_loc, base_type, locs, loc_qtys, &
- num_close, close_indices, distances, state_handle)
+!
+! See 2nd PW term here: Eq 3.a.109 where l=K,kK, k Convert a 2d array of geopotential altitudes to mean sea level altitudes.
+!> To avoid overflow with very high model tops, convert to km first, compute,
+!> then convert back. bof.
-! Get all the potentially close obs but no distances.
-call loc_get_close(filt_gc, local_base_loc, base_type, locs, loc_qtys, &
- num_close, close_indices)
-
-do k = 1, num_close
-
- ! The indices in close_obs refer to the subset of (state) vars or obs ON 1 TASK.
- ! That subset is (re)labeled 1...num_vars_task#, where num_vars_task# ~ state_vec_size/ntasks.
- ! So those indices can't tell me which state vector element I'm dealing with.
- ! I need to use the location of each returned close_indices to learn anything about it.
-
- t_ind = close_indices(k)
- obs_array = get_location(locs(t_ind))
- ! query_location returns location%which_vert, if no 'attr' argument is given.
- obs_which = nint(query_location(locs(t_ind)))
-
- ! FIXME Nancy; what about 'ob's on scale height, but vert_coord is pressure.
- ! KDR: the base ob was converted to pressure, if necessary, in the first section,
- ! before the loop over num_close.
- ! And can these if blocks be collapsed by defining local_obs_array(1:2 at least)
- ! before the if tests.
- if ((obs_which == VERTISPRESSURE .and. vert_coord == 'pressure') .or. &
- (obs_which == VERTISSCALEHEIGHT .and. vert_coord == 'log_invP')) then
- ! put the vertical (pressure) of the state/ob in local storage
- local_obs_array(3) = obs_array(3)
- local_obs_which = obs_which
-
- elseif (obs_which == VERTISUNDEF) then
- ! obs_which = -2 (VERTISUNDEF) means this ob is vertically close to base_obs, no matter what.
- ! if (local_obs_array(3) == MISSING_R8) then
- local_obs_array(3) = local_base_array(3)
- local_obs_which = local_base_which
+subroutine gph2gmh(h, lat)
+real(r8), intent(inout) :: h(:,:) ! geopotential altitude in m
+real(r8), intent(in) :: lat ! latitude in degrees.
- else
- call convert_vert(state_handle, obs_array, obs_which, locs(t_ind), loc_qtys(t_ind), &
- local_obs_array, local_obs_which)
+real(r8), parameter :: be = 6356.7516_r8 ! min earth radius, km
+real(r8), parameter :: ae = 6378.1363_r8 ! max earth radius, km
+real(r8), parameter :: G = 0.00980665_r8 ! WMO reference g value, km/s**2, at 45.542N(S)
- ! save the converted location back into the original list.
- ! huge improvement in speed since we only do the vertical convert
- ! once per location, instead of num_close * nobs times.
- locs(t_ind) = set_location( local_obs_array(1), local_obs_array(2), &
- local_obs_array(3), local_obs_which)
+real(r8) :: g0
+real(r8) :: r0
+real(r8) :: latr
- endif
+integer :: i, j
-! FIXME: I think this line could be replaced by moving 'locs(t_ind) = '
-! out of the last if-block above, and referencing locs(t_ind) below.
-! This is because the lon and lat are not changing: obs_array(1) = local_obs_array(1),...
- local_loc = set_location(obs_array(1), obs_array(2), local_obs_array(3), &
- local_obs_which)
-
-!>@todo FIXME this should be removed and replaced by calls to obs_impact
-!> in the assim_tools module.
-! allow a namelist specified kind string to restrict the impact of those
-! obs kinds to only other obs and state vars of the same kind.
- if ((impact_kind_index >= 0) .and. &
- (impact_kind_index == base_obs_kind) .and. &
- (impact_kind_index /= loc_qtys(t_ind))) then
- if(present(distances)) distances(k) = 999999.0_r8 ! arbitrary very large distance
+latr = lat * DEG2RAD ! convert to radians
+call compute_surface_gravity(latr, g0)
- else
- ! Need to damp the influence of all obs (VERTISUNDEF, VERTISSURFACE too) on model state vars
- ! above highest_state_pressure_Pa.
-
- ! The which vert of local_base_loc determines how vertical distance to local_loc is calculated.
- ! It can be VERTISSCALEHEIGHT.
- if(present(distances)) distances(k) = get_dist(local_base_loc, local_loc, base_type, loc_qtys(t_ind))
-
- ! Damp the influence of obs, which are below the namelist variable highest_OBS_pressure_Pa,
- ! on variables above highest_STATE_pressure_Pa.
- ! This section could also change the distance based on the QTY_s of the base_obs and obs.
-
- ! distances = 0 for some for synthetic obs.
-
- ! Better damping
- ! Should be units of distance (radians), so normalize the distance added to the existing dist(k),
- ! below, by the vert_normalization_{pressure,scale_height}.
- ! Vert_norm is not public, so call get_dist with 2 locations having the same
- ! horiz location, but different verticals, and the appropriate which_vert.
-
- if ((vert_coord == 'pressure' .and. (local_obs_array(3) < highest_state_pressure_Pa)) .or. &
- (vert_coord == 'log_invP' .and. (local_obs_array(3) > highest_state_scale_h)) ) then
- ! The (lon,lat) here must match the definition of highest_state_loc in static_init_mod.
- ! FIXME; is this hard-coding OK?
- ! local_obs_which should be consistent with local_base_obs_which, (and vert_coord).
- vert_only_loc = set_location(1.0_r8,1.0_r8,local_obs_array(3),local_obs_which)
-
- ! This gets the vertical distance (> 0) only, and uses the appropriate
- ! vert_normalization to convert from pressure or scale_height to radians.
- damping_dist = get_dist(highest_state_loc,vert_only_loc,no_vert=.false.)
-
- ! This (new) added distance varies smoothly from 0 at highest_state_pressure_Pa
- ! to > 2*cutoff*vert_normalization at the levels where CAM has extra damping
- ! (assuming that highest_state_pressure_Pa has been chosen low enough).
-
- if(present(distances)) distances(k) = distances(k) + damping_dist * damping_dist * damp_wght
+! compute local earth's radius using ellipse equation
- endif
- endif
+r0 = sqrt( ae**2 * cos(latr)**2 + be**2 * sin(latr)**2)
+! Compute altitude above sea level
+do j=1, size(h, 2)
+ do i=1, size(h, 1)
+ h(i,j) = h(i,j) / 1000.0_r8 ! m to km
+ if ( ((g0*r0)/G) - h(i,j) > 0) &
+ h(i,j) = (r0 * h(i,j)) / (((g0*r0)/G) - h(i,j))
+ h(i,j) = h(i,j) * 1000.0_r8 ! km to m
+ enddo
enddo
-end subroutine get_close
+end subroutine gph2gmh
!-----------------------------------------------------------------------
-!> wrapper for convert_vert so it can be called from assim_tools
+!> This subroutine computes the Earth's gravity at any latitude.
+!> The model assumes the Earth is an oblate spheriod rotating at
+!> the Earth's spin rate. The model was taken from
+!> "Geophysical Geodesy, Kurt Lambeck, 1988".
!>
-!> @param[in] state_handle
-!> The DART ensemble_type structure which gives access to the ensemble of model states.
+!> input: xlat, latitude in radians
+!> output: galt, gravity at the given lat, km/sec**2
!>
-!> @param[inout] obs_loc
-!> The DART location_type location of the observation.
-!>
-!> @param[in] obs_kind
-!> The DART QTY of the observation.
+!> taken from code from author Bill Schreiner, 5/95
!>
-!> @param[out] vstatus
-!> The status of the conversion from one vertical location to another.
!>
-!--------------------------------------------------------------------
-
-subroutine convert_vertical_obs(state_handle, num, locs, loc_qtys, loc_types, &
- which_vert, status)
-
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: num
-type(location_type), intent(inout) :: locs(:)
-integer, intent(in) :: loc_qtys(:), loc_types(:)
-integer, intent(in) :: which_vert
-integer, intent(out) :: status(:)
-
-real(r8) :: old_array(3)
-integer :: old_which, wanted_vert
-type(location_type) :: old_loc
-real(r8) :: new_array(3)
-integer :: new_which, i
+subroutine compute_surface_gravity(xlat, galt)
+real(r8), intent(in) :: xlat
+real(r8), intent(out) :: galt
+real(r8),parameter :: xmu = 398600.4415_r8 ! km^3/s^2
+real(r8),parameter :: ae = 6378.1363_r8 ! km
+real(r8),parameter :: f = 1.0_r8/298.2564_r8
+real(r8),parameter :: xm = 0.003468_r8 !
+real(r8),parameter :: f2 = 5.3481622134089e-03_r8 ! f2 = -f + 5.0* 0.50*xm - 17.0/14.0*f*xm + 15.0/4.0*xm**2
+real(r8),parameter :: f4 = 2.3448248012911e-05_r8 ! f4 = -f**2* 0.50 + 5.0* 0.50*f*xm
-status(:) = 0 ! I don't think cam has a return status for vertical conversion
-wanted_vert = query_vert_localization_coord()
+real(r8) :: g
+!real(r8) :: alt = 0.0_r8
-do i=1, num
- old_which = query_location(locs(i), 'which_vert')
- if (old_which == wanted_vert) cycle
+! gravity at the equator, km/s2
+real(r8), parameter :: ge = xmu/ae**2/(1.0_r8 - f + 1.5_r8*xm - 15.0_r8/14.0_r8*xm*f)
- old_loc = locs(i)
- old_array = get_location(locs(i))
- call convert_vert(state_handle, old_array, old_which, old_loc, loc_qtys(i), new_array, new_which)
+! compute gravity at any latitude, km/s2
+g = ge*(1.0_r8 + f2*(sin(xlat))**2 - 1.0_r8/4.0_r8*f4*(sin(2.0_r8*xlat))**2)
- if(new_which == MISSING_I) then
- status(i) = 1
- else
- locs(i) = set_location(new_array(1), new_array(2), new_array(3), new_which)
- endif
-enddo
+! at a fixed altitude of 0.0, g and galt are the same
+galt = g
+! FIXME: if alt is hardcoded to 0.0, none of this code is needed.
+!
+! keep it for now in case we want gravity to vary with height.
+!
+!! compute gravity at any latitude and at any height, km/s2
+!galt = g - 2.0_r8*ge*alt/ae*(1.0_r8 + f + xm + (-3.0_r8*f + 5.0_r8* 0.50_r8*xm)* &
+! (sin(xlat))**2) + 3.0_r8*ge*alt**2/ae**2
+!
+!if (g /= galt) print *, 'g, galt: ', g, galt
+!
+!!! compute gravity at any latitude, km/s2
+!!galt = ge*(1.0_r8 + f2*(sin(xlat))**2 - 1.0_r8/4.0_r8*f4*(sin(2.0_r8*xlat))**2)
+!
+!! convert to meters/s2
+!!galt = galt*1000.0_r8
-end subroutine convert_vertical_obs
+end subroutine compute_surface_gravity
-!--------------------------------------------------------------------
-!>@todo FIXME there should be a more efficient way to convert
-!>state locations - no interpolation in the horizontal is needed.
+!-----------------------------------------------------------------------
+!> This subroutine computes converts vertical state
+!>
+!> in: ens_handle - mean ensemble handle
+!> in: num - number of locations
+!> inout: locs(:) - locations
+!> in: loc_qtys(:) - location quantities
+!> in: loc_indx(:) - location index
+!> in: which_vert - vertical location to convert
+!> out: istatus - return status 0 is a successful conversion
+!>
-subroutine convert_vertical_state(state_handle, num, locs, loc_qtys, loc_indx, &
+subroutine convert_vertical_state(ens_handle, num, locs, loc_qtys, loc_indx, &
which_vert, istatus)
-
-type(ensemble_type), intent(in) :: state_handle
+type(ensemble_type), intent(in) :: ens_handle
integer, intent(in) :: num
type(location_type), intent(inout) :: locs(:)
integer, intent(in) :: loc_qtys(:)
@@ -4168,1335 +2943,1506 @@ subroutine convert_vertical_state(state_handle, num, locs, loc_qtys, loc_indx, &
integer, intent(in) :: which_vert
integer, intent(out) :: istatus
-real(r8) :: old_array(3)
-integer :: old_which, wanted_vert
-type(location_type) :: old_loc
+character(len=*), parameter :: routine = 'convert_vertical_state'
+
+integer :: current_vert_type, ens_size, i
+
+ens_size = 1
+
+do i=1,num
+ current_vert_type = nint(query_location(locs(i)))
+
+ if ( current_vert_type == which_vert ) cycle
+ if ( current_vert_type == VERTISUNDEF) cycle
+
+ select case (which_vert)
+ case (VERTISPRESSURE)
+ call state_vertical_to_pressure( ens_handle, ens_size, locs(i), loc_indx(i), loc_qtys(i) )
+ case (VERTISHEIGHT)
+ call state_vertical_to_height( ens_handle, ens_size, locs(i), loc_indx(i), loc_qtys(i) )
+ case (VERTISLEVEL)
+ call state_vertical_to_level( ens_size, locs(i), loc_indx(i), loc_qtys(i) )
+ case (VERTISSCALEHEIGHT)
+ call state_vertical_to_scaleheight( ens_handle, ens_size, locs(i), loc_indx(i), loc_qtys(i) )
+ case default
+ write(string1,*)'unable to convert vertical state "', which_vert, '"'
+ call error_handler(E_MSG,routine,string1,source,revision,revdate)
+ end select
+enddo
+
+istatus = 0
+
+end subroutine convert_vertical_state
-real(r8) :: new_array(3)
-integer :: new_which, i
+!--------------------------------------------------------------------
-wanted_vert = query_vert_localization_coord()
+subroutine state_vertical_to_pressure(ens_handle, ens_size, location, location_indx, qty)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(inout) :: location
+integer(i8), intent(in) :: location_indx
+integer, intent(in) :: qty
-do i=1, num
- old_which = query_location(locs(i), 'which_vert')
- if (old_which == wanted_vert) cycle
+integer :: iloc, jloc, vloc, myqty, level_one, status1
+integer :: my_status(ens_size)
+real(r8) :: pressure_array(ref_nlevels), surface_pressure(ens_size)
- old_loc = locs(i)
- old_array = get_location(locs(i))
- old_which = query_location(locs(i), 'which_vert')
- if (old_which == wanted_vert) cycle
+call get_model_variable_indices(location_indx, iloc, jloc, vloc, kind_index=myqty)
- call convert_vert(state_handle, old_array, old_which, old_loc, loc_qtys(i), new_array, new_which)
+if (is_surface_field(myqty)) then
+
+ level_one = 1
+ call get_values_from_single_level(ens_handle, ens_size, QTY_SURFACE_PRESSURE, &
+ iloc, jloc, level_one, surface_pressure, status1)
- ! this is converting state locations. it shouldn't fail.
- if(new_which == MISSING_I) then
- istatus = 1
+ if (status1 /= 0) then
return
- else
- locs(i) = set_location(new_array(1), new_array(2), new_array(3), new_which)
endif
-enddo
+ call set_vertical(location, surface_pressure(1), VERTISPRESSURE)
+else
+ call cam_pressure_levels(ens_handle, ens_size, iloc, jloc, ref_nlevels, &
+ qty, pressure_array, my_status)
-istatus = 0
+ call set_vertical(location, pressure_array(vloc), VERTISPRESSURE)
+endif
-end subroutine convert_vertical_state
+end subroutine state_vertical_to_pressure
+!--------------------------------------------------------------------
-!-----------------------------------------------------------------------
+subroutine state_vertical_to_height(ens_handle, ens_size, location, location_indx, qty)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(inout) :: location
+integer(i8), intent(in) :: location_indx
+integer, intent(in) :: qty
-subroutine convert_vert(state_handle, old_array, old_which, old_loc, old_kind, new_array, new_which)
-
-! Uses model information and subroutines to convert the vertical location of an ob
-! (prior, model state variable, or actual ob) into the standard vertical coordinate
-! (pressure or log_invP = log(P0/ps)).
-! Kevin Raeder 10/26/2006
-! updated 2014 for WACCM use; log_invP vertical coordinate.
-
-type(ensemble_type), intent(in) :: state_handle
-real(r8), intent(in) :: old_array(3)
-integer, intent(in) :: old_which
-type(location_type), intent(in) :: old_loc
-integer, intent(in) :: old_kind
-real(r8), intent(inout) :: new_array(3)
-integer, intent(out) :: new_which
-
-integer :: top_lev, bot_lev
-integer :: istatus(1), closest
-integer :: lon_ind, lat_ind, cam_type
-! p_surf dimensioned (1) because it's input to interp_lonlat,
-! which needs it to be an array because of RMA.
-real(r8) :: p_surf(1), frac, l, m, new_pressure
-type(location_type) :: temp_loc
-integer :: slon_index
-
-character(len=8) :: cam_varname
-integer :: ens_size ! To call interp_lonlat with ens_size of 1
-real(r8), allocatable :: p_col(:)
-real(r8), allocatable :: model_h(:)
+integer :: iloc, jloc, vloc, my_status(ens_size)
+real(r8) :: height_array(ref_nlevels, ens_size)
-ens_size = 1
+! build a height column and a pressure column and find the levels
+call get_model_variable_indices(location_indx, iloc, jloc, vloc)
-!HK not building ps arrays.
-slon_index = find_name('slon',dim_names)
-
-! this code does not alter the lat/lon, only the vertical.
-! but still return a full location for subsequent use.
-new_array(1) = old_array(1)
-new_array(2) = old_array(2)
-
-! these should be set by the code below; it's an error if not.
-new_which = MISSING_I
-new_array(3) = MISSING_R8
-allocate(p_col(lev%length))
-
-if (.not. (old_which == VERTISPRESSURE .or. old_which == VERTISHEIGHT .or. &
- old_which == VERTISLEVEL .or. old_which == VERTISSURFACE .or. &
- old_which == VERTISUNDEF .or. old_which == VERTISSCALEHEIGHT) ) then
- ! There's no procedure to translate a which_vert value into text.
- ! So I'll just point users to location_mod.
- write(string1,'(A,3(F12.5,1x),A,I2)') 'obs at (', old_array, &
- ') has unsupported vertical type = ',old_which
- write(string2,*) 'See location_mod.f90; VERTISxxx to decode this vertical type'
- call error_handler(E_ERR, 'convert_vert', string1,source,revision,revdate,text2=string2)
-endif
+call cam_height_levels(ens_handle, ens_size, iloc, jloc, ref_nlevels, &
+ qty, height_array, my_status)
-! Need lon and lat indices to select ps for calc of p_col for vertical conversion.
-
-! Find the surface pressure and the column of pressures at this location.
-if (old_which == VERTISLEVEL ) then
- ! This assumes that if VERTISLEVEL, then the potentially close 'ob' is a
- ! model state variable, defined at a grid point. So we can figure out the
- ! grid indices and grab the surface pressure from the global ps array.
- ! This may not be true; there can be observations on a model level which
- ! don't lie on a grid point. Then this vertical coordinate conversion
- ! will be more approximate than if we interpolated the pressure to the
- ! actual 'ob' horizontal location.
- cam_type = find_name(dart_to_cam_types(old_kind),cflds)
- if (cam_type < 0) then
- write(string1,*)'old_kind is ',old_kind,' | cam_type is ',cam_type
- write(string2,*)'get_name_for_quantity of old_kind ', trim(get_name_for_quantity(old_kind))
- call error_handler(E_ERR,'convert_vert',string1,source,revision,revdate,text2=string2)
- endif
+!>@todo FIXME this can only be used if ensemble size is 1
+call set_vertical(location, height_array(vloc,1), VERTISHEIGHT)
- ! Assumes 2D obs locations are (lon, lat) and 3D are (lev,lon,lat).
-
- ! Get the column of pressures at this location, from the ensemble mean.
-
- cam_varname = trim(cflds(cam_type))
- if (cam_varname == 'US') then
- call coord_index('lon', old_array(1), lon_ind)
- call coord_index('slat', old_array(2), lat_ind)
- !p_surf = ps_stagr_lat(lon_ind,lat_ind)
- p_surf = 0.5*(get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind) + &
- get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind +1) )
- ! WHAT ABOUT FIELDS THAT MIGHT COME ON ilevS ? have lev_which_dimid from above;
- ! test = ilev%dim_id or lev%dim_id
- call plevs_cam(p_surf(1), lev%length, p_col)
- elseif (cam_varname == 'VS') then
- call coord_index('slon', old_array(1), lon_ind)
- call coord_index('lat', old_array(2), lat_ind)
- !p_surf = ps_stagr_lon(lon_ind,lat_ind)
- if ( lon_ind == 1 ) then
- p_surf = 0.5*(get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind) + &
- get_surface_pressure(state_handle, ens_size, dim_sizes(slon_index), lat_ind) )
- else
- p_surf = 0.5*(get_surface_pressure(state_handle, ens_size, lon_ind -1, lat_ind) + &
- get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind) )
- endif
- call plevs_cam(p_surf(1), lev%length, p_col)
- else
- call coord_index('lon', old_array(1), lon_ind)
- call coord_index('lat', old_array(2), lat_ind)
- !p_surf = ps(lon_ind,lat_ind)
- p_surf = get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind)
- call plevs_cam(p_surf(1), lev%length, p_col)
- endif
-else
- ! Make a vertical location that has a vert type of surface.
- ! Don't need lon_lat_vert array because old_array is passed in,
- ! which is get_location(old_loc)
- temp_loc = set_location(old_array(1), old_array(2), 0.0_r8, VERTISSURFACE)
- ! Find ps at the ob point. Need to interpolate.
- ! Only interested in P (columns), so don't need to worry about staggered grids here.
- call interp_lonlat(state_handle, ens_size, temp_loc, QTY_SURFACE_PRESSURE, p_surf, istatus)
- if (istatus(1) == 1) then
- write(string1,'(A,I8)') 'interp_X failed for QTY_SURFACE_PRESSURE.'
- call write_location(0, old_loc, charstring=string2)
- call error_handler(E_ERR, 'convert_vert', string1,source,revision,revdate, text2=string2)
- endif
+end subroutine state_vertical_to_height
- call plevs_cam(p_surf(1), lev%length, p_col)
+!--------------------------------------------------------------------
-endif
+subroutine state_vertical_to_scaleheight(ens_handle, ens_size, location, location_indx, qty)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(inout) :: location
+integer(i8), intent(in) :: location_indx
+integer, intent(in) :: qty
-! Convert vertical coordinate to vert_coord (pressure or log_invP).
-if (old_which == VERTISUNDEF) then
- ! Field with no vertical location; get_dist will only calculate horiz dist unless
- ! this case is handled by the calling routine.
-
- ! If a parameter/state variable is supposed to be close to everything,
- ! then I would need to have the/an other location to set it to,
- ! Send back new_array empty and test for that in the calling routine,
- ! where the other location exists.
- ! For model variables user specifies which_vert for each state field,
- ! so when user specifies undefined, then this should return;
- new_array(3) = MISSING_R8
- new_which = old_which
-
-elseif (old_which == VERTISSURFACE) then
- ! surface field; change which_vert for the distance calculation
- if (vert_coord == 'pressure') then
- new_array(3) = p_surf(1)
- new_which = VERTISPRESSURE
- elseif (vert_coord == 'log_invP') then
- ! Scale height at the surface is 0.0_r8 by definition [log(p_surf/p_surf)]
- new_array(3) = 0.0_r8
- new_which = VERTISSCALEHEIGHT
- endif
+integer :: iloc, jloc, vloc, level_one, status1, my_status(ens_size)
+real(r8) :: pressure_array(ref_nlevels)
+real(r8) :: surface_pressure(1), scaleheight_val
-elseif (old_which == VERTISPRESSURE) then
- if (vert_coord == 'pressure') then
- new_array(3) = old_array(3)
- new_which = VERTISPRESSURE
- elseif (vert_coord == 'log_invP') then
- new_array(3) = scale_height(p_surface=p_surf(1), p_above=old_array(3))
- new_which = VERTISSCALEHEIGHT
- endif
+!> this is currently only called with an ensemble size of 1 for
+!> vertical conversion. since it is working only on state variables
+!> we don't expect it to ever fail.
-elseif (old_which == VERTISSCALEHEIGHT) then
- if (vert_coord == 'pressure') then
- new_array(3) = p_surf(1) / exp(old_array(3))
- new_which = VERTISPRESSURE
- elseif (vert_coord == 'log_invP') then
- new_array(3) = old_array(3)
- new_which = old_which
- endif
+level_one = 1
+scaleheight_val = MISSING_R8
-elseif (old_which == VERTISLEVEL) then
- ! FIXME
- ! WHAT ABOUT FIELDS THAT MIGHT COME ON ilevS ? have lev_which_dimid from above;
- ! test = ilev%dim_id or lev%dim_id
- ! OR do this for all columns in static_init_model_dist, which would make PS (and P)
- ! globally available for all regions?
- if (vert_coord == 'pressure') then
- new_array(3) = p_col(nint(old_array(3)))
- new_which = VERTISPRESSURE
- elseif (vert_coord == 'log_invP') then
- new_array(3) = scale_height(p_surface=p_surf(1), p_above=p_col(nint(old_array(3))))
- new_which = VERTISSCALEHEIGHT
- endif
+if (no_normalization_of_scale_heights) then
-elseif (old_which == VERTISHEIGHT) then
- allocate(model_h(lev%length))
- call model_heights(state_handle, ens_size, lev%length, p_surf(1), old_loc, model_h, istatus(1))
- if (istatus(1) == 1) then
- write(string1, *) 'model_heights failed'
- call error_handler(E_ERR, 'convert_vert', string1)
- ! return
- endif
+ if (query_location(location) == VERTISSURFACE) then
+
+ ! get the surface pressure from the ens_handle
+ call get_model_variable_indices(location_indx, iloc, jloc, vloc)
+
+ call get_values_from_single_level(ens_handle, ens_size, QTY_SURFACE_PRESSURE, &
+ iloc, jloc, level_one, surface_pressure, status1)
+ if (status1 /= 0) goto 200
+
+ scaleheight_val = log(surface_pressure(1))
- ! Search down through heights
- ! This assumes linear relationship of pressure to height over each model layer,
- ! when really it's exponential. How bad is that?
-! bot_lev = 2
-! do while (old_array(3) <= model_h(bot_lev) .and. bot_lev <= lev%length)
-! bot_lev = bot_lev + 1
-! end do
- Bottom: do bot_lev = 2,lev%length
- if (old_array(3) > model_h(bot_lev) .or. bot_lev == lev%length) exit Bottom
- end do Bottom
- if (bot_lev > lev%length) bot_lev = lev%length
- top_lev = bot_lev - 1
-
- ! Write warning message if not found within model level heights.
- ! Maybe this should return failure somehow?
- if (top_lev == 1 .and. old_array(3) > model_h(1)) then
- ! above top of model
- frac = 1.0_r8
- write(string1, *) 'ob height ',old_array(3),' above CAM levels at ' &
- ,old_array(1) ,old_array(2) ,' for kind',old_kind
- call error_handler(E_MSG, 'convert_vert', string1,source,revision,revdate)
- elseif (bot_lev <= lev%length) then
- ! within model levels
- frac = (old_array(3) - model_h(bot_lev)) / (model_h(top_lev) - model_h(bot_lev))
else
- ! below bottom of model
- frac = 0.0_r8
- write(string1, *) 'ob height ',old_array(3),' below CAM levels at ' &
- ,old_array(1) ,old_array(2) ,' for kind',old_kind
- call error_handler(E_MSG, 'convert_vert', string1,source,revision,revdate)
- endif
- new_pressure = (1.0_r8 - frac) * p_col(bot_lev) + frac * p_col(top_lev)
+ ! build a pressure column and and find the levels
+ call get_model_variable_indices(location_indx, iloc, jloc, vloc)
- if (vert_coord == 'pressure') then
- new_array(3) = new_pressure
- new_which = VERTISPRESSURE
- else if (vert_coord == 'log_invP') then
- new_array(3) = scale_height(p_surface=p_surf(1), p_above=new_pressure)
- new_which = VERTISSCALEHEIGHT
- endif
+ call cam_pressure_levels(ens_handle, ens_size, iloc, jloc, ref_nlevels, &
+ qty, pressure_array, my_status)
+ if (any(my_status /= 0)) goto 200
+
+ scaleheight_val = log(pressure_array(vloc))
- deallocate(model_h)
+ endif
else
- write(string1, *) 'model which_vert = ',old_which,' not handled in convert_vert '
- call error_handler(E_ERR, 'convert_vert', string1,source,revision,revdate)
-endif
-deallocate(p_col)
+ ! handle surface obs separately here.
+ if (query_location(location) == VERTISSURFACE) then
-return
+ scaleheight_val = 0.0_r8 ! log(1.0)
-end subroutine convert_vert
+ else
-! End of get_close section
+ ! build a pressure column and and find the levels
+ call get_model_variable_indices(location_indx, iloc, jloc, vloc)
-!#######################################################################
+ call cam_pressure_levels(ens_handle, ens_size, iloc, jloc, ref_nlevels, &
+ qty, pressure_array, my_status)
+ if (any(my_status /= 0)) goto 200
-! Initial conditions for DART
+ ! get the surface pressure from the ens_handle
+ call get_values_from_single_level(ens_handle, ens_size, QTY_SURFACE_PRESSURE, &
+ iloc, jloc, level_one, surface_pressure, status1)
+ if (status1 /= 0) goto 200
+
+ scaleheight_val = scale_height(pressure_array(vloc), surface_pressure(1), no_normalization_of_scale_heights)
-!------------------------------------------------------------------
-!> Perturbs a model state copy for generating initial ensembles.
-!> Routine which could provide a custom perturbation routine to
-!> generate initial ensembles. The default (if interface is not
-!> provided) is to add gaussian noise to each item in the state vector.
-!>
-!> It is controlled by model_nml namelist variables.
-!> There are two modes of perturbation. The most common will perturb
-!> every state variable by a small random amount.
-!> See model_mod.html for details.
-!>
-!> @param[in] state(:)
-!> The model state which will be perturbed
-!>
-!> @param[out] pert_state(:)
-!> The perturbed model state
-!>
-!> @param[out] interf_provided
-!> A flag to tell filter that this perturbation interface has been provided to it.
+ endif
+
+endif
+
+200 continue ! done
+
+call set_vertical(location, scaleheight_val, VERTISSCALEHEIGHT)
+
+end subroutine state_vertical_to_scaleheight
+
+!--------------------------------------------------------------------
+
+subroutine state_vertical_to_level(ens_size, location, location_indx, qty)
+integer, intent(in) :: ens_size
+type(location_type), intent(inout) :: location
+integer(i8), intent(in) :: location_indx
+integer, intent(in) :: qty
-subroutine pert_model_copies(state_handle, ens_size, pert_amp, interf_provided)
+integer :: iloc, jloc, vloc
-type(ensemble_type), intent(inout) :: state_handle
-integer, intent(in) :: ens_size
-real(r8), intent(in) :: pert_amp
-logical, intent(out) :: interf_provided
+!>@todo FIXME qty is currently unused. if we need it, its here.
+!>if we really don't need it, we can remove it. all the other
+!>corresponding routines like this use it. (not clear what to
+!>return if field is W or something else with a vertical stagger.)
-type(model_type) :: var_temp
-integer :: j, k, m, pert_fld, mode, field_num
-integer :: dim1, dim2, dim3, member
-integer, save :: seed
-logical :: perturbed
-integer(i8) :: start_index, end_index, i ! for a variable
-integer :: copy
-real(r8) :: random_number
+call get_model_variable_indices(location_indx, iloc, jloc, vloc)
-! The input is a single model state vector that has (different) gaussian
-! noise added to each member to generate an initial ensemble.
+call set_vertical(location, real(vloc,r8), VERTISLEVEL)
-if (.not. module_initialized) call static_init_model()
+end subroutine state_vertical_to_level
-interf_provided = .true.
+!--------------------------------------------------------------------
+!> using a standard atmosphere pressure column, convert a height directly to pressure
-! This will make the results reproduce for runs with the same number of MPI tasks.
-! It will NOT give the same random sequence if you change the task count.
-k = (my_task_id()+1) * 1000
-call init_random_seq(random_seq, k)
+function generic_height_to_pressure(height, status)
+real(r8), intent(in) :: height
+integer, intent(out) :: status
+real(r8) :: generic_height_to_pressure
-pert_fld = 1
+integer :: lev1, lev2
+real(r8) :: fract
-Vars2Perturb : do pert_fld=1,100
- if (pert_names(pert_fld) == ' ') exit Vars2Perturb
+generic_height_to_pressure = MISSING_R8
- ! Keep track of whether or not this field is matched and was perturbed.
- perturbed = .false.
+call height_to_level(std_atm_table_len, std_atm_hgt_col, height, &
+ lev1, lev2, fract, status)
+if (status /= 0) return
- ExistingVars : do m=1,nflds
+generic_height_to_pressure = std_atm_pres_col(lev1) * (1.0_r8-fract) + &
+ std_atm_pres_col(lev2) * (fract)
- if (pert_names(pert_fld) /= cflds(m)) cycle ExistingVars
+end function generic_height_to_pressure
- perturbed = .true.
+!--------------------------------------------------------------------
+!> using a standard atmosphere pressure column, convert a pressure directly to height
- start_index = get_index_start(component_id, m)
- end_index = get_index_end(component_id, m)
- if (output_task0) then
- write(string1,'(3A,2I8,A,I8)') 'Perturbing ',trim(pert_names(pert_fld)), &
- ' start,stop = ',start_index,end_index,' seed=', k
- call error_handler(E_MSG,'pert_model_copies', string1)
- endif
+function generic_pressure_to_height(pressure, status)
+real(r8), intent(in) :: pressure
+integer, intent(out) :: status
+real(r8) :: generic_pressure_to_height
- ! FIXME : below is not robust. ens_member is always 0 in CESM context.
- ! Probably should remove this option from future versions; hasn't been used for years.
-
- ! Choose mode of perturbations/resets;
- if (pert_sd(pert_fld) <= 0.0_r8 ) then
- ! Set each ensemble member to its own constant value,
- ! as found in pert_base_vals(ens_member).
- ! This only works when setting a single field = to a different constant value
- ! for each ensemble member.
- ! Could add more fields by overloading pert_base_vals and
- ! adding code to find those values.
- mode = ens_member
- else
- ! Set each *field* to it's own pert_base_val +/- pert_sd
- mode = pert_fld
- endif
+integer :: lev1, lev2
+real(r8) :: fract
- if (print_details .and. output_task0) then
- write(string1,'(2A,I8,A,1pE12.3)') &
- ' WARNING: filter_nml:perturbation_amplitude is not being used. ', &
- ' INSTEAD: model_nml:pert_sd(',mode,') = ',pert_sd(mode)
- call error_handler(E_WARN,'pert_model_copies', string1)
- endif
+generic_pressure_to_height = MISSING_R8
- ! Handle the fields
+call pressure_to_level(std_atm_table_len, std_atm_pres_col, pressure, &
+ lev1, lev2, fract, status)
+if (status /= 0) return
- ! reset base values to value provided in namelist.
- if (pert_base_vals(mode) /= MISSING_R8) then
- if (print_details) then
- write(string1,*) 'Using a new base value ',pert_base_vals(mode), 'for ',cflds(m)
- call error_handler(E_MSG, 'pert_model_copies', string1, source, revision, revdate)
- endif
- where (state_handle%my_vars > start_index .and. state_handle%my_vars < end_index)
- state_handle%copies(copy, :) = pert_base_vals(mode)
- endwhere
- endif
+generic_pressure_to_height = std_atm_hgt_col(lev1) * (1.0_r8 - fract) + &
+ std_atm_hgt_col(lev2) * (fract)
- ! randomly perturb each point around its base value.
- if (pert_sd(pert_fld) > 0.0_r8 ) then
- do i = 1, state_handle%my_num_vars
- if (state_handle%my_vars(i) >= start_index .and. state_handle%my_vars(i) <= end_index) then
- do copy = 1, ens_size
-! RMA-KR This looks like it gives the same seed to each member.
-! But this is how it was done in the trunk, which worked.
- state_handle%copies(copy, i) = random_gaussian(random_seq, state_handle%copies(copy, i), pert_sd(mode))
- enddo
- endif
- enddo
- endif
+end function generic_pressure_to_height
- enddo ExistingVars
+!--------------------------------------------------------------------
+!> using the cam eta arrays, convert a pressure directly to model level
+!> use P0 as surface, ignore elevation.
- if (.not. perturbed) then
- write(string1,*)trim(pert_names(pert_fld)),' not found in list of state variables.'
- write(string2,*)'but was supposed to be used to perturb.'
- call error_handler(E_ERR,'pert_model_copies', string1, source, revision, revdate, text2=string2)
- endif
+function generic_cam_pressure_to_cam_level(pressure, status)
+real(r8), intent(in) :: pressure
+integer, intent(out) :: status
+real(r8) :: generic_cam_pressure_to_cam_level
-enddo Vars2Perturb
+integer :: lev1, lev2
+real(r8) :: fract
+real(r8) :: pressure_array(ref_nlevels)
-end subroutine pert_model_copies
+generic_cam_pressure_to_cam_level = MISSING_R8
+
+call single_pressure_column(ref_surface_pressure, ref_nlevels, pressure_array)
-! End of initial model state section
+call pressure_to_level(ref_nlevels, pressure_array, pressure, &
+ lev1, lev2, fract, status)
+if (status /= 0) return
-!#######################################################################
+generic_cam_pressure_to_cam_level = lev1 + fract
-! Utility routines; called by several main subroutines
+end function generic_cam_pressure_to_cam_level
!-----------------------------------------------------------------------
+!> Compute the pressure values at midpoint levels
+!>
+!> this version does all ensemble members at once.
-function index_from_grid(lev_ind, lon_ind, lat_ind, ifld)
+subroutine cam_pressure_levels(ens_handle, ens_size, lon_index, lat_index, nlevels, qty, &
+ pressure_array, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: nlevels
+integer, intent(in) :: qty
+real(r8), intent(out) :: pressure_array(nlevels, ens_size)
+integer, intent(out) :: my_status(ens_size)
-! Calculate the index into the state vector, given the coordinate indices
-! and the field number (out of nflds state vector fields).
+integer :: level_one, status1
+real(r8) :: surface_pressure(ens_size)
-integer, intent(in) :: lev_ind
-integer, intent(in) :: lon_ind
-integer, intent(in) :: lat_ind
-integer, intent(in) :: ifld
-integer(i8) :: index_from_grid
+! this is for surface obs
+level_one = 1
-integer :: i, j, k
+! get the surface pressure from the ens_handle
+call get_staggered_values_from_qty(ens_handle, ens_size, QTY_SURFACE_PRESSURE, &
+ lon_index, lat_index, level_one, qty, surface_pressure, status1)
-i = -1
-j = -1
-k = -1
+if (status1 /= 0) then
+ my_status(:) = status1
+ return
+endif
-! Need to convert from lev_ind, lon_ind, lat_ind to i, j, k
-!> @todo Should just store staggared info for each ifld in static_init_model_mod
-!RMA-KR; these sections could be condensed into 1, inside a loop over the 3 dimensions,
-! by defining ijk(3)
-if (get_dim_name(component_id, ifld, 1) == 'lev') i = lev_ind
-if (get_dim_name(component_id, ifld, 1) == 'lon' .or. &
- get_dim_name(component_id, ifld, 1) == 'slon') i = lon_ind
-if (get_dim_name(component_id, ifld, 1) == 'lat' .or. &
- get_dim_name(component_id, ifld, 1) == 'slat') i = lat_ind
+call build_cam_pressure_columns(ens_size, surface_pressure, ref_nlevels, &
+ pressure_array)
+my_status(:) = 0
-if (get_dim_name(component_id, ifld, 2) == 'lev') j = lev_ind
-if (get_dim_name(component_id, ifld, 2) == 'lon' .or. &
- get_dim_name(component_id, ifld, 2) == 'slon') j = lon_ind
-if (get_dim_name(component_id, ifld, 2) == 'lat' .or. &
- get_dim_name(component_id, ifld, 2) == 'slat') j = lat_ind
+end subroutine cam_pressure_levels
+!--------------------------------------------------------------------
-if (get_dim_name(component_id, ifld, 3) == 'lev') k = lev_ind
-if (get_dim_name(component_id, ifld, 3) == 'lon' .or. &
- get_dim_name(component_id, ifld, 3) == 'slon') k = lon_ind
-if (get_dim_name(component_id, ifld, 3) == 'lat' .or. &
- get_dim_name(component_id, ifld, 3) == 'slat') k = lat_ind
+subroutine convert_vertical_obs(ens_handle, num, locs, loc_qtys, loc_types, &
+ which_vert, my_status)
-index_from_grid = get_dart_vector_index(i, j, k, component_id, ifld)
+type(ensemble_type), intent(in) :: ens_handle
+integer, intent(in) :: num
+type(location_type), intent(inout) :: locs(:)
+integer, intent(in) :: loc_qtys(:)
+integer, intent(in) :: loc_types(:)
+integer, intent(in) :: which_vert
+integer, intent(out) :: my_status(:)
+
+character(len=*), parameter :: routine = 'convert_vertical_obs'
+
+integer :: current_vert_type, i
+
+do i=1,num
+ current_vert_type = nint(query_location(locs(i)))
+
+ if ( current_vert_type == which_vert ) cycle
+ if ( current_vert_type == VERTISUNDEF) cycle
+
+ select case (which_vert)
+ case (VERTISPRESSURE)
+ call obs_vertical_to_pressure( ens_handle, locs(i), my_status(i))
+ case (VERTISHEIGHT)
+ call obs_vertical_to_height( ens_handle, locs(i), my_status(i))
+ case (VERTISLEVEL)
+ call obs_vertical_to_level( ens_handle, locs(i), my_status(i))
+ case (VERTISSCALEHEIGHT)
+ call obs_vertical_to_scaleheight(ens_handle, locs(i), my_status(i))
+ case default
+ write(string1,*)'unable to convert vertical obs "', which_vert, '"'
+ call error_handler(E_ERR,routine,string1,source,revision,revdate)
+ end select
+enddo
+end subroutine convert_vertical_obs
-end function index_from_grid
+!--------------------------------------------------------------------
-!-----------------------------------------------------------------------
+subroutine obs_vertical_to_pressure(ens_handle, location, my_status)
-function find_name(nam, list)
+type(ensemble_type), intent(in) :: ens_handle
+type(location_type), intent(inout) :: location
+integer, intent(out) :: my_status
-character(len=*), intent(in) :: nam
-character(len=*), intent(in) :: list(:)
-integer :: find_name
+integer :: varid, ens_size, status(1), qty
+real(r8) :: pressure_array(ref_nlevels)
-integer :: i
+character(len=*), parameter :: routine = 'obs_vertical_to_pressure'
-! find_name = 0
-find_name = MISSING_I
-do i = 1,size(list,1)
-if (nam == list(i)) then
- find_name = i
- return
+ens_size = 1
+
+qty = QTY_PRESSURE
+if (query_location(location) == VERTISSURFACE) then
+ qty = QTY_SURFACE_PRESSURE
endif
-enddo
-end function find_name
+call ok_to_interpolate(qty, varid, my_status)
+if (my_status /= 0) return
-!-----------------------------------------------------------------------
+call interpolate_values(ens_handle, ens_size, location, &
+ qty, varid, pressure_array(:), status(:))
-subroutine coord_val(dim_name, indx, lon_val, lat_val, lev_val)
-
-! Given the name of the coordinate to be searched and the index into that array,
-! returns the coordinate value in either lon_val, lat_val, or lev_val.
-! All 3 _val arguments are present so that this routine can return the value
-! in the coordinate that the calling routine wants it to be, and search/placement doesn't
-! have to be done there.
-
-character(len=*), intent(in) :: dim_name
-integer, intent(in) :: indx
-real(r8), intent(inout) :: lon_val
-real(r8), intent(inout) :: lat_val
-real(r8), intent(inout) :: lev_val
-
-! Check for acceptable value of indx?
-! FIXME; replace these ifs with select case and add a failure case.
-
-if (dim_name == 'lon') lon_val = lon%vals(indx)
-if (dim_name == 'lat') lat_val = lat%vals(indx)
-if (dim_name == 'slon') then
- lon_val = slon%vals(indx)
- ! CAM staggered longitude grid -2.5, ..., 352.5 (FV4x5)
- ! but DART wants to see 0.,...,360. only.
- if (lon_val < 0.0_r8) lon_val = lon_val + 360.0_r8
-endif
-if (dim_name == 'slat') lat_val = slat%vals(indx)
-! RMA-KR; the ncol section was removed for this CAM-FV model_mod.
-! Will be needed for the CAM-SE version.
-
-if (lat_val <= -90.0_r8) lat_val = -89.9999999_r8
-if (lat_val >= 90.0_r8) lat_val = 89.9999999_r8
-
-! FIXME this is returning the NOMINAL vertical location (to get_state_meta_data)
-! Is that good enough? Or do I need to calculate the actual vertical location?
-! This IS good enough for the calls in interp_lonlat because only lat_val is set by those calls.
-! 2FIXME: lev from the initial file is for PS = 1000 hPa (not 10^5 Pa); missing topography and weather.
-! So it's useless for our purposes. (It's not even consistent with units of PS).
-! if (dim_name == 'lev') lev_val = lev%vals(indx) * 100.0_r8
-! if (dim_name == 'ilev') lev_val = ilev%vals(indx) * 100.0_r8
-! Any need for the lev pressure values will be calculated in get_close_obs:convert_vert.
-if (dim_name == 'lev' .or. dim_name == 'ilev') then
- lev_val = real(indx)
+
+if (status(1) /= 0) then
+ my_status = status(1)
+ return
endif
-! Add more for other coords? hyam...? Not for now; never referenced indirectly
-end subroutine coord_val
+call set_vertical(location, pressure_array(1), VERTISPRESSURE)
-!-----------------------------------------------------------------------
+my_status = 0
-subroutine coord_index(dim_name, val, indx, other_indx)
-
-! Given the name of the (Eulerian or FV) coordinate to be searched and the value,
-! Returns the index of the closest coordinate value.
-! Optionally returns the next closest index too, which may be < or > the closest.
-
-character(len=*), intent(in) :: dim_name
-real(r8), intent(in) :: val
-integer, intent(out) :: indx
-integer, optional, intent(out) :: other_indx
-
-real(r8), pointer :: coord(:)
-real(r8) :: diff_upper, diff_lower, val_local, resol
-integer :: coord_len, i
-
-nullify(coord)
-val_local = val
-
-if (dim_name == 'lon') then
- coord => lon%vals
- coord_len = lon%length
- resol = lon%resolution
-elseif (dim_name == 'lat') then
- coord => lat%vals
- coord_len = lat%length
- resol = lat%resolution
-elseif (dim_name == 'lev') then
- coord => lev%vals
- coord_len = lev%length
- resol = lev%resolution
-elseif (dim_name == 'slon') then
- coord => slon%vals
- coord_len = slon%length
- resol = slon%resolution
- ! Make sure longitudes conform to the CAM staggered grid.
- if ((val - coord(coord_len)) >= (coord(coord_len)-coord(coord_len-1))) &
- val_local = val_local - 360.0_r8
-elseif (dim_name == 'slat') then
- coord => slat%vals
- coord_len = slat%length
- resol = slat%resolution
-elseif (dim_name == 'ilev') then
- coord => ilev%vals
- coord_len = ilev%length
- resol = ilev%resolution
-else
- ! should not happen; fatal error.
- write(string1, *) 'unexpected dim_name, ', trim(dim_name)
- call error_handler(E_ERR, 'coord_index', string1,source,revision,revdate)
-endif
+end subroutine obs_vertical_to_pressure
-! Assumes that coordinates are monotonic.
+!--------------------------------------------------------------------
-if (val_local <= coord(1)) then
- indx = 1
- if (present(other_indx)) other_indx = 1
- nullify (coord)
- return
-elseif (val_local >= coord(coord_len)) then
- indx = coord_len
- if (present(other_indx)) other_indx = coord_len
- nullify (coord)
- return
-else
- if (resol > 0.0_r8) then
- ! regularly spaced; calculate the index
- ! NINT is used because some calls to this routine want the single closest indx,
- ! regardless of whether val_local is < or > coord(indx).
- indx = NINT((val_local - coord(1))/resol) + 1
-
- if (present(other_indx)) then
- if (val_local > coord(indx)) then
- other_indx = indx + 1
- else
- other_indx = indx - 1
- endif
- endif
- else
- ! IRregularly spaced (but still monotonically increasing); search for the index
- ! Replace with a binary search?
- do i=1, coord_len - 1
- diff_upper = coord(i+1) - val_local
- if (diff_upper >= 0.0_r8) then
- diff_lower = val_local - coord(i)
- ! Alway return the closer coord point in the first (non-optional) argument
- if (diff_upper > diff_lower) then
- indx = i
- if (present(other_indx)) other_indx = i + 1
- else
- indx = i + 1
- if (present(other_indx)) other_indx = i
- endif
- nullify (coord)
- return
- endif
- enddo
- endif
-endif
-! Try reclaiming coord memory before returning.
-nullify (coord)
+subroutine obs_vertical_to_height(ens_handle, location, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+type(location_type), intent(inout) :: location
+integer, intent(out) :: my_status
-end subroutine coord_index
+integer :: varid, ens_size, status(1)
+real(r8) :: height_array(1)
-!-----------------------------------------------------------------------
+character(len=*), parameter :: routine = 'obs_vertical_to_height'
-function scale_height(p_surface, p_above)
+ens_size = 1
-! Function to calculate scale height, given a surface pressure and a pressure.
-! Using the surface pressure instead of, e.g., mean sea level as the reference pressure
-! ensures that scale height is always positive.
-! FIXME; But is it a distortion to have the scale heights follow the terrain?
+call ok_to_interpolate(QTY_GEOMETRIC_HEIGHT, varid, my_status)
+if (my_status /= 0) return
-real(r8), intent(in) :: p_surface
-real(r8), intent(in) :: p_above
-real(r8) :: scale_height
+call interpolate_values(ens_handle, ens_size, location, &
+ QTY_GEOMETRIC_HEIGHT, varid, height_array(:), status(:))
+if (status(1) /= 0) then
+ my_status = status(1)
+ return
+endif
-scale_height = 5000.0_r8 ! arbitrary impossibly large number of scale heights.
-if (p_above > 0.0_r8) scale_height = log(p_surface/p_above)
+call set_vertical(location, height_array(1), VERTISHEIGHT)
-end function scale_height
+my_status = 0
-!-----------------------------------------------------------------------
+end subroutine obs_vertical_to_height
-subroutine plevs_cam (p_surf, n_levels, pmid )
+!--------------------------------------------------------------------
-! Define the pressures of the layer midpoints from the
-! coordinate definitions and the surface pressure.
+subroutine obs_vertical_to_level(ens_handle, location, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+type(location_type), intent(inout) :: location
+integer, intent(out) :: my_status
-real(r8), intent(in) :: p_surf ! Surface pressure (pascals)
-integer, intent(in) :: n_levels
-real(r8), intent(out) :: pmid(lev%length) ! Pressure at model levels
+integer :: varid, ens_size, status(1)
+real(r8) :: level_array(1)
-integer :: k
+ens_size = 1
+varid = -1
-! Set midpoint pressures and layer thicknesses
+call interpolate_values(ens_handle, ens_size, location, &
+ QTY_VERTLEVEL, varid, level_array(:), status(:))
+if (status(1) /= 0) then
+ my_status = status(1)
+ return
+endif
-do k=1,n_levels
- pmid(k) = hyam%vals(k)*P0%vals(1) + hybm%vals(k)*p_surf
-enddo
+call set_vertical(location, level_array(1), VERTISLEVEL)
-end subroutine plevs_cam
+my_status = 0
-!-----------------------------------------------------------------------
+end subroutine obs_vertical_to_level
-subroutine model_heights(state_handle, ens_size, n_levels, p_surf, base_obs_loc, model_h, istatus)
+!--------------------------------------------------------------------
-! This routine calculates geometrical height (m) at mid-layers of the CAM model
-!
-! was Hui's dcz2ccm1
-! has globally defined inputs:
-! hyam(lev%length),hybm(lev%length),hyai(lev%length),hybi(lev%length) =
-! hybrid vertical coefficients, top to bottom.
-! (P = P0*hyam + ps*hybm)
-! P0 - Hybrid base pressure (pascals)
-!
-! Kevin Raeder converted to single column version 4/28/2006
-! removed longitude dimension entirely and extra arrays 10/2006
-! 5/31/2013; Rewritten to adapt to convert_vert handling obs TYPEs,
-! not obs QTYs, and to handle lonlat and cubed sphere
-! grids/interpolations.
+subroutine obs_vertical_to_scaleheight(ens_handle, location, my_status)
+type(ensemble_type), intent(in) :: ens_handle
+type(location_type), intent(inout) :: location
+integer, intent(out) :: my_status
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: ens_size
-integer, intent(in) :: n_levels
-real(r8), intent(in) :: p_surf(ens_size)
-type(location_type), intent(in) :: base_obs_loc
-
-real(r8), intent(out) :: model_h(n_levels, ens_size)
-integer, intent(out) :: istatus(ens_size)
-
-! local variables;
-real(r8), dimension(ens_size, n_levels) :: phi, tv, q, t, mmr_o1, mmr_o2, mmr_h1, mmr_n2
-real(r8), dimension(ens_size) :: h_surf, ht_tmp
-real(r8), dimension(n_levels+1,2) :: hybrid_As, hybrid_Bs
-
-! CS Should these come from common_mod?
-! That might be inconsistent with how levels, etc were defined in CAM originally.
-! DART's values are 287.0_r8 and 461.6_r8.
-real(r8), parameter :: rd = 287.05_r8
-real(r8), parameter :: rv = 461.51_r8
-real(r8), parameter :: rr_factor = (rv/rd) - 1.0_r8
+integer :: varid1, varid2, ens_size, status(1), ptype
+real(r8) :: pressure_array(1), surface_pressure_array(1)
+real(r8) :: scaleheight_val
-real(r8) :: lon_lat_lev(3)
-type(location_type) :: temp_obs_loc
-
-integer :: k, i, imem
-integer :: vstatus(ens_size)
-istatus(:) = 1
-model_h(:,:) = MISSING_R8
-
-! RMA-KR; CAM-SE section was removed from here.
-
-! lat, lon and vertical in height
-lon_lat_lev = get_location(base_obs_loc)
-
-!> @todo I don't think hybrid_As and hybrid_Bs change thoughout a run of filter
-! RMA-KR; That's true. They could be put in global storage and initialized in static_init_mod
-! after hy[ab][im] have been read in.
-! copy hybrid_As, hybrid_Bs to temporary arrays to pass to dcz2
-! All arrays except hybrid_As, hybrid_Bs are oriented top to bottom.
-
-! The 'interface' levels have an 'extra' level at model bottom, compared to the midpoint levels.
-! Initialize this extra level, before filling the rest in a loop.
-k = n_levels +1
-hybrid_As(1,1) = hyai%vals(k)
-hybrid_Bs(1,1) = hybi%vals(k)
-
-! hyam(n_levels) = 0 -> hybrid_As(2,2) = 0, so it
-! would be safe to set hybrid_As(1,2) = 0.
-! It's safe because this element is used to set pmln in dcz2, but that element of pmln is never used.
-hybrid_As(1,2) = 0.0_r8
-
-! hyb[im] have non-0 values at the bottom, 0s at the top;
-! hyb[im] coeffs multiply sigma in the calculation of pressure on levels,
-! and CAM's vertical coord is pure sigma at the bottom, so hybrid_Bs = 1.0 there.
-hybrid_Bs(1,2) = 1.0_r8
-
-! mid-points: 2nd dimension of hybrid_[AB]s = 2
-! note that hyXm(n_levels + 1) is not defined (= MISSING_R8)
-do k = 2,n_levels +1
- i = n_levels +2 - k
- hybrid_As(k,1) = hyai%vals(i)
- hybrid_Bs(k,1) = hybi%vals(i)
- hybrid_As(k,2) = hyam%vals(i)
- hybrid_Bs(k,2) = hybm%vals(i)
-enddo
+character(len=*), parameter :: routine = 'obs_vertical_to_scaleheight'
-! Calculate h_surf and tv for this column, for use by dcz2.
-call interp_lonlat(state_handle, ens_size, base_obs_loc, QTY_SURFACE_ELEVATION, h_surf, vstatus)
-if (any(vstatus == 1)) then
- write(string1,'(A,1p3F12.6)') 'surface elevation could not be interpolated in interp_lonlat at ', &
- lon_lat_lev
- call error_handler(E_WARN, 'model_heights', string1)
- return
-endif
+ens_size = 1
-! loop through all levels to get the temperature and moisture.
-! the interp routine will return a vstatus of 2 when the level is
-! above the 'highest obs' threshold but we don't care about that here.
-! error out for other return code values, but continue if vstatus is
-! either 0 (all ok) or 2 (too high)
-do k = 1, n_levels
- ! construct a location with the same lat/lon but cycle though the model levels
- temp_obs_loc = set_location(lon_lat_lev(1), lon_lat_lev(2), real(k,r8), VERTISLEVEL)
-
- call interp_lonlat(state_handle, ens_size, temp_obs_loc, QTY_TEMPERATURE, t(:, k), vstatus)
- if (any(vstatus == 1)) then
- write(string1,'(A,I2,A)') 'Temperature level ',k, &
- ' could not be interpolated in interp_lonlat'
- call error_handler(E_WARN, 'model_heights', string1)
- return
+! there are 4 cases here.
+
+if (no_normalization_of_scale_heights) then
+
+ ! take log of pressure, either surface pressure or regular pressure
+
+ if (query_location(location) == VERTISSURFACE) then
+ ptype = QTY_SURFACE_PRESSURE
+ else
+ ptype = QTY_PRESSURE
endif
- call interp_lonlat(state_handle, ens_size, temp_obs_loc, QTY_SPECIFIC_HUMIDITY, q(:, k), vstatus)
- if (any(vstatus == 1)) then
- write(string1,'(A,I2,A)') 'specific humidity level ',k, &
- ' could not be interpolated in interp_lonlat'
- call error_handler(E_WARN, 'model_heights', string1)
- return
+
+ call ok_to_interpolate(ptype, varid1, my_status)
+ if (my_status /= 0) return
+
+ !>@todo FIXME IFF the obs location is already pressure, we can take it at
+ !> face value here and not interpolate it. however it won't fail if the
+ !> pressure here is less than the ensemble mean pressure at this point.
+ !> is that ok?
+
+ if (ptype == QTY_PRESSURE .and. is_vertical(location, "PRESSURE")) then
+ pressure_array(:) = query_location(location, "VLOC")
+ my_status = 0
+ else
+ call interpolate_values(ens_handle, ens_size, location, ptype, varid1, &
+ pressure_array(:), status(:))
+ if (status(1) /= 0) then
+ my_status = status(1)
+ return
+ endif
endif
+
+ scaleheight_val = log(pressure_array(1))
- tv(:, k) = t(:, k)*(1.0_r8 + rr_factor*q(:, k))
-enddo
+else
-do imem = 1, ens_size
- call dcz2(n_levels, p_surf(imem), h_surf(imem), tv(imem,:), P0%vals(1) , &
- hybrid_As, hybrid_Bs, phi(imem,:))
-enddo
+ ! handle surface obs separately here.
+ if (query_location(location) == VERTISSURFACE) then
-! used; hybrid_Bs, hybrid_As, hprb
-! output from dcz2; phi
+ scaleheight_val = 0.0_r8 ! -log(1.0)
-! Conversion from geopotential height to geometric height depends on latitude
-! Convert to kilometers for gph2gmh call, then back to meters for return value.
-do k = 1,n_levels
- ht_tmp(:) = phi(:, k) * 0.001_r8 ! convert to km for following call only
- do imem = 1, ens_size
- model_h(k, imem) = gph2gmh(ht_tmp(imem), lon_lat_lev(2)) * 1000.0_r8
- enddo
-enddo
+ else
-! model_heights returns only istatus 0 or 1
-! RMA-KR; model_heights uses a somewhat different status strategy than get_val_...
-! It uses 'return's (istatus(:)(all) set to 1) if it fails along the way,
-! rather than continuing on with calculations for those members that don't fail.
-! So if we arrived here, all is well, and return 'success' in all values of istatus.
-!
-istatus = 0
+ call ok_to_interpolate(QTY_PRESSURE, varid1, my_status)
+ if (my_status /= 0) return
+
+ !>@todo FIXME IFF the obs location is already pressure, we can take it at
+ !> face value here and not interpolate it. however, it can result in negative
+ !> scale height values if the pressure is larger than the surface pressure at
+ !> that location. that's what the original cam model_mod did. is that ok?
+
+ if (ptype == QTY_PRESSURE .and. is_vertical(location, "PRESSURE")) then
+ pressure_array(:) = query_location(location, "VLOC")
+ my_status = 0
+ else
+ call interpolate_values(ens_handle, ens_size, location, QTY_PRESSURE, varid1, &
+ pressure_array(:), status(:))
+ if (status(1) /= 0) then
+ my_status = status(1)
+ return
+ endif
+ endif
+
+ call ok_to_interpolate(QTY_SURFACE_PRESSURE, varid2, my_status)
+ if (my_status /= 0) return
+
+ call interpolate_values(ens_handle, ens_size, location, QTY_SURFACE_PRESSURE, varid2, &
+ surface_pressure_array(:), status(:))
+ if (status(1) /= 0) then
+ my_status = status(1)
+ return
+ endif
+
+ scaleheight_val = scale_height(pressure_array(1),surface_pressure_array(1), no_normalization_of_scale_heights)
-end subroutine model_heights
+ endif
-!-----------------------------------------------------------------------
+endif
-subroutine dcz2(kmax,p_surf,h_surf,tv,hprb,hybrid_As,hybrid_Bs,z2)
-
-! Compute geopotential height for a CESM hybrid coordinate column.
-! All arrays except hybrid_As, hybrid_Bs are oriented top to bottom.
-! hybrid_[AB]s first subscript:
-! = 1 for layer interfaces
-! = 2 for layer midpoints
-! hybrid_As coord coeffs for P0 reference pressure term in plevs_cam
-! hybrid_Bs coord coeffs for surf pressure term in plevs_cam (in same format as hybrid_As)
-
-integer, intent(in) :: kmax ! Number of vertical levels
-real(r8), intent(in) :: p_surf ! Surface pressure (pascals)
-real(r8), intent(in) :: h_surf ! Surface height (m)
-real(r8), intent(in) :: tv(kmax) ! Virtual temperature, top to bottom
-real(r8), intent(in) :: hprb ! Hybrid base pressure (pascals)
-real(r8), intent(in) :: hybrid_As(kmax+1,2)
-real(r8), intent(in) :: hybrid_Bs(kmax+1,2)
-real(r8), intent(out) :: z2(kmax) ! Geopotential height, top to bottom
+call set_vertical(location, scaleheight_val, VERTISSCALEHEIGHT)
-! Local variables
-real(r8), parameter :: r = 287.04_r8 ! Different than model_heights !
-real(r8), parameter :: g0 = 9.80616_r8 ! Different than model_heights:gph2gmh:G !
-real(r8), parameter :: rbyg=r/g0
-real(r8) :: pterm(kmax) ! pressure profile
-real(r8) :: pmln(kmax+1) ! logs of midpoint pressures
+my_status = 0
-integer :: i,k,l
-real(r8) :: ARG
+end subroutine obs_vertical_to_scaleheight
-! Compute intermediate quantities using scratch space
+!--------------------------------------------------------------------
-! DEBUG: z2 was unassigned in previous code.
-z2(:) = MISSING_R8
+subroutine convert_vert_one_obs(ens_handle, loc, otype, vert_type, status1)
+type(ensemble_type), intent(in) :: ens_handle
+type(location_type), intent(inout) :: loc
+integer, intent(in) :: otype
+integer, intent(in) :: vert_type
+integer, intent(out) :: status1
+
+type(location_type) :: bl(1)
+integer :: bq(1), bt(1), status(1)
+
+! these need to be arrays. kinda a pain.
+bl(1) = loc
+bt(1) = otype
+bq(1) = get_quantity_for_type_of_obs(otype)
+
+call convert_vertical_obs(ens_handle, 1, bl, bq, bt, &
+ vert_type, status)
+if (status(1) /= 0) then
+ status1 = status(1)
+ return
+endif
-! Invert vertical loop
-! Compute top only if top interface pressure is nonzero.
-!
-! newFIXME; p_col could be used here, instead of (re)calculating it in ARG
-do K = kmax+1, 1, -1
- i = kmax-K+2
- ARG = hprb*hybrid_As(i,2) + p_surf *hybrid_Bs(i,2)
- if (ARG > 0.0_r8) THEN
- pmln(K) = LOG(ARG)
- else
- pmln(K) = 0.0_r8
- endif
-enddo
+loc = bl(1)
-do K = 2,kmax - 1
- pterm(k) = rbyg*tv(k)*0.5_r8* (pmln(k+1)-pmln(k-1))
-enddo
+end subroutine convert_vert_one_obs
-! Initialize z2 to sum of ground height and thickness of top half layer
-! DEBUG; this is NOT adding the thickness of the 'top' half layer.
-! it's adding the thickness of the half layer at level K,
-do K = 1,kmax - 1
- z2(k) = h_surf + rbyg*tv(k)*0.5_r8* (pmln(K+1)-pmln(K))
-enddo
-z2(kmax) = h_surf + rbyg*tv(kmax)* (log(p_surf*hybrid_Bs(1,1))-pmln(kmax))
+!--------------------------------------------------------------------
-! DEBUG; THIS is adding the half layer at the BOTTOM.
-do k = 1,kmax - 1
- z2(k) = z2(k) + rbyg*tv(kmax)* (log(p_surf*hybrid_Bs(1,1))-0.5_r8* &
- (pmln(kmax-1)+pmln(kmax)))
-enddo
+subroutine init_discard_high_obs()
+
+! compute a conversion table between height and pressure based on
+! a surface pressure of 1010 mb. this is a fixed table and does not
+! vary with temperature, humidity or surface elevation.
+! use only for quick conversions when absolute accuracy
+! isn't a primary concern.
+
+character(len=*), parameter :: routine = 'init_discard_high_obs'
+integer :: my_status
+
+integer :: table_type
+character(len=16) :: out_fmt, out_fmt1, pres_fmt
+real(r8) :: no_assim_above_scaleh
+
+! pick the better table:
+! one is more accurate for the lower atmosphere,
+! and the other has a very high top.
+table_type = store_std_atm_tables(ref_model_top_pressure)
+
+! set formatting which is easiest to read in the log.
+! the very high top table has very small numbers that need
+! exponential notation.
+out_fmt = '(A,F12.5,A)'
+out_fmt1 = '(A,I5)'
+pres_fmt = out_fmt
+if (table_type == HIGH_TOP_TABLE) pres_fmt = '(A,E12.5,A)'
+
+! levels can be fractional but the namelist only allows integer, so simplify the formatting
+write(string1, out_fmt1) &
+ 'Discarding observations higher than model level ', no_obs_assim_above_level
+call error_handler(E_MSG, 'init_discard_high_obs', string1, source, revision, revdate)
+
+no_assim_above_pressure = single_pressure_value(ref_surface_pressure, no_obs_assim_above_level)
+write(string1, pres_fmt) &
+ ' ... which is equivalent to pressure level ', no_assim_above_pressure, ' Pascals'
+call error_handler(E_MSG, 'init_discard_high_obs', string1, source, revision, revdate)
+
+no_assim_above_height = generic_pressure_to_height(no_assim_above_pressure, my_status)
+if (my_status /= 0) then
+ call error_handler(E_ERR, routine, 'error converting pressure to height', &
+ source, revision, revdate, text2='"no_assim_above_pressure" invalid value')
+endif
+
+write(string1, out_fmt) &
+ ' ... which is equivalent to height ', no_assim_above_height, ' meters'
+call error_handler(E_MSG, 'init_discard_high_obs', string1, source, revision, revdate)
+
+! special for this - normalize by Ps for printing out
+no_assim_above_scaleh = scale_height(no_assim_above_pressure, ref_surface_pressure, .false.)
+write(string1, out_fmt) &
+ ' ... which is equivalent to scale height ', no_assim_above_scaleh
+call error_handler(E_MSG, 'init_discard_high_obs', string1, source, revision, revdate)
+
+end subroutine init_discard_high_obs
-! Add thickness of the remaining full layers
-! (i.e., integrate from ground to highest layer interface)
+!--------------------------------------------------------------------
+! initialize what we can here. the highest end of the ramp is fixed;
+! the start depends on the cutoff distance which can be observation
+! type dependent. at the time the ramping adjustment is applied all
+! vertical coordinates will have already been converted to the
+! vertical localization type.
-do K = 1,kmax - 2
- do L = K+1, kmax-1
- z2(K) = z2(K) + pterm(L)
- enddo
-enddo
+subroutine init_damping_ramp_info()
-end subroutine dcz2
+real(r8) :: model_top
-!-----------------------------------------------------------------------
+character(len=*), parameter :: routine = 'init_damping_ramp_info'
-function gph2gmh(h, lat)
+integer :: table_type
+character(len=16) :: out_fmt
-! Convert a list of geopotential altitudes to mean sea level altitude.
+! pick the better table:
+! one is more accurate for the lower atmosphere,
+! and the other has a very high top.
+table_type = store_std_atm_tables(ref_model_top_pressure)
-real(r8), intent(in) :: h ! geopotential altitude (in km)
-real(r8), intent(in) :: lat ! latitude of profile in degrees.
-real(r8) :: gph2gmh ! MSL altitude, in km.
+! set formatting which is easiest to read in the log.
+! the very high top table has very small numbers that need
+! exponential notation.
+out_fmt = '(A,F12.5,A)'
+if (table_type == HIGH_TOP_TABLE .and. &
+ vertical_localization_type == VERTISPRESSURE) out_fmt = '(A,E12.5,A)'
-real(r8), parameter :: be = 6356.7516_r8 ! min earth radius, km
-real(r8), parameter :: ae = 6378.1363_r8 ! max earth radius, km
-real(r8), parameter :: pi = 3.14159265358979_r8
-! FIXME; another definition of gravitational acceleration. See g0 and gravity_constant elsewhere.
-real(r8), parameter :: G = 0.00980665_r8 ! WMO reference g value, km/s**2, at 45.542N(S)
+! convert to vertical localization units
+call convert_vertical_level_generic(real(model_damping_ends_at_level, r8), &
+ vertical_localization_type, ramp_end, string3, no_norm=.false.)
-real(r8) :: g0
-real(r8) :: r0
-real(r8) :: latr
+! check for conversion errors
+if (ramp_end == MISSING_R8) then
+ write(string1, *) 'error converting ramp_end to vertical localization units'
+ call error_handler(E_MSG, routine, 'unexpected error', &
+ source, revision, revdate, text2=string1)
+endif
-latr = lat * (pi/180.0_r8) ! in radians
-call gravity(latr, 0.0_r8, g0)
+! this value only used for print statement, unused otherwise
+call convert_vertical_level_generic(1.0_r8, vertical_localization_type, &
+ model_top, string3, no_norm=.false.)
-! compute local earth's radius using ellipse equation
+! check for conversion errors
+if (model_top == MISSING_R8) then
+ write(string1, *) 'error converting model_top to vertical localization units'
+ call error_handler(E_MSG, routine, 'unexpected error', &
+ source, revision, revdate, text2=string1)
+endif
-r0 = sqrt( ae**2 * cos(latr)**2 + be**2 * sin(latr)**2)
+! at this point, ramp_end and model_top are in the localization units
-! Compute altitude above sea level
-gph2gmh = (r0 * h) / (((g0*r0)/G) - h)
+! let the log know what we're doing
+write(string1, '(A,I5)') 'Increments will go to 0.0 at model level ', model_damping_ends_at_level
+write(string2, out_fmt) 'which is ', ramp_end, ' '//trim(string3)
+call error_handler(E_MSG, routine, &
+ 'Decreasing increments in region damped in the model', &
+ string1, source, revision, revdate, text2=string1, text3=string2)
-end function gph2gmh
+write(string1, out_fmt) 'For reference, model top is ', model_top, ' '//trim(string3)
+call error_handler(E_MSG, routine, string1, source, revision, revdate)
-!-----------------------------------------------------------------------
+end subroutine init_damping_ramp_info
-subroutine gravity(xlat,alt,galt)
+!--------------------------------------------------------------------
+!> pressure gets smaller as you go up, everything else gets larger.
+!> return true if this value is above the start of the ramp.
+!> test_value and ramp_end need to already be in vert localization units
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! This subroutine computes the Earth's gravity at any altitude
-! and latitude. The model assumes the Earth is an oblate
-! spheriod rotating at a the Earth's spin rate. The model
-! was taken from "Geophysical Geodesy, Kurt Lambeck, 1988".
+! FIXME: test this new code section carefully.
!
-! input: xlat, latitude in radians
-! alt, altitude above the reference ellipsiod, km
-! output: galt, gravity at the given lat and alt, km/sec**2
+! right now the calling code is expecting extra_dist to be added
+! to the original get_dist() value, so any scaling or modifications
+! should happen in this routine.
!
-! Compute acceleration due to the Earth's gravity at any latitude/altitude
-! author Bill Schreiner 5/95
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! do we need the 2 locations here to compute the horizontal distance?
+! or is having the total dist and the vertical separation enough?
+
+function above_ramp_start(test_value, gc, obs_type, ramp_end, total_dist, extra_dist)
+real(r8), intent(in) :: test_value
+type(get_close_type), intent(in) :: gc
+integer, intent(in) :: obs_type
+real(r8), intent(in) :: ramp_end
+real(r8), intent(in) :: total_dist
+real(r8), intent(out) :: extra_dist
+logical :: above_ramp_start
+
+real(r8) :: vert_localize_dist, ramp_start, norm, vert_norm, vert_only_dist
+real(r8) :: horiz_dist, ramp_dist, ramp_width
+type(location_type) :: this_loc, ramp_start_loc, loc1, loc2
+logical, save :: onetime = .true.
+
+
+! do the easy cases first - either above the ramp end
+! or below the ramp start. leave the middle ground for
+! last because we have to then compute a damping factor.
+
+! FIXME: test this!!!
+! is it above the ramp end? set damp dist to something
+! large enough to turn off all impacts. is vert_localize_dist enough?
+vert_localize_dist = get_maxdist(gc, obs_type)
+if (.false. .and. onetime) then
+ print *, 'vert_localize_dist = ', vert_localize_dist
+ onetime = .false.
+endif
+
+if (v_above(test_value, ramp_end)) then
+ extra_dist = vert_localize_dist
+ above_ramp_start = .true.
+ return
+endif
-real(r8), intent(in) :: xlat
-real(r8), intent(in) :: alt
-real(r8), intent(out) :: galt
+! compute ramp start and see if we're lower than that.
-real(r8),parameter :: xmu = 398600.4415_r8 ! km^3/s^2
-real(r8),parameter :: ae = 6378.1363_r8 ! km
-real(r8),parameter :: f = 1.0_r8/298.2564_r8
-real(r8),parameter :: w = 7.292115e-05_r8 ! rad/s
-real(r8),parameter :: xm = 0.003468_r8 !
-real(r8),parameter :: f2 = 5.3481622134089e-03_r8 ! f2 = -f + 5.0* 0.50*xm - 17.0/14.0*f*xm + 15.0/4.0*xm**2
-real(r8),parameter :: f4 = 2.3448248012911e-05_r8 ! f4 = -f**2* 0.50 + 5.0* 0.50*f*xm
+! vert norm for this obs type
+loc1 = set_location(0.0_r8, 0.0_r8, 0.0_r8, vertical_localization_type)
+loc2 = set_location(0.0_r8, 0.0_r8, 1.0_r8, vertical_localization_type)
+norm = get_dist(loc1, loc2, obs_type) ! units: rad/loc units
+vert_norm = 1.0_r8 / norm ! units now: loc units/rad
-real(r8) :: ge
-real(r8) :: g
+ramp_start = v_down(ramp_end, vert_norm * vert_localize_dist)
+!print *, 'computing ramp start: ramp_end, vert_norm, vert_localize_dist', &
+! ramp_start, ramp_end, vert_norm, vert_localize_dist
-! compute gravity at the equator, km/s2
-ge = xmu/ae**2/(1.0_r8 - f + 1.5_r8*xm - 15.0_r8/14.0_r8*xm*f)
+if (.not. v_above(test_value, ramp_start)) then
+ extra_dist = 0.0_r8
+ above_ramp_start = .false.
+ return
+endif
-! compute gravity at any latitude, km/s2
-g = ge*(1.0_r8 + f2*(sin(xlat))**2 - 1.0_r8/4.0_r8*f4*(sin(2.0_r8*xlat))**2)
-! compute gravity at any latitude and at any height, km/s2
-galt = g - 2.0_r8*ge*alt/ae*(1.0_r8 + f + xm + (-3.0_r8*f + 5.0_r8* 0.50_r8*xm)* &
- (sin(xlat))**2) + 3.0_r8*ge*alt**2/ae**2
+! ok, we're somewhere inbetween. compute horiz and vert distances
+! and see what the ramping factor needs to be.
-end subroutine gravity
+!print *, 'test value within ramp range: ', ramp_start, test_value, ramp_end
+above_ramp_start = .true.
-!-----------------------------------------------------------------------
+! see what the vertical separation is from obs to start of ramp
+this_loc = set_location(0.0_r8, 0.0_r8, test_value, vertical_localization_type)
+ramp_start_loc = set_location(0.0_r8, 0.0_r8, ramp_start, vertical_localization_type)
-subroutine init_model_instance(var)
+! do we need this? i think so. radians
+vert_only_dist = get_dist(ramp_start_loc, this_loc, obs_type)
-! Initializes an instance of a cam model state variable
+! we need this to compute what?
+if (vert_only_dist > total_dist) then
+ !print *, 'unexpected, vert larger than total: ', vert_only_dist, total_dist
+ !print *, 'obs_type, vert_norm = ', obs_type, vert_norm
+ horiz_dist = 0.0_r8
+else
+ horiz_dist = sqrt(total_dist**2 - vert_only_dist**2)
+endif
-type(model_type), intent(inout) :: var
+ramp_dist = v_difference(test_value, ramp_start)
+ramp_width = v_difference(ramp_end, ramp_start)
+extra_dist = (ramp_dist / ramp_width) * vert_localize_dist
-if (.not. module_initialized) call static_init_model()
+! DEBUG - disable for now
+if (.false. .and. above_ramp_start) then
+ print *, 'ramp s/v/e: ', ramp_start, test_value, ramp_end
+ print *, 'v, h: ', vert_only_dist, horiz_dist
+ print *, 'rampd, tot: ', ramp_dist, ramp_width
+ print *, 'ed, return: ', extra_dist, above_ramp_start
+endif
-! Initialize the storage space and return
+end function above_ramp_start
-! The temporary arrays into which fields are read are dimensioned by the largest values of
-! the sizes of the dimensions listed in f_dim_RANKd. Those are stored in f_dim_max.
+!--------------------------------------------------------------------
+! vertical functions - these deal with the fact that pressure,
+! scale height, and model levels all get larger as you go from
+! higher in the atmosphere to lower in the atmosphere, but height
+! is the opposite. these all depend on the global setting of the
+! vertical localization type.
-allocate(var%vars_0d( state_num_0d))
-allocate(var%vars_1d(f_dim_max(1,1), state_num_1d))
-allocate(var%vars_2d(f_dim_max(1,2),f_dim_max(2,2), state_num_2d))
-allocate(var%vars_3d(f_dim_max(1,3),f_dim_max(2,3),f_dim_max(3,3), state_num_3d))
-end subroutine init_model_instance
+!--------------------------------------------------------------------
+!> for pressure, level, and one flavor of scale height
+!> smaller numbers are further away from the surface.
+!> for height and the other flavor of scale height
+!> the opposite is true. set this once at init time.
-!-----------------------------------------------------------------------
+subroutine init_sign_of_vert_units()
-subroutine end_model_instance(var)
+if (vertical_localization_type == VERTISHEIGHT) then
+ higher_is_smaller = .false.
-! Ends an instance of a cam model state variable
+else if (vertical_localization_type == VERTISSCALEHEIGHT) then
+ ! FIXME: note from nick on scale height:
+ ! If no_normalization_of_scale_heights is true, then SH=log(pressure),
+ ! and scale height will decrease with increasing height.
+ ! However, if it is false then SH= -1*log(pressure/surface_pressure)
+ ! and it will increase with increasing height.
-type(model_type), intent(inout) :: var
+ if (no_normalization_of_scale_heights) then
+ higher_is_smaller = .true.
+ else
+ higher_is_smaller = .false.
+ endif
-if (.not. module_initialized) call static_init_model()
+else
+ higher_is_smaller = .true.
-if (.not. allocated(var%vars_0d)) then
- write(string1,*) 'Calling end_model_instance on an uninitialized state structure'
- call error_handler(E_ERR,'end_model_instance',string1, source, revision, revdate)
endif
-deallocate(var%vars_0d, var%vars_1d, var%vars_2d, var%vars_3d)
-
-end subroutine end_model_instance
+end subroutine init_sign_of_vert_units
+!--------------------------------------------------------------------
+! returns true if a is above b (higher in the atmosphere,
+! further from the surface of the earth).
-! End of utility routines
+pure function v_above(a, b)
+real(r8), intent(in) :: a, b
+logical :: v_above
-!#######################################################################
+if (higher_is_smaller) then
+ v_above = (a < b)
+else
+ v_above = (a > b)
+endif
-!-----------------------------------------------------------------------
-!>
-!> Subroutine end_model
-!> deallocates arrays that are in module global storage.
+end function v_above
-subroutine end_model()
+!--------------------------------------------------------------------
+! returns new value of moving b distance down in the atmosphere
+! starting at a. for height, this results in a smaller value
+! (also one flavor of scale height), but for other vertical types
+! this results in a larger value.
-deallocate(dim_names, dim_sizes, phis)
-deallocate(state_long_names, state_units)
-deallocate(cflds)
+pure function v_down(a, b)
+real(r8), intent(in) :: a, b
+real(r8) :: v_down
-if (allocated(f_dim_3d)) then
- deallocate(f_dim_3d, f_dimid_3d)
-endif
-if (allocated(f_dim_2d)) then
- deallocate(f_dim_2d, f_dimid_2d)
-endif
-if (allocated(f_dim_1d)) then
- deallocate(f_dim_1d, f_dimid_1d)
+if (higher_is_smaller) then
+ v_down = (a + b)
+else
+ v_down = (a - b)
endif
-call end_grid_1d_instance(lon)
-call end_grid_1d_instance(lat)
-call end_grid_1d_instance(lev)
-call end_grid_1d_instance(gw)
-call end_grid_1d_instance(hyam)
-call end_grid_1d_instance(hybm)
-call end_grid_1d_instance(hyai)
-call end_grid_1d_instance(hybi)
-call end_grid_1d_instance(slon)
-call end_grid_1d_instance(slat)
-call end_grid_1d_instance(ilev)
-call end_grid_1d_instance(P0)
+end function v_down
-end subroutine end_model
+!--------------------------------------------------------------------
+! returns difference of a and b
+! (doesn't depend on the vertical_localization_type)
-!-------------------------------------------------------------------------
-!> This replaces set_ps_arrays. It handles the whole ensemble,
-!> when needed, as required by RMA.
-function get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind)
+pure function v_difference(a, b)
+real(r8), intent(in) :: a, b
+real(r8) :: v_difference
-integer, intent(in) :: ens_size
-type(ensemble_type), intent(in) :: state_handle
-integer, intent(in) :: lon_ind
-integer, intent(in) :: lat_ind
+v_difference = abs(a - b)
-real(r8) :: get_surface_pressure(ens_size)
-integer :: ifld ! pressure field index
-integer(i8) :: ind ! index into state vector
+end function v_difference
-ifld = find_name('PS ',cflds)
+!--------------------------------------------------------------------
+!> this should only be used for converting vertical values which
+!> are the same for all ensemble members at all locations.
+!> it uses generic values to do a vertical conversion.
-! find index into state
-ind = index_from_grid(1, lon_ind, lat_ind, ifld)
+subroutine convert_vertical_level_generic(level_value, want_vert_type, out_value, out_label, no_norm)
+real(r8), intent(in) :: level_value
+integer, intent(in) :: want_vert_type
+real(r8), intent(out) :: out_value
+character(len=*), intent(out), optional :: out_label
+logical, intent(in), optional :: no_norm
-! get correct piece of state
-get_surface_pressure = get_state(ind, state_handle)
+character(len=*), parameter :: routine = 'convert_vertical_level_generic'
-end function get_surface_pressure
+integer :: status
+real(r8) :: tmp_val
+logical :: no_norm_flag
-!-----------------------------------------------------------------------
-subroutine update_vstatus(ens_size, current_vstatus, vstatus)
+if (present(no_norm)) then
+ no_norm_flag = no_norm
+else
+ no_norm_flag = no_normalization_of_scale_heights
+endif
-integer, intent(in) :: ens_size
-integer, intent(in) :: current_vstatus(ens_size)
-integer, intent(out) :: vstatus(ens_size)
-logical :: bail_out ! quit because all the ensemble members have failed
+if (want_vert_type == VERTISLEVEL) then
+ out_value = level_value
+ if (present(out_label)) out_label = 'levels'
+else
+ ! convert to the requested units. start by going to pressure
+ tmp_val = single_pressure_value(ref_surface_pressure, level_value)
-! RMA-KR; Is this bail_out code commented out because it's handled in the calling routines?
-!bail_out = .false.
-! only update if there are no previous failures
-where(vstatus == 0) vstatus = current_vstatus
-!if(all(vstatus /= 0)) bail_out = .true. ! Every ensemble member has reached failure
+ select case (want_vert_type)
+ case (VERTISPRESSURE)
+ out_value = tmp_val
+ if (present(out_label)) out_label = 'pascals'
+
+ case (VERTISSCALEHEIGHT)
+ out_value = scale_height(tmp_val, ref_surface_pressure, no_norm_flag)
+ if (present(out_label)) out_label = 'scale heights'
+
+ case (VERTISHEIGHT)
+ out_value = generic_pressure_to_height(tmp_val, status)
+ if (status /= 0) out_value = MISSING_R8
+ if (present(out_label)) out_label = 'meters'
+
+ case default
+ write(string1, *) 'unknown requested vertical type ', want_vert_type
+ call error_handler(E_MSG, routine, 'unexpected error', &
+ source, revision, revdate, text2=string1)
+ end select
+endif
-end subroutine update_vstatus
-!-----------------------------------------------------------------------
+end subroutine convert_vertical_level_generic
-! RMA-KR; set_print_details is not used in this module.
-subroutine set_print_details(how)
+!--------------------------------------------------------------------
-! reset the print_details module global variable to control
-! how much output there is
+subroutine get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, &
+ num_close, close_ind, dist, ens_handle)
-logical, intent(in) :: how
+! The specific type of the base observation, plus the generic kinds list
+! for either the state or obs lists are available if a more sophisticated
+! distance computation is needed.
-print_details = how
+type(get_close_type), intent(in) :: gc
+type(location_type), intent(inout) :: base_loc, locs(:)
+integer, intent(in) :: base_type, loc_qtys(:), loc_types(:)
+integer, intent(out) :: num_close, close_ind(:)
+real(r8), optional, intent(out) :: dist(:)
+type(ensemble_type), optional, intent(in) :: ens_handle
-end subroutine set_print_details
+character(len=*), parameter :: routine = 'get_close_obs'
-!--------------------------------------------------------------------
-!> construct restart file name for reading
-!> model time for CESM format?
-function construct_file_name_in(stub, domain, copy)
+integer :: i, status(1), this, vert_type
+real(r8) :: vert_value, extra_damping_dist
+real(r8), parameter :: LARGE_DIST = 999999.0 ! positive and large
-character(len=512), intent(in) :: stub
-integer, intent(in) :: domain
-integer, intent(in) :: copy
-character(len=256) :: construct_file_name_in
+! if absolute distances aren't needed, or vertical localization isn't on,
+! the default version works fine since no conversion will be needed and
+! there won't be any damping since there are no vert distances.
+if (.not. present(dist) .or. .not. vertical_localization_on()) then
+ call loc_get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, &
+ num_close, close_ind, dist, ens_handle)
+ return
+endif
-! fv_testcase.cam_0003.i.2004-01-15-00000.nc
-! RMA-KR; Why is the file type (i) and date hard-wired?
-! Where is this used?
-! io/io_filenames_mod.f90; when restart name can't be read from rpointer, build a name.
-write(construct_file_name_in, '(A, i4.4, A)') TRIM(stub), copy, '.i.2004-01-15-00000.nc'
+if (.not. present(ens_handle)) then
+ call error_handler(E_ERR, routine, &
+ 'unexpected error: cannot convert distances without an ensemble handle', &
+ source, revision, revdate)
+endif
-end function construct_file_name_in
+! does the base obs need conversion first?
+vert_type = query_location(base_loc)
-!--------------------------------------------------------------------
-!> pass the vertical localization coordinate to assim_tools_mod
-function query_vert_localization_coord()
+if (vert_type /= vertical_localization_type) then
+ call convert_vert_one_obs(ens_handle, base_loc, base_type, &
+ vertical_localization_type, status(1))
+ if (status(1) /= 0) then
+ num_close = 0
+ return
+ endif
+endif
-integer :: query_vert_localization_coord
+! FIXME: is here where we need to compute start of ramp for this
+! obs type? should we cache these? start with doing the computation
+! each time, then make an array indexed by obs types with the
+! start of the ramp and fill it in on demand. have to call for
+! maxdist(obs_type) and do the math, but just once per type.
+
+! ok, distance is needed and we are localizing in the vertical.
+! call default get close to get potentically close locations
+! but call without distance so it doesn't do extra work.
+call loc_get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, &
+ num_close, close_ind)
+
+! compute distances, converting vertical first if need be.
+do i=1, num_close
+ this = close_ind(i)
+
+ vert_type = query_location(locs(this))
+!print *, 'close_o, vval, vtype = ', i, query_location(locs(this), 'VLOC'), vert_type
+
+ if (vert_type /= vertical_localization_type) then
+ call convert_vertical_obs(ens_handle, 1, locs(this:this), &
+ loc_qtys(this:this), loc_types(this:this), &
+ vertical_localization_type, status)
+ if (status(1) /= 0) then
+ dist(i) = LARGE_DIST
+ cycle
+ endif
-query_vert_localization_coord = VERTISUNDEF
+ endif
-if (vert_coord == 'pressure') query_vert_localization_coord = VERTISPRESSURE
-if (vert_coord == 'log_invP') query_vert_localization_coord = VERTISSCALEHEIGHT
+ dist(i) = get_dist(base_loc, locs(this))
-end function query_vert_localization_coord
+ ! do not try to damp impacts when obs has "vert is undefined".
+ ! the impact will go all the way to the model top.
+ ! this is the agreed-on functionality.
+ if (.not. are_damping .or. vert_type == VERTISUNDEF) cycle
-!--------------------------------------------------------------------
-!> read the time from the input file
-function read_model_time(file_name)
+ vert_value = query_location(locs(this), 'VLOC')
+ if (above_ramp_start(vert_value, gc, base_type, ramp_end, dist(i), extra_damping_dist)) then
+ dist(i) = dist(i) + extra_damping_dist
+ endif
+enddo
-character(len=256), intent(in) :: file_name
+end subroutine get_close_obs
-type(time_type) :: read_model_time
+!----------------------------------------------------------------------------
-integer :: i, k, n, m, ifld
-integer :: nc_file_ID, nc_var_ID, dimid, varid, dimlen
-integer :: iyear, imonth, iday, ihour, imin, isec, rem
-integer :: timestep
-integer, allocatable :: datetmp(:), datesec(:)
+subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, &
+ num_close, close_ind, dist, ens_handle)
-! read CAM 'initial' file domain info
-call nc_check(nf90_open(path=file_name, mode=nf90_nowrite, ncid=nc_file_ID), &
- 'read_cam_init', 'opening '//trim(file_name))
+! The specific type of the base observation, plus the generic kinds list
+! for either the state or obs lists are available if a more sophisticated
+! distance computation is needed.
-! Read the time of the current state.
-! CAM initial files have two variables of length 'time' (the unlimited dimension): date, datesec
-! The rest of the routine presumes there is but one time in the file -
+type(get_close_type), intent(in) :: gc
+type(location_type), intent(inout) :: base_loc, locs(:)
+integer, intent(in) :: base_type, loc_qtys(:)
+integer(i8), intent(in) :: loc_indx(:)
+integer, intent(out) :: num_close, close_ind(:)
+real(r8), optional, intent(out) :: dist(:)
+type(ensemble_type), optional, intent(in) :: ens_handle
-call nc_check(nf90_inq_dimid(nc_file_ID, 'time', dimid), &
- 'read_cam_init', 'inq_dimid time '//trim(file_name))
-call nc_check(nf90_inquire_dimension(nc_file_ID, dimid, len=dimlen), &
- 'read_cam_init', 'inquire_dimension time '//trim(file_name))
+character(len=*), parameter :: routine = 'get_close_state'
-if (dimlen /= 1) then
- write(string1,*)trim(file_name),' has',dimlen,'times. Require exactly 1.'
- call error_handler(E_ERR, 'read_cam_init', string1, source, revision, revdate)
+integer :: i, status, this, vert_type
+real(r8) :: vert_value, extra_damping_dist
+real(r8), parameter :: LARGE_DIST = 999999.0 ! positive and large
+
+! if absolute distances aren't needed, or vertical localization isn't on,
+! the default version works fine since no conversion will be needed and
+! there won't be any damping since there are no vert distances.
+if (.not. present(dist) .or. .not. vertical_localization_on()) then
+ call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, &
+ num_close, close_ind, dist, ens_handle)
+ return
endif
-allocate(datetmp(dimlen), datesec(dimlen))
+if (.not. present(ens_handle)) then
+ call error_handler(E_ERR, routine, &
+ 'unexpected error: cannot convert distances without an ensemble handle', &
+ source, revision, revdate)
+endif
-call nc_check(nf90_inq_varid(nc_file_ID, 'date', varid), &
- 'read_cam_init', 'inq_varid date '//trim(file_name))
-call nc_check(nf90_get_var(nc_file_ID, varid, values=datetmp), &
- 'read_cam_init', 'get_var date '//trim(file_name))
+! does the base obs need conversion first?
+vert_type = query_location(base_loc)
-call nc_check(nf90_inq_varid(nc_file_ID, 'datesec', varid), &
- 'read_cam_init', 'inq_varid datesec '//trim(file_name))
-call nc_check(nf90_get_var(nc_file_ID, varid, values=datesec), &
- 'read_cam_init', 'get_var datesec '//trim(file_name))
+if (vert_type /= vertical_localization_type) then
+ call convert_vert_one_obs(ens_handle, base_loc, base_type, &
+ vertical_localization_type, status)
+ if (status /= 0) then
+ num_close = 0
+ return
+ endif
+endif
-! for future extensibility, presume we find a 'timeindex' that we want.
-! Since we only support 1 timestep in the file, this is easy.
+! ok, distance is needed and we are localizing in the vertical.
+! call default get close to get potentically close locations
+! but call without distance so it doesn't do extra work.
+call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, &
+ num_close, close_ind)
-timestep = 1
+! compute distances, converting vertical first if need be.
+do i=1, num_close
+ this = close_ind(i)
-! The 'date' is YYYYMMDD ... datesec is 'current seconds of current day'
-iyear = datetmp(timestep) / 10000
-rem = datetmp(timestep) - iyear*10000
-imonth = rem / 100
-iday = rem - imonth*100
+ vert_type = query_location(locs(this))
+!print *, 'close_s, vval, vtype = ', i, query_location(locs(this), 'VLOC'), vert_type
-ihour = datesec(timestep) / 3600
-rem = datesec(timestep) - ihour*3600
-imin = rem / 60
-isec = rem - imin*60
+ if (vert_type /= vertical_localization_type) then
+ call convert_vertical_state(ens_handle, 1, locs(this:this), &
+ loc_qtys(this:this), loc_indx(this:this), &
+ vertical_localization_type, status)
+ if (status /= 0) then
+ dist(i) = LARGE_DIST
+ cycle
+ endif
-deallocate(datetmp, datesec)
+ endif
-! some cam files are from before the start of the gregorian calendar.
-! since these are 'arbitrary' years, just change the offset.
+ dist(i) = get_dist(base_loc, locs(this))
-if (iyear < 1601) then
- write(string1,*)' '
- write(string2,*)'WARNING - ',trim(file_name),' changing year from ',iyear,'to',iyear+1601
- call error_handler(E_MSG, 'read_cam_init', string1, source, revision, &
- revdate, text2=string2,text3='to make it a valid Gregorian date.')
- write(string1,*)' '
- call error_handler(E_MSG, 'read_cam_init', string1, source, revision)
- iyear = iyear + 1601
-endif
+ ! do not try to damp impacts when obs has "vert is undefined".
+ ! the impact will go all the way to the model top.
+ ! this is the agreed-on functionality.
+ if (.not. are_damping .or. vert_type == VERTISUNDEF) cycle
-read_model_time = set_date(iyear,imonth,iday,ihour,imin,isec)
+ vert_value = query_location(locs(this), 'VLOC')
+ if (above_ramp_start(vert_value, gc, base_type, ramp_end, dist(i), extra_damping_dist)) then
+ dist(i) = dist(i) + extra_damping_dist
+ endif
+enddo
-end function read_model_time
-!-----------------------------------------------------------------------
-!>@todo this routine should write the model time when
-!> creating files from scratch
-subroutine write_model_time(ncid, dart_time)
+end subroutine get_close_state
-integer, intent(in) :: ncid !< netcdf file handle
-type(time_type), intent(in) :: dart_time
+!--------------------------------------------------------------------
+!> set values that are used by many routines here and which do not
+!> change during the execution of filter.
-call error_handler(E_MSG, 'write_model_time', 'no routine for cam-fv write model time')
+subroutine init_globals()
-end subroutine write_model_time
+ref_surface_pressure = grid_data%P0%vals(1)
+ref_model_top_pressure = grid_data%hyai%vals(1) * ref_surface_pressure
+ref_nlevels = grid_data%lev%nsize
+end subroutine init_globals
!--------------------------------------------------------------------
-!> Construct an arry to pass to add_domain that contains the clamping info
-!> for each variable. Note for non-netcdf read this is done in write_cam_init
-subroutine set_clamp_fields(clampfield)
+! Function to calculate scale height given a pressure and optionally
+! a surface pressure. (See the namelist item which controls whether to
+! normalize the pressure value aloft with the surface pressure or not.
+! We currently only use scale height for computing distances between
+! two locations, so the surface pressure terms cancel out - exactly if
+! the two locations are co-located horizontally, almost if they are not.
+! Normalizing by the surface pressure means in areas of high orography
+! the surface differences propagate all the way to the model top.
+! To be backwards-compatible, do this normalization; the current thinking
+! is we shouldn't do it both for scientific reasons and because it
+! doubles the work if it's expensive to find the correct horizontal
+! location, i.e. mpas irregular grids. In this model we always have
+! the surface pressure at a location so it's not a performance issue.)
+!
+! Watch out for unusual cases that could crash the log() function
+! We pass in the surface pressure here even if it isn't going to be
+! used because in all the cases above we seem to have it (or the standard
+! reference pressure) everywhere we are going to compute this value.
+! The "skip_norm" parameter controls whether this code uses the
+! surface pressure or not.
+
+function scale_height(p_above, p_surface, skip_norm)
+real(r8), intent(in) :: p_above
+real(r8), intent(in) :: p_surface
+logical, intent(in) :: skip_norm
+real(r8) :: scale_height
-real(r8), intent(out) :: clampfield(nflds, 2) ! min, max for each field
+real(r8), parameter :: tiny = epsilon(1.0_r8)
+real(r8) :: diff
-integer :: i
+if (skip_norm) then
+ scale_height = log(p_above)
+ return
+endif
-clampfield(:, :) = MISSING_R8 ! initalize to no clamping
+diff = p_surface - p_above ! should be positive
-do i = 1, nflds
- if(cflds(i) == 'Q') clampfield(i, 1) = 1.0e-12_r8
- if(cflds(i) == 'CLDLIQ') clampfield(i, 1) = 0.0_r8
- if(cflds(i) == 'CLDICE') clampfield(i, 1) = 0.0_r8
-enddo
+if (abs(diff) < tiny) then
+ ! surface obs will have (almost) identical values
+ scale_height = 0.0_r8 ! -log(1.0_r8)
+
+else if (diff <= tiny .or. p_above <= 0.0_r8) then
+ ! weed out bad cases
+ scale_height = MISSING_R8
-end subroutine
+else
+ ! normal computation - should be safe now
+ scale_height = -log(p_above / p_surface )
+
+endif
+
+end function scale_height
!--------------------------------------------------------------------
-function get_lon_name(var)
-integer, intent(in) :: var ! s_type - order in state vectors
-character(len=8) :: get_lon_name
+function is_surface_field(qty)
+integer, intent(in) :: qty
+logical :: is_surface_field
-integer :: i
+is_surface_field = (qty == QTY_SURFACE_PRESSURE .or. qty == QTY_SURFACE_ELEVATION)
+
+end function is_surface_field
-get_lon_name = 'lon' ! default to not staggered
+!-----------------------------------------------------------------------
+!> Store a table of pressures and heights. based on a std atmosphere.
+!> not precise - use only when rough numbers are good enough.
+!> return which table was used.
+!>
+!> table from: http://www.pdas.com/atmos.html
+!> and also see: http://www.pdas.com/upatmos.html
+!> for a good explanation of why you can't use the standard
+!> equations at high altitudes. the low tables came from
+!> tables.c, and the high one came from bigtables.out.
+!> (all found in the atmos.zip file from that web site.)
-do i = 1, get_num_dims(component_id, var)
- if (get_dim_name(component_id, var, i)=='slon') then
- get_lon_name = 'slon'
- exit
- endif
-enddo
-end function get_lon_name
+function store_std_atm_tables(this_model_top)
+real(r8), intent(in) :: this_model_top
+integer :: store_std_atm_tables
-!--------------------------------------------------------------------
-function get_lat_name(var)
+logical, save :: table_initialized = .false.
-integer, intent(in) :: var ! s_type - order in state vectors
-character(len=8) :: get_lat_name
+if (this_model_top < high_top_threshold) then
+ if (.not. table_initialized) call load_high_top_table()
+ store_std_atm_tables = HIGH_TOP_TABLE
+else
+ if (.not. table_initialized) call load_low_top_table()
+ store_std_atm_tables = LOW_TOP_TABLE
+endif
-integer :: i
+table_initialized = .true.
-get_lat_name = 'lat' ! default to not staggered
+end function store_std_atm_tables
-do i = 1, get_num_dims(component_id, var)
- if (get_dim_name(component_id, var, i)=='slat') then
- get_lat_name = 'slat'
- exit
- endif
-enddo
+!-----------------------------------------------------------------------
+!> Free arrays associated with generic tables
-end function get_lat_name
+subroutine free_std_atm_tables()
-!--------------------------------------------------------------------
-function get_lev_name(var)
+if (allocated(std_atm_hgt_col)) deallocate(std_atm_hgt_col)
+if (allocated(std_atm_pres_col)) deallocate(std_atm_pres_col)
-integer, intent(in) :: var ! s_type - order in state vectors
-character(len=8) :: get_lev_name
+end subroutine free_std_atm_tables
-integer :: i
+!--------------------------------------------------------------------
-get_lev_name = 'lev' ! default to not staggered
+subroutine load_low_top_table()
+
+std_atm_table_len = 45
+allocate(std_atm_hgt_col(std_atm_table_len), std_atm_pres_col(std_atm_table_len))
+
+std_atm_hgt_col(1) = 86.0_r8 ; std_atm_pres_col(1) = 3.732E-01_r8
+std_atm_hgt_col(2) = 84.0_r8 ; std_atm_pres_col(2) = 5.308E-01_r8
+std_atm_hgt_col(3) = 82.0_r8 ; std_atm_pres_col(3) = 7.498E-01_r8
+std_atm_hgt_col(4) = 80.0_r8 ; std_atm_pres_col(4) = 1.052E+00_r8
+std_atm_hgt_col(5) = 78.0_r8 ; std_atm_pres_col(5) = 1.467E+00_r8
+std_atm_hgt_col(6) = 76.0_r8 ; std_atm_pres_col(6) = 2.033E+00_r8
+std_atm_hgt_col(7) = 74.0_r8 ; std_atm_pres_col(7) = 2.800E+00_r8
+std_atm_hgt_col(8) = 72.0_r8 ; std_atm_pres_col(8) = 3.835E+00_r8
+std_atm_hgt_col(9) = 70.0_r8 ; std_atm_pres_col(9) = 5.220E+00_r8
+std_atm_hgt_col(10) = 68.0_r8 ; std_atm_pres_col(10) = 7.051E+00_r8
+std_atm_hgt_col(11) = 66.0_r8 ; std_atm_pres_col(11) = 9.459E+00_r8
+std_atm_hgt_col(12) = 64.0_r8 ; std_atm_pres_col(12) = 1.260E+01_r8
+std_atm_hgt_col(13) = 62.0_r8 ; std_atm_pres_col(13) = 1.669E+01_r8
+std_atm_hgt_col(14) = 60.0_r8 ; std_atm_pres_col(14) = 2.196E+01_r8
+std_atm_hgt_col(15) = 58.0_r8 ; std_atm_pres_col(15) = 2.872E+01_r8
+std_atm_hgt_col(16) = 56.0_r8 ; std_atm_pres_col(16) = 3.736E+01_r8
+std_atm_hgt_col(17) = 54.0_r8 ; std_atm_pres_col(17) = 4.833E+01_r8
+std_atm_hgt_col(18) = 52.0_r8 ; std_atm_pres_col(18) = 6.221E+01_r8
+std_atm_hgt_col(19) = 50.0_r8 ; std_atm_pres_col(19) = 7.977E+01_r8
+std_atm_hgt_col(20) = 48.0_r8 ; std_atm_pres_col(20) = 1.023E+02_r8
+std_atm_hgt_col(21) = 46.0_r8 ; std_atm_pres_col(21) = 1.313E+02_r8
+std_atm_hgt_col(22) = 44.0_r8 ; std_atm_pres_col(22) = 1.695E+02_r8
+std_atm_hgt_col(23) = 42.0_r8 ; std_atm_pres_col(23) = 2.200E+02_r8
+std_atm_hgt_col(24) = 40.0_r8 ; std_atm_pres_col(24) = 2.871E+02_r8
+std_atm_hgt_col(25) = 38.0_r8 ; std_atm_pres_col(25) = 3.771E+02_r8
+std_atm_hgt_col(26) = 36.0_r8 ; std_atm_pres_col(26) = 4.985E+02_r8
+std_atm_hgt_col(27) = 34.0_r8 ; std_atm_pres_col(27) = 6.634E+02_r8
+std_atm_hgt_col(28) = 32.0_r8 ; std_atm_pres_col(28) = 8.890E+02_r8
+std_atm_hgt_col(29) = 30.0_r8 ; std_atm_pres_col(29) = 1.197E+03_r8
+std_atm_hgt_col(30) = 28.0_r8 ; std_atm_pres_col(30) = 1.616E+03_r8
+std_atm_hgt_col(31) = 26.0_r8 ; std_atm_pres_col(31) = 2.188E+03_r8
+std_atm_hgt_col(32) = 24.0_r8 ; std_atm_pres_col(32) = 2.972E+03_r8
+std_atm_hgt_col(33) = 22.0_r8 ; std_atm_pres_col(33) = 4.047E+03_r8
+std_atm_hgt_col(34) = 20.0_r8 ; std_atm_pres_col(34) = 5.529E+03_r8
+std_atm_hgt_col(35) = 18.0_r8 ; std_atm_pres_col(35) = 7.565E+03_r8
+std_atm_hgt_col(36) = 16.0_r8 ; std_atm_pres_col(36) = 1.035E+04_r8
+std_atm_hgt_col(37) = 14.0_r8 ; std_atm_pres_col(37) = 1.417E+04_r8
+std_atm_hgt_col(38) = 12.0_r8 ; std_atm_pres_col(38) = 1.940E+04_r8
+std_atm_hgt_col(39) = 10.0_r8 ; std_atm_pres_col(39) = 2.650E+04_r8
+std_atm_hgt_col(40) = 8.0_r8 ; std_atm_pres_col(40) = 3.565E+04_r8
+std_atm_hgt_col(41) = 6.0_r8 ; std_atm_pres_col(41) = 4.722E+04_r8
+std_atm_hgt_col(42) = 4.0_r8 ; std_atm_pres_col(42) = 6.166E+04_r8
+std_atm_hgt_col(43) = 2.0_r8 ; std_atm_pres_col(43) = 7.950E+04_r8
+std_atm_hgt_col(44) = 0.0_r8 ; std_atm_pres_col(44) = 1.013E+05_r8
+std_atm_hgt_col(45) = -2.0_r8 ; std_atm_pres_col(45) = 1.278E+05_r8
+
+! convert km to m
+std_atm_hgt_col(:) = std_atm_hgt_col(:) * 1000.0_r8
+
+end subroutine load_low_top_table
-do i = 1, get_num_dims(component_id, var)
- if (get_dim_name(component_id, var, i)=='ilev') then
- get_lev_name = 'ilev'
- exit
- endif
-enddo
+!--------------------------------------------------------------------
-end function get_lev_name
+subroutine load_high_top_table()
+
+std_atm_table_len = 201
+allocate(std_atm_hgt_col(std_atm_table_len), std_atm_pres_col(std_atm_table_len))
+
+std_atm_hgt_col(1) = 1000.0_r8 ; std_atm_pres_col(1) = 7.518E-09_r8
+std_atm_hgt_col(2) = 995.0_r8 ; std_atm_pres_col(2) = 7.651E-09_r8
+std_atm_hgt_col(3) = 990.0_r8 ; std_atm_pres_col(3) = 7.790E-09_r8
+std_atm_hgt_col(4) = 985.0_r8 ; std_atm_pres_col(4) = 7.931E-09_r8
+std_atm_hgt_col(5) = 980.0_r8 ; std_atm_pres_col(5) = 8.075E-09_r8
+std_atm_hgt_col(6) = 975.0_r8 ; std_atm_pres_col(6) = 8.222E-09_r8
+std_atm_hgt_col(7) = 970.0_r8 ; std_atm_pres_col(7) = 8.371E-09_r8
+std_atm_hgt_col(8) = 965.0_r8 ; std_atm_pres_col(8) = 8.524E-09_r8
+std_atm_hgt_col(9) = 960.0_r8 ; std_atm_pres_col(9) = 8.680E-09_r8
+std_atm_hgt_col(10) = 955.0_r8 ; std_atm_pres_col(10) = 8.839E-09_r8
+std_atm_hgt_col(11) = 950.0_r8 ; std_atm_pres_col(11) = 9.001E-09_r8
+std_atm_hgt_col(12) = 945.0_r8 ; std_atm_pres_col(12) = 9.168E-09_r8
+std_atm_hgt_col(13) = 940.0_r8 ; std_atm_pres_col(13) = 9.338E-09_r8
+std_atm_hgt_col(14) = 935.0_r8 ; std_atm_pres_col(14) = 9.513E-09_r8
+std_atm_hgt_col(15) = 930.0_r8 ; std_atm_pres_col(15) = 9.692E-09_r8
+std_atm_hgt_col(16) = 925.0_r8 ; std_atm_pres_col(16) = 9.875E-09_r8
+std_atm_hgt_col(17) = 920.0_r8 ; std_atm_pres_col(17) = 1.006E-08_r8
+std_atm_hgt_col(18) = 915.0_r8 ; std_atm_pres_col(18) = 1.026E-08_r8
+std_atm_hgt_col(19) = 910.0_r8 ; std_atm_pres_col(19) = 1.046E-08_r8
+std_atm_hgt_col(20) = 905.0_r8 ; std_atm_pres_col(20) = 1.066E-08_r8
+std_atm_hgt_col(21) = 900.0_r8 ; std_atm_pres_col(21) = 1.087E-08_r8
+std_atm_hgt_col(22) = 895.0_r8 ; std_atm_pres_col(22) = 1.109E-08_r8
+std_atm_hgt_col(23) = 890.0_r8 ; std_atm_pres_col(23) = 1.132E-08_r8
+std_atm_hgt_col(24) = 885.0_r8 ; std_atm_pres_col(24) = 1.155E-08_r8
+std_atm_hgt_col(25) = 880.0_r8 ; std_atm_pres_col(25) = 1.179E-08_r8
+std_atm_hgt_col(26) = 875.0_r8 ; std_atm_pres_col(26) = 1.203E-08_r8
+std_atm_hgt_col(27) = 870.0_r8 ; std_atm_pres_col(27) = 1.229E-08_r8
+std_atm_hgt_col(28) = 865.0_r8 ; std_atm_pres_col(28) = 1.255E-08_r8
+std_atm_hgt_col(29) = 860.0_r8 ; std_atm_pres_col(29) = 1.283E-08_r8
+std_atm_hgt_col(30) = 855.0_r8 ; std_atm_pres_col(30) = 1.311E-08_r8
+std_atm_hgt_col(31) = 850.0_r8 ; std_atm_pres_col(31) = 1.340E-08_r8
+std_atm_hgt_col(32) = 845.0_r8 ; std_atm_pres_col(32) = 1.371E-08_r8
+std_atm_hgt_col(33) = 840.0_r8 ; std_atm_pres_col(33) = 1.402E-08_r8
+std_atm_hgt_col(34) = 835.0_r8 ; std_atm_pres_col(34) = 1.435E-08_r8
+std_atm_hgt_col(35) = 830.0_r8 ; std_atm_pres_col(35) = 1.469E-08_r8
+std_atm_hgt_col(36) = 825.0_r8 ; std_atm_pres_col(36) = 1.504E-08_r8
+std_atm_hgt_col(37) = 820.0_r8 ; std_atm_pres_col(37) = 1.541E-08_r8
+std_atm_hgt_col(38) = 815.0_r8 ; std_atm_pres_col(38) = 1.579E-08_r8
+std_atm_hgt_col(39) = 810.0_r8 ; std_atm_pres_col(39) = 1.619E-08_r8
+std_atm_hgt_col(40) = 805.0_r8 ; std_atm_pres_col(40) = 1.660E-08_r8
+std_atm_hgt_col(41) = 800.0_r8 ; std_atm_pres_col(41) = 1.704E-08_r8
+std_atm_hgt_col(42) = 795.0_r8 ; std_atm_pres_col(42) = 1.749E-08_r8
+std_atm_hgt_col(43) = 790.0_r8 ; std_atm_pres_col(43) = 1.795E-08_r8
+std_atm_hgt_col(44) = 785.0_r8 ; std_atm_pres_col(44) = 1.844E-08_r8
+std_atm_hgt_col(45) = 780.0_r8 ; std_atm_pres_col(45) = 1.896E-08_r8
+std_atm_hgt_col(46) = 775.0_r8 ; std_atm_pres_col(46) = 1.949E-08_r8
+std_atm_hgt_col(47) = 770.0_r8 ; std_atm_pres_col(47) = 2.006E-08_r8
+std_atm_hgt_col(48) = 765.0_r8 ; std_atm_pres_col(48) = 2.064E-08_r8
+std_atm_hgt_col(49) = 760.0_r8 ; std_atm_pres_col(49) = 2.126E-08_r8
+std_atm_hgt_col(50) = 755.0_r8 ; std_atm_pres_col(50) = 2.191E-08_r8
+std_atm_hgt_col(51) = 750.0_r8 ; std_atm_pres_col(51) = 2.260E-08_r8
+std_atm_hgt_col(52) = 745.0_r8 ; std_atm_pres_col(52) = 2.331E-08_r8
+std_atm_hgt_col(53) = 740.0_r8 ; std_atm_pres_col(53) = 2.407E-08_r8
+std_atm_hgt_col(54) = 735.0_r8 ; std_atm_pres_col(54) = 2.487E-08_r8
+std_atm_hgt_col(55) = 730.0_r8 ; std_atm_pres_col(55) = 2.571E-08_r8
+std_atm_hgt_col(56) = 725.0_r8 ; std_atm_pres_col(56) = 2.660E-08_r8
+std_atm_hgt_col(57) = 720.0_r8 ; std_atm_pres_col(57) = 2.755E-08_r8
+std_atm_hgt_col(58) = 715.0_r8 ; std_atm_pres_col(58) = 2.854E-08_r8
+std_atm_hgt_col(59) = 710.0_r8 ; std_atm_pres_col(59) = 2.960E-08_r8
+std_atm_hgt_col(60) = 705.0_r8 ; std_atm_pres_col(60) = 3.072E-08_r8
+std_atm_hgt_col(61) = 700.0_r8 ; std_atm_pres_col(61) = 3.191E-08_r8
+std_atm_hgt_col(62) = 695.0_r8 ; std_atm_pres_col(62) = 3.317E-08_r8
+std_atm_hgt_col(63) = 690.0_r8 ; std_atm_pres_col(63) = 3.451E-08_r8
+std_atm_hgt_col(64) = 685.0_r8 ; std_atm_pres_col(64) = 3.594E-08_r8
+std_atm_hgt_col(65) = 680.0_r8 ; std_atm_pres_col(65) = 3.746E-08_r8
+std_atm_hgt_col(66) = 675.0_r8 ; std_atm_pres_col(66) = 3.908E-08_r8
+std_atm_hgt_col(67) = 670.0_r8 ; std_atm_pres_col(67) = 4.080E-08_r8
+std_atm_hgt_col(68) = 665.0_r8 ; std_atm_pres_col(68) = 4.264E-08_r8
+std_atm_hgt_col(69) = 660.0_r8 ; std_atm_pres_col(69) = 4.459E-08_r8
+std_atm_hgt_col(70) = 655.0_r8 ; std_atm_pres_col(70) = 4.668E-08_r8
+std_atm_hgt_col(71) = 650.0_r8 ; std_atm_pres_col(71) = 4.892E-08_r8
+std_atm_hgt_col(72) = 645.0_r8 ; std_atm_pres_col(72) = 5.130E-08_r8
+std_atm_hgt_col(73) = 640.0_r8 ; std_atm_pres_col(73) = 5.385E-08_r8
+std_atm_hgt_col(74) = 635.0_r8 ; std_atm_pres_col(74) = 5.659E-08_r8
+std_atm_hgt_col(75) = 630.0_r8 ; std_atm_pres_col(75) = 5.951E-08_r8
+std_atm_hgt_col(76) = 625.0_r8 ; std_atm_pres_col(76) = 6.264E-08_r8
+std_atm_hgt_col(77) = 620.0_r8 ; std_atm_pres_col(77) = 6.600E-08_r8
+std_atm_hgt_col(78) = 615.0_r8 ; std_atm_pres_col(78) = 6.961E-08_r8
+std_atm_hgt_col(79) = 610.0_r8 ; std_atm_pres_col(79) = 7.349E-08_r8
+std_atm_hgt_col(80) = 605.0_r8 ; std_atm_pres_col(80) = 7.765E-08_r8
+std_atm_hgt_col(81) = 600.0_r8 ; std_atm_pres_col(81) = 8.213E-08_r8
+std_atm_hgt_col(82) = 595.0_r8 ; std_atm_pres_col(82) = 8.695E-08_r8
+std_atm_hgt_col(83) = 590.0_r8 ; std_atm_pres_col(83) = 9.214E-08_r8
+std_atm_hgt_col(84) = 585.0_r8 ; std_atm_pres_col(84) = 9.774E-08_r8
+std_atm_hgt_col(85) = 580.0_r8 ; std_atm_pres_col(85) = 1.038E-07_r8
+std_atm_hgt_col(86) = 575.0_r8 ; std_atm_pres_col(86) = 1.103E-07_r8
+std_atm_hgt_col(87) = 570.0_r8 ; std_atm_pres_col(87) = 1.173E-07_r8
+std_atm_hgt_col(88) = 565.0_r8 ; std_atm_pres_col(88) = 1.249E-07_r8
+std_atm_hgt_col(89) = 560.0_r8 ; std_atm_pres_col(89) = 1.330E-07_r8
+std_atm_hgt_col(90) = 555.0_r8 ; std_atm_pres_col(90) = 1.418E-07_r8
+std_atm_hgt_col(91) = 550.0_r8 ; std_atm_pres_col(91) = 1.514E-07_r8
+std_atm_hgt_col(92) = 545.0_r8 ; std_atm_pres_col(92) = 1.617E-07_r8
+std_atm_hgt_col(93) = 540.0_r8 ; std_atm_pres_col(93) = 1.728E-07_r8
+std_atm_hgt_col(94) = 535.0_r8 ; std_atm_pres_col(94) = 1.849E-07_r8
+std_atm_hgt_col(95) = 530.0_r8 ; std_atm_pres_col(95) = 1.979E-07_r8
+std_atm_hgt_col(96) = 525.0_r8 ; std_atm_pres_col(96) = 2.120E-07_r8
+std_atm_hgt_col(97) = 520.0_r8 ; std_atm_pres_col(97) = 2.273E-07_r8
+std_atm_hgt_col(98) = 515.0_r8 ; std_atm_pres_col(98) = 2.439E-07_r8
+std_atm_hgt_col(99) = 510.0_r8 ; std_atm_pres_col(99) = 2.618E-07_r8
+std_atm_hgt_col(100) = 505.0_r8 ; std_atm_pres_col(100) = 2.813E-07_r8
+std_atm_hgt_col(101) = 500.0_r8 ; std_atm_pres_col(101) = 3.024E-07_r8
+std_atm_hgt_col(102) = 495.0_r8 ; std_atm_pres_col(102) = 3.252E-07_r8
+std_atm_hgt_col(103) = 490.0_r8 ; std_atm_pres_col(103) = 3.501E-07_r8
+std_atm_hgt_col(104) = 485.0_r8 ; std_atm_pres_col(104) = 3.770E-07_r8
+std_atm_hgt_col(105) = 480.0_r8 ; std_atm_pres_col(105) = 4.063E-07_r8
+std_atm_hgt_col(106) = 475.0_r8 ; std_atm_pres_col(106) = 4.382E-07_r8
+std_atm_hgt_col(107) = 470.0_r8 ; std_atm_pres_col(107) = 4.728E-07_r8
+std_atm_hgt_col(108) = 465.0_r8 ; std_atm_pres_col(108) = 5.104E-07_r8
+std_atm_hgt_col(109) = 460.0_r8 ; std_atm_pres_col(109) = 5.514E-07_r8
+std_atm_hgt_col(110) = 455.0_r8 ; std_atm_pres_col(110) = 5.960E-07_r8
+std_atm_hgt_col(111) = 450.0_r8 ; std_atm_pres_col(111) = 6.445E-07_r8
+std_atm_hgt_col(112) = 445.0_r8 ; std_atm_pres_col(112) = 6.974E-07_r8
+std_atm_hgt_col(113) = 440.0_r8 ; std_atm_pres_col(113) = 7.550E-07_r8
+std_atm_hgt_col(114) = 435.0_r8 ; std_atm_pres_col(114) = 8.179E-07_r8
+std_atm_hgt_col(115) = 430.0_r8 ; std_atm_pres_col(115) = 8.864E-07_r8
+std_atm_hgt_col(116) = 425.0_r8 ; std_atm_pres_col(116) = 9.612E-07_r8
+std_atm_hgt_col(117) = 420.0_r8 ; std_atm_pres_col(117) = 1.043E-06_r8
+std_atm_hgt_col(118) = 415.0_r8 ; std_atm_pres_col(118) = 1.132E-06_r8
+std_atm_hgt_col(119) = 410.0_r8 ; std_atm_pres_col(119) = 1.229E-06_r8
+std_atm_hgt_col(120) = 405.0_r8 ; std_atm_pres_col(120) = 1.336E-06_r8
+std_atm_hgt_col(121) = 400.0_r8 ; std_atm_pres_col(121) = 1.452E-06_r8
+std_atm_hgt_col(122) = 395.0_r8 ; std_atm_pres_col(122) = 1.579E-06_r8
+std_atm_hgt_col(123) = 390.0_r8 ; std_atm_pres_col(123) = 1.718E-06_r8
+std_atm_hgt_col(124) = 385.0_r8 ; std_atm_pres_col(124) = 1.870E-06_r8
+std_atm_hgt_col(125) = 380.0_r8 ; std_atm_pres_col(125) = 2.037E-06_r8
+std_atm_hgt_col(126) = 375.0_r8 ; std_atm_pres_col(126) = 2.220E-06_r8
+std_atm_hgt_col(127) = 370.0_r8 ; std_atm_pres_col(127) = 2.421E-06_r8
+std_atm_hgt_col(128) = 365.0_r8 ; std_atm_pres_col(128) = 2.641E-06_r8
+std_atm_hgt_col(129) = 360.0_r8 ; std_atm_pres_col(129) = 2.884E-06_r8
+std_atm_hgt_col(130) = 355.0_r8 ; std_atm_pres_col(130) = 3.151E-06_r8
+std_atm_hgt_col(131) = 350.0_r8 ; std_atm_pres_col(131) = 3.445E-06_r8
+std_atm_hgt_col(132) = 345.0_r8 ; std_atm_pres_col(132) = 3.769E-06_r8
+std_atm_hgt_col(133) = 340.0_r8 ; std_atm_pres_col(133) = 4.126E-06_r8
+std_atm_hgt_col(134) = 335.0_r8 ; std_atm_pres_col(134) = 4.521E-06_r8
+std_atm_hgt_col(135) = 330.0_r8 ; std_atm_pres_col(135) = 4.957E-06_r8
+std_atm_hgt_col(136) = 325.0_r8 ; std_atm_pres_col(136) = 5.440E-06_r8
+std_atm_hgt_col(137) = 320.0_r8 ; std_atm_pres_col(137) = 5.975E-06_r8
+std_atm_hgt_col(138) = 315.0_r8 ; std_atm_pres_col(138) = 6.568E-06_r8
+std_atm_hgt_col(139) = 310.0_r8 ; std_atm_pres_col(139) = 7.226E-06_r8
+std_atm_hgt_col(140) = 305.0_r8 ; std_atm_pres_col(140) = 7.957E-06_r8
+std_atm_hgt_col(141) = 300.0_r8 ; std_atm_pres_col(141) = 8.770E-06_r8
+std_atm_hgt_col(142) = 295.0_r8 ; std_atm_pres_col(142) = 9.676E-06_r8
+std_atm_hgt_col(143) = 290.0_r8 ; std_atm_pres_col(143) = 1.069E-05_r8
+std_atm_hgt_col(144) = 285.0_r8 ; std_atm_pres_col(144) = 1.181E-05_r8
+std_atm_hgt_col(145) = 280.0_r8 ; std_atm_pres_col(145) = 1.308E-05_r8
+std_atm_hgt_col(146) = 275.0_r8 ; std_atm_pres_col(146) = 1.449E-05_r8
+std_atm_hgt_col(147) = 270.0_r8 ; std_atm_pres_col(147) = 1.608E-05_r8
+std_atm_hgt_col(148) = 265.0_r8 ; std_atm_pres_col(148) = 1.787E-05_r8
+std_atm_hgt_col(149) = 260.0_r8 ; std_atm_pres_col(149) = 1.989E-05_r8
+std_atm_hgt_col(150) = 255.0_r8 ; std_atm_pres_col(150) = 2.218E-05_r8
+std_atm_hgt_col(151) = 250.0_r8 ; std_atm_pres_col(151) = 2.476E-05_r8
+std_atm_hgt_col(152) = 245.0_r8 ; std_atm_pres_col(152) = 2.770E-05_r8
+std_atm_hgt_col(153) = 240.0_r8 ; std_atm_pres_col(153) = 3.105E-05_r8
+std_atm_hgt_col(154) = 235.0_r8 ; std_atm_pres_col(154) = 3.488E-05_r8
+std_atm_hgt_col(155) = 230.0_r8 ; std_atm_pres_col(155) = 3.927E-05_r8
+std_atm_hgt_col(156) = 225.0_r8 ; std_atm_pres_col(156) = 4.432E-05_r8
+std_atm_hgt_col(157) = 220.0_r8 ; std_atm_pres_col(157) = 5.015E-05_r8
+std_atm_hgt_col(158) = 215.0_r8 ; std_atm_pres_col(158) = 5.690E-05_r8
+std_atm_hgt_col(159) = 210.0_r8 ; std_atm_pres_col(159) = 6.476E-05_r8
+std_atm_hgt_col(160) = 205.0_r8 ; std_atm_pres_col(160) = 7.394E-05_r8
+std_atm_hgt_col(161) = 200.0_r8 ; std_atm_pres_col(161) = 8.474E-05_r8
+std_atm_hgt_col(162) = 195.0_r8 ; std_atm_pres_col(162) = 9.749E-05_r8
+std_atm_hgt_col(163) = 190.0_r8 ; std_atm_pres_col(163) = 1.127E-04_r8
+std_atm_hgt_col(164) = 185.0_r8 ; std_atm_pres_col(164) = 1.308E-04_r8
+std_atm_hgt_col(165) = 180.0_r8 ; std_atm_pres_col(165) = 1.527E-04_r8
+std_atm_hgt_col(166) = 175.0_r8 ; std_atm_pres_col(166) = 1.794E-04_r8
+std_atm_hgt_col(167) = 170.0_r8 ; std_atm_pres_col(167) = 2.121E-04_r8
+std_atm_hgt_col(168) = 165.0_r8 ; std_atm_pres_col(168) = 2.528E-04_r8
+std_atm_hgt_col(169) = 160.0_r8 ; std_atm_pres_col(169) = 3.039E-04_r8
+std_atm_hgt_col(170) = 155.0_r8 ; std_atm_pres_col(170) = 3.693E-04_r8
+std_atm_hgt_col(171) = 150.0_r8 ; std_atm_pres_col(171) = 4.542E-04_r8
+std_atm_hgt_col(172) = 145.0_r8 ; std_atm_pres_col(172) = 5.669E-04_r8
+std_atm_hgt_col(173) = 140.0_r8 ; std_atm_pres_col(173) = 7.203E-04_r8
+std_atm_hgt_col(174) = 135.0_r8 ; std_atm_pres_col(174) = 9.357E-04_r8
+std_atm_hgt_col(175) = 130.0_r8 ; std_atm_pres_col(175) = 1.250E-03_r8
+std_atm_hgt_col(176) = 125.0_r8 ; std_atm_pres_col(176) = 1.736E-03_r8
+std_atm_hgt_col(177) = 120.0_r8 ; std_atm_pres_col(177) = 2.537E-03_r8
+std_atm_hgt_col(178) = 115.0_r8 ; std_atm_pres_col(178) = 4.004E-03_r8
+std_atm_hgt_col(179) = 110.0_r8 ; std_atm_pres_col(179) = 7.149E-03_r8
+std_atm_hgt_col(180) = 105.0_r8 ; std_atm_pres_col(180) = 1.442E-02_r8
+std_atm_hgt_col(181) = 100.0_r8 ; std_atm_pres_col(181) = 3.201E-02_r8
+std_atm_hgt_col(182) = 95.0_r8 ; std_atm_pres_col(182) = 7.577E-02_r8
+std_atm_hgt_col(183) = 90.0_r8 ; std_atm_pres_col(183) = 1.844E-01_r8
+std_atm_hgt_col(184) = 85.0_r8 ; std_atm_pres_col(184) = 4.457E-01_r8
+std_atm_hgt_col(185) = 80.0_r8 ; std_atm_pres_col(185) = 1.052E+00_r8
+std_atm_hgt_col(186) = 75.0_r8 ; std_atm_pres_col(186) = 2.388E+00_r8
+std_atm_hgt_col(187) = 70.0_r8 ; std_atm_pres_col(187) = 5.221E+00_r8
+std_atm_hgt_col(188) = 65.0_r8 ; std_atm_pres_col(188) = 1.093E+01_r8
+std_atm_hgt_col(189) = 60.0_r8 ; std_atm_pres_col(189) = 2.196E+01_r8
+std_atm_hgt_col(190) = 55.0_r8 ; std_atm_pres_col(190) = 4.253E+01_r8
+std_atm_hgt_col(191) = 50.0_r8 ; std_atm_pres_col(191) = 7.978E+01_r8
+std_atm_hgt_col(192) = 45.0_r8 ; std_atm_pres_col(192) = 1.491E+02_r8
+std_atm_hgt_col(193) = 40.0_r8 ; std_atm_pres_col(193) = 2.871E+02_r8
+std_atm_hgt_col(194) = 35.0_r8 ; std_atm_pres_col(194) = 5.746E+02_r8
+std_atm_hgt_col(195) = 30.0_r8 ; std_atm_pres_col(195) = 1.197E+03_r8
+std_atm_hgt_col(196) = 25.0_r8 ; std_atm_pres_col(196) = 2.549E+03_r8
+std_atm_hgt_col(197) = 20.0_r8 ; std_atm_pres_col(197) = 5.529E+03_r8
+std_atm_hgt_col(198) = 15.0_r8 ; std_atm_pres_col(198) = 1.211E+04_r8
+std_atm_hgt_col(199) = 10.0_r8 ; std_atm_pres_col(199) = 2.650E+04_r8
+std_atm_hgt_col(200) = 5.0_r8 ; std_atm_pres_col(200) = 5.405E+04_r8
+std_atm_hgt_col(201) = 0.0_r8 ; std_atm_pres_col(201) = 1.013E+05_r8
+
+! convert km to m
+std_atm_hgt_col(:) = std_atm_hgt_col(:) * 1000.0_r8
+
+end subroutine load_high_top_table
+
+!===================================================================
+! End of model_mod
+!===================================================================
-!#######################################################################
end module model_mod
!
diff --git a/models/cam-fv/model_mod.html b/models/cam-fv/model_mod.html
index b03aeb6d18..9862af7610 100644
--- a/models/cam-fv/model_mod.html
+++ b/models/cam-fv/model_mod.html
@@ -219,7 +219,7 @@
Overview
-The 16 public interfaces in model_mod
+The 19 public interfaces in model_mod
are standardized for all DART compliant models. These interfaces allow
DART to get the model state and metadata describing
this state, find state variables that are close to a given location,
@@ -263,33 +263,24 @@
-The names of the fields to put into the state vector come from the CAM initial
-file field names.
-The specification of lists of names and numbers for the various dimensions
-enables the very flexible definition of the state vector. It can be
-done via the namelist, instead of recompiling DART for each different set.
-In the CESM+DART framework, filter initial condition files are
-created based on the state vector defined in the namelist.
-
-
-
-The dimension of these lists is currently hardwired to size 100.
-If more fields need to be assimilated (e.g. many chemical species),
-look for the integer parameter MAX_STATE_NAMES in the source code
-and change it to a large enough value and recompile DART.
-
-
-
-The values for which_vert_#d are described in
-
-location_mod:
-location_mod.html.
+The names of the fields to put into the state vector
+must match the CAM initial NetCDF file variable names.
@@ -330,139 +302,139 @@
NAMELIST
-
output_state_vector
-
logical
-
Controls the output to netCDF files.
-If .true., output the raw dart state vector. If .false., output the
-prognostic flavor (gridded data) for easier plotting (recommended).
-
-
-
model_config_file
+
cam_template_file
character(len=128)
-
CAM initial file used to provide configuration information, like
-the resolution of the grid, number of vertical levels, whether fields
+
CAM initial file used to provide configuration information,
+such as the grid resolution, number of vertical levels, whether fields
are staggered or not, etc.
cam_phis
character(len=128)
-
CAM topography file for the Eulerian and Finite Volume versions.
-Not used in the Spectral Element version.
+
CAM topography file. Reads the "PHIS" NetCDF variable from
+this file. Typically this is a CAM History file because this field is
+not normally found in a CAM initial file.
-
cs_grid_file
+
vertical_localization_coord
character(len=128)
-
CAM Spectral Element grid file. Not used in the Eulerian or
-Finite Volume versions.
+
The vertical coordinate to which all vertical locations are converted
+in model_mod. Valid options are "pressure", "height", "scaleheight" or "level".
-
homme_map_file
-
character(len=128)
-
CAM Spectral Element mapping file written by CAM-SE. Not used in the Eulerian or
-Finite Volume versions.
+
no_normalization_of_scale_heights
+
logical
+
If true the scale height is computed as the log of the pressure at
+the given location. If false the scale height is computed as a ratio of the
+log of the surface pressure and the log of the pressure aloft.
+In limited areas of high topography the ratio version might be advantageous,
+and in previous versions of filter this was the default.
+For global CAM the recommendation is to set this to .true. so the scale
+height is simply the log of the pressure at any location.
-
state_num_#d, #=0,1,2,3
+
no_obs_assim_above_level
integer
-
Numbers of fields of various dimensions to put into the state vector.
-Note that CAM-SE fields have only 1 horizontal dimension on the initial files,
-due to the cubed-sphere grid being not logically rectangular.
-"Dimensions" in cam/model_mod.f90 generally refers to dimensions on the initial file,
-not spatial dimensions of the fields.
-
-
-
state_names_#d, #=0,1,2,3
-
character(len=8), dimension(100)
-
Names of fields of various dimensions to put into the state vector.
-
-
-
which_vert_#d, #=1,2,3
-
integer, dimension(100)
-
Vertical location types of fields in state_names_#d.
-See the 3D sphere location
-documentation for the mapping of integer values to vertical location types.
+
Because the top of the model is highly damped it is recommended
+to NOT assimilate observations in the top model levels. The units here
+are CAM model level numbers. Set it to equal or below the lowest model
+level (the highest number) where damping is applied in the model.
-
pert_names
-
character(len=8), dimension(100)
-
To make filter generate an ensemble from a single model state by
-randomly perturbing it, list the field(s) to be perturbed here
-(and see the DART namelist settings for a
-perturbed initial ensemble).
+
model_damping_ends_at_level
+
integer
+
Set this to the lowest model level (the highest number) where
+model damping is applied. Observations below the 'no_obs_assim_above_level'
+cutoff but close enough to the model top to have an impact during the
+assimilation will have their impacts decreased smoothly to 0 at this
+given model level. The assimilation should make no changes to the model
+state above the given level.
-
pert_sd
-
real(r8), dimension(100)
-
If positive, it's the standard deviation of the perturbation for each
-field in the pert_names list (filter). Unused unless pert_names is set.
+
state_variables
+
character(len=64), dimension(100)
+
Character string table that includes: Names of fields (NetCDF variable
+names) to be read into the state vector, the corresponding DART Quantity for
+that variable, if a bounded quantity the minimum and maximum valid values,
+and finally the string 'UPDATE' to indicate the updated values should be
+written back to the output file. 'NOUPDATE' will skip writing this field
+at the end of the assimilation.
-
pert_base_vals
-
real(r8), dimension(100)
-
If pert_sd is positive, this the list of values to which the field(s)
-listed in pert_names will be reset if filter is told to create an ensemble
-from a single state vector. Otherwise, it's is the list of values to use for
-each ensemble member when perturbing the single field named in pert_names.
-Unused unless pert_names is set
-and pert_base_vals is not the DART missing value.
+
assimilation_period_days
+
integer
+
Sets the assimilation window width, and should match the
+model advance time when cycling. The scripts distributed with DART
+always set this to 0 days, 21600 seconds (6 hours).
-
max_obs_lat_degree
-
real(r8)
-
Observations closer to the poles than this latitude will be ignored.
+
assimilation_period_seconds
+
integer
+
Sets the assimilation window width, and should match the
+model advance time when cycling. The scripts distributed with DART
+always set this to 0 days, 21600 seconds (6 hours).
-
vert_coord
-
character(len=8)
-
The vertical coordinate to which all vertical locations are converted
-in model_mod. "log_invP" ("scale height" especially for WACCM) or "pressure".
+
suppress_grid_info_in_output
+
logical
+
Filter can update fields in existing files or create diagnostic/output
+files from scratch. By default files created from scratch include a full set
+of CAM grid information to make the file fully self-contained and plottable.
+However, to save disk space the grid variables can be suppressed in files
+created by filter by setting this to true.
-
highest_obs_pressure_Pa
-
real(r8)
-
Observations higher than this pressure are ignored.
-NOTE that this
-has a non-backwards incompatible change from previous versions. It is now
-specified in Pascals, not millibars. Divide by 100 to convert the units.
+
custom_routine_to_generate_ensemble
+
logical
+
The default perturbation routine in filter adds gaussian noise
+equally to all fields in the state vector. It is recommended to set
+this option to true so code in the model_mod is called instead.
+This allows only a limited number of fields to be perturbed.
+For example, only perturbing the temperature field T with a small
+amount of noise and then running the model forward for a few days
+is often a recommended way to generate an ensemble from a single state.
-
highest_state_pressure_Pa
-
real(r8)
-
Influence of all observations on model points higher than this is reduced.
-NOTE that this has a non-backwards incompatible change from previous versions.
-It is now specified in Pascals, not millibars. Divide by 100 to convert the units to mb.
-Details of calculating the minimum value recommended for a given vertical grid
-and set of DART namelist variables can be found in
-model_top_issues.pdf,
+
fields_to_perturb
+
character(len=32), dimension(100)
+
If perturbing a single state to generate an ensemble,
+set 'custom_routine_to_generate_ensemble = .true.' and list
+list the field(s) to be perturbed here.
-
Time_step_seconds
-
real(r8)
-
Minimum forecast duration (the part < 1 day).
-CESM1_2_1_setup_{hybrid,advanced} assume that this is 6 hours (21600 s).
+
perturbation_amplitude
+
real(r8), dimension(100)
+
For each field name in the 'fields_to_perturb' list
+give the standard deviation for the gaussian noise to add to
+each field being perturbed.
-
Time_step_days
-
real(r8)
-
Minimum forecast duration (the part > 24*3600 sec)
+
pert_base_vals
+
real(r8), dimension(100)
+
If pert_sd is positive, this the list of values to which the field(s)
+listed in pert_names will be reset if filter is told to create an ensemble
+from a single state vector. Otherwise, it's is the list of values to use for
+each ensemble member when perturbing the single field named in pert_names.
+Unused unless pert_names is set
+and pert_base_vals is not the DART missing value.
-
print_details
+
using_chemistry
logical
-
If true, print out detailed information about the sizes, shapes, offsets,
-etc. of items in the CAM state vector. If false, just print out the names of
-the fields as they are read into the state vector.
+
If using CAM-CHEM, set this to .true.
-
model_version
-
character(len=128)
-
Not used in CESM+DART; deprecated. The number of the CAM version being used, i.e. '3.0.7'.
+
using_variable_mean_mass
+
logical
+
If using any variant of WACCM with a very high
+model top, set this to .true.
-
impact_only_same_kind
-
character(len=32)
-
Name of one observation kind which can only affect
-state variables of the same kind.
+
debug_level
+
integer
+
Set this to increasingly larger values to
+print out more debugging information. Note that this
+can be very verbose. Use with care.
diff --git a/models/cam-fv/model_mod.nml b/models/cam-fv/model_mod.nml
index 5f8a4599a4..1d567ff10a 100644
--- a/models/cam-fv/model_mod.nml
+++ b/models/cam-fv/model_mod.nml
@@ -1,30 +1,44 @@
+
+# options for vertical localization: 'PRESSURE', 'HEIGHT', 'SCALEHEIGHT', 'LEVEL'
+# options for vertical interpolation (use_log_vertical_scale) = .false., .true.
+#
+# model top related items (no_obs_assim_above_level, model_damping_ends_at_level)
+# are now specified in model level numbers. the top level is 1 and increases
+# going down towards the surface.
+#
+# examples of state_variables, 5 columns per field:
+#
+# netcdf varname, dart quantity, min allowed value, max allowed value, (no)update this var
+#
+# state_variables = 'T', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE'
+# 'US','QTY_U_WIND_COMPONENT', 'NA', 'NA', 'UPDATE'
+# 'VS','QTY_V_WIND_COMPONENT', 'NA', 'NA', 'UPDATE'
+# 'Q', 'QTY_SPECIFIC_HUMIDITY', 'NA', 'NA', 'UPDATE'
+# 'CLDLIQ','QTY_CLOUD_LIQUID_WATER', 'NA', 'NA', 'UPDATE'
+# 'CLDICE','QTY_CLOUD_ICE', 'NA', 'NA', 'UPDATE'
+# 'PS','QTY_SURFACE_PRESURE', 'NA', 'NA', 'UPDATE'
+# 'O', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO', 'NA', 'NA', 'UPDATE'
+# 'O2','QTY_MOLEC_OXYGEN_MIXING_RATIO', 'NA', 'NA', 'UPDATE'
+# 'H', 'QTY_ATOMIC_H_MIXING_RATIO', 'NA', 'NA', 'UPDATE'
+# 'Op','QTY_ION_O_MIXING_RATIO', 'NA', 'NA', 'UPDATE'
+
&model_nml
- model_version = '4.0'
- model_config_file = 'caminput.nc'
- cam_phis = 'cam_phis.nc'
- cs_grid_file = 'SEMapping_cs_grid.nc'
- homme_map_file = 'SEMapping.nc'
- state_num_0d = 0
- state_num_1d = 0
- state_num_2d = 0
- state_num_3d = 0
- state_names_0d = ''
- state_names_1d = ''
- state_names_2d = ''
- state_names_3d = ''
- which_vert_1d = -2
- which_vert_2d = -1
- which_vert_3d = 1
- pert_names = ''
- pert_sd = -888888.0
- pert_base_vals = -888888.0
- highest_obs_pressure_Pa = 1000.0
- highest_state_pressure_Pa = 9400.0
- vert_coord = 'pressure'
- max_obs_lat_degree = 90.0
- Time_step_seconds = 21600
- Time_step_days = 0
- impact_only_same_kind = ' '
- print_details = .false.
- /
+ cam_template_filename = 'caminput.nc'
+ cam_phis_filename = 'cam_phis.nc'
+ vertical_localization_coord = 'PRESSURE'
+ use_log_vertical_scale = .false.
+ no_normalization_of_scale_heights = .true.
+ no_obs_assim_above_level = -1,
+ model_damping_ends_at_level = -1,
+ state_variables = ''
+ assimilation_period_days = 0
+ assimilation_period_seconds = 21600
+ suppress_grid_info_in_output = .false.
+ custom_routine_to_generate_ensemble = .true.
+ fields_to_perturb = ''
+ perturbation_amplitude = 0.0_r8
+ using_chemistry = .false.
+ use_variable_mean_mass = .false.
+ debug_level = 0
+/
diff --git a/models/cam-fv/original_model_mod.f90 b/models/cam-fv/original_model_mod.f90
new file mode 100644
index 0000000000..be23145afa
--- /dev/null
+++ b/models/cam-fv/original_model_mod.f90
@@ -0,0 +1,5504 @@
+! 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$
+
+! > > > This version has NOT been updated to describe RMA changes.
+! See RMA-KR for changes to Helen's original RMA version.
+! Some comments in here are meant to connect with comments in
+! the trunk (non-RMA) version as of 2016-7. These comments
+! and the sections in the trunk may be helpful in tracing the
+! development of the RMA for FV, and help with the development
+! of the RMA SE version.
+
+
+!> This is the interface module between remote memory access capable DART (RMA)
+!> and the atmospheric components of CESM; CAM, WACCM, CAM-Chem (, ...?).
+!> It contains the required 16 interface procedures, as specified by DART.
+!> It also contains several utility routines which help translate between CAM and DART
+!> formats, and deal with time.
+!> It is used by filter and perfect_model_obs.
+!>
+!> This module handles the finite volume dynamical core version of CAM.
+!> A separate model_mod will handle CAM-SE, the spectral element dycore.
+!> CAM-FV uses a logically rectangular grid,
+!> while CAM-SE uses the cubed sphere (non-rectangular) horizontal grid.
+!>
+!> There is a perturburbation routine for generating and initial ensemble.
+!> This routine is activated by the filter namelist logical perturb_from_single_instance
+!> and the model_mod namelist variable pert_names.
+!> The module does not provide adv_1step or init_conditions because CAM
+!> is a separate executable and cannot be called as a subroutine.
+!>
+!> This module intercepts the get_close_obs() calls and can alter the distances
+!> for obs near the top of the model to reduce the impact on the state near the
+!> top.
+!>
+!> The coordinate orders of fields are preserved from the CAM initial file order.
+!>
+!> The RMA model_mod does not refer to TYPE_s, since they were replaced by association
+!> with CAM variables and use of find_name.
+!> In the future, DART QTYs will be associated with CAM variables by the ${comp}_variables
+!> mechanism as in models/clm.
+!> If a user wants to add new CAM variables to the state vector,
+!> then more QTY_s may be needed in the 'use obs_kind_mod' statement and maybe the obs_kind_mod.
+!>
+!> Observations below the lowest model level (including surface observations) and above
+!> the highest model level cannot be assimilated (yet). The spatial extent of observations
+!> can be further restricted using model_nml namelist variables.
+!>
+!> MODULE ORGANIZATION (search for the following strings to find the corresponding section)
+!>
+!> 'use' statements
+!> Global storage for describing cam model class
+!> Namelist variables with default values
+!> Derived parameters
+!> static_init_model section
+!> Module I/O to/from DART and files
+!> model_interpolate section
+!> Vector-field translations
+!> get_close section
+!> Utility routines; called by several main subroutines
+!> Stubs not used by cam/model_mod (this is not all of them)
+!>
+!> See the subversion code logs for history of this module.
+!> There is an html description of this module in ./model_mod.html.
+!>
+
+module model_mod
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+! CONTRIBUTORS (aside from the DART team)
+
+! Ave Arellano did the first work with CAM-Chem, assimilating MOPPITT CO observations
+! into CAM-Chem using the FV core. Jerome Barre and Benjamin Gaubert took up the development
+! work from Ave, and prompted several additions to DART, as well as cam/model_mod.
+
+! Nick Pedatella developed the first vert_coord = 'log_invP' capability
+! to enable assimilation using WACCM and scale height vertical locations.
+
+! NOTES about the module.
+
+! This module no longer (RMA) keeps a copy of the ensemble mean in module global storage.
+! That was needed for convert_vert to transform the vertical coordinate of something
+! passed from filter into the coordinate used in model_mod. But now convert_vert is
+! called directly by filter, where the model states and or mean are available,
+! so ens_mean is not needed.
+! All locations are now converted to a standard coordinate
+! (pressure or log(P0/pressure), aka scale height), instead of always converting the state
+! vertical location to that of the ob. The highest_obs_level and ..._height_m variables
+! are derived from highest_obs_pressure_Pa namelist variable.
+!
+! Surface pressure may be needed on the A-grid (thermodynamic variables) and grids staggered
+! relative to the A-grid (winds). These are retrieved (A-grid) and/or calculated (staggered)
+! as needed from filter, rather than being stored globally in this module.
+
+! The coordinates of CAM (lats, lons, etc.) and their dimensions and attributes are
+! read into globally accessible data structures (see grid_1d_type).
+!
+! MODULE ORGANIZATION (search for the following strings to find the corresponding section)
+!
+! USE statements
+! Global storage for describing cam model class
+! Namelist variables with default values
+! Derived parameters
+! static_init_model section
+! Module I/O to/from DART and files
+! model_interpolate section
+! Vector-field translations
+! get_close section
+! Utility routines; called by several main subroutines
+! Stubs not used by cam/model_mod (this is not all of them)
+
+!= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+
+! USE statements
+
+use netcdf
+use typeSizes
+
+use types_mod, only : r8, MISSING_I, MISSING_R8, gravity_const => gravity, &
+ PI, DEG2RAD, RAD2DEG, obstypelength, earth_radius, i8
+! FIXME; these constants should be consistent with CESM, not necessarily with DART.
+! add after verification against Hui's tests; gas_constant_v,gas_constant,ps0,PI,DEG2RAD
+
+use time_manager_mod, only : time_type, set_time, set_date, print_time, print_date, &
+ set_calendar_type, get_calendar_type, get_time, get_date, &
+ operator(-), operator(==)
+
+use utilities_mod, only : open_file, close_file, find_namelist_in_file, check_namelist_read, &
+ register_module, error_handler, file_exist, E_ERR, E_WARN, E_MSG, &
+ logfileunit, nmlfileunit, do_output, get_unit, do_nml_file, &
+ do_nml_term
+
+use netcdf_utilities_mod, only : nc_add_global_attribute, nc_sync, nc_check, &
+ nc_add_global_creation_time, nc_redef, nc_enddef
+
+use mpi_utilities_mod, only : my_task_id, task_count
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+use location_mod, only : location_type, get_location, set_location, query_location, &
+ is_vertical, &
+ VERTISUNDEF, VERTISSURFACE, VERTISLEVEL, &
+ VERTISPRESSURE, VERTISHEIGHT, VERTISSCALEHEIGHT, write_location, &
+ get_close_type, get_dist, loc_get_close => get_close
+
+! READ THIS SYNTAX as:
+! There's a subroutine in location_mod named 'get_close'.
+! If I want to use that one in this module then refer to it as 'loc_get_close'.
+! If I call 'get_close', then I'll get the one in this module,
+! which does some stuff I need, AND ALSO CALLS 'loc_get_close'
+
+! FIXME
+! I've put a copy of solve_quadratic in this model_mod.
+! Eventually it should go into a utilities module.
+! use utilities_YYY, only : solve_quadratic
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+use obs_kind_mod, only : QTY_U_WIND_COMPONENT, QTY_V_WIND_COMPONENT, QTY_PRESSURE, &
+ QTY_SURFACE_PRESSURE, QTY_TEMPERATURE, QTY_SPECIFIC_HUMIDITY, &
+ QTY_CLOUD_LIQUID_WATER, QTY_CLOUD_ICE, QTY_CLOUD_FRACTION, &
+ QTY_GRAV_WAVE_DRAG_EFFIC, QTY_GRAV_WAVE_STRESS_FRACTION, &
+ QTY_SURFACE_ELEVATION, &
+ QTY_CO, QTY_CO2, QTY_NO, QTY_NO2, QTY_CH4, QTY_NH3, QTY_O3, &
+ QTY_AOD, QTY_CO01, QTY_CO02, QTY_CO03, &
+ QTY_SFCO, QTY_SFCO01, QTY_SFCO02, QTY_SFCO03, &
+ QTY_CB1, QTY_CB2, QTY_OC1, QTY_OC2, &
+ QTY_SFCB1, QTY_SFCB2, QTY_SFOC1, QTY_SFOC2, &
+ QTY_CB102, QTY_CB202, QTY_OC102, QTY_OC202, &
+ QTY_SFCB102, QTY_SFCB202, QTY_SFOC102, QTY_SFOC202, &
+ get_index_for_quantity, get_name_for_quantity, get_quantity_for_type_of_obs
+
+
+! Other possibilities (names have changed with various CAM versions):
+! Atmos
+! CLOUD: "Cloud fraction" ;
+! QCWAT: "q associated with cloud water" ;
+! TCWAT: "T associated with cloud water" ;
+! CWAT: "Total Grid box averaged Condensate Amount (liquid + ice)" ;
+! also? LCWAT
+
+! pbl
+! PBLH: "PBL height" ;
+! QPERT: "Perturbation specific humidity (eddies in PBL)" ;
+! TPERT: "Perturbation temperature (eddies in PBL)" ;
+
+! Surface
+! LANDFRAC: "Fraction of sfc area covered by land" ;
+! LANDM: "Land ocean transition mask: ocean (0), continent (1), transition (0-1)" ;
+! also LANDM_COSLAT
+! ICEFRAC: "Fraction of sfc area covered by sea-ice" ;
+! SGH: "Standard deviation of orography" ;
+! Z0FAC: "factor relating z0 to sdv of orography" ;
+! TS: "Surface temperature (radiative)" ;
+! TSOCN: "Ocean tempertare" ;
+! TSICE: "Ice temperature" ;
+! TSICERAD: "Radiatively equivalent ice temperature" ;
+
+! Land/under surface
+! SICTHK: "Sea ice thickness" ;
+! SNOWHICE: "Water equivalent snow depth" ;
+! TS1: "subsoil temperature" ;
+! TS2: "subsoil temperature" ;
+! TS3: "subsoil temperature" ;
+! TS4: "subsoil temperature" ;
+
+! Other fields are not included because they look more CLM oriented.
+
+! Other fields which users may add to the CAM initial files are not listed here.
+! Examples are EFGWORO, FRACLDV from the gravity wave drag parameterization study
+! and chemical species from WACCM and CAM-Chem.
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+use random_seq_mod, only : random_seq_type, init_random_seq, random_gaussian
+
+use ensemble_manager_mod, only : ensemble_type
+
+use distributed_state_mod, only : get_state, get_state_array
+
+use state_structure_mod, only : add_domain, get_model_variable_indices, get_dim_name, &
+ get_num_dims, get_domain_size, get_dart_vector_index, &
+ get_index_start, get_index_end
+
+use default_model_mod, only : adv_1step, init_time, init_conditions, nc_write_model_vars
+
+! end of use statements
+!= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+
+! CAM global/module declarations
+
+implicit none
+private
+
+! The first block are the 16 required interfaces. The following block
+! are additional useful interfaces that utility programs can call.
+public :: &
+ static_init_model, get_model_size, &
+ shortest_time_between_assimilations, &
+ pert_model_copies, get_state_meta_data, model_interpolate, &
+ nc_write_model_atts, nc_write_model_vars, &
+ init_conditions, init_time, adv_1step, end_model, &
+ get_close_obs, get_close_state, &
+ convert_vertical_obs, convert_vertical_state, &
+ query_vert_localization_coord, read_model_time, write_model_time
+
+public :: &
+ model_type, prog_var_to_vector, vector_to_prog_var, &
+ read_cam_init, &
+ init_model_instance, end_model_instance, write_cam_init, &
+ write_cam_times
+
+!-----------------------------------------------------------------------
+! 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$"
+!-----------------------------------------------------------------------
+
+integer :: component_id ! for add_domain.
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Global storage for describing cam model class
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+!-----------------------------------------------------------------------
+
+! A type for cam model.
+! Each variable will be allowed to have different dimensions, even different from
+! others of the same rank (i.e. 2d).
+! The maximum size for each dimension (for a given rank) will be used to allocate space
+! when a model_type variable is initialized.
+type model_type
+ private
+ real(r8), allocatable :: vars_0d(:)
+ real(r8), allocatable :: vars_1d(:, :)
+ real(r8), allocatable :: vars_2d(:, :, :)
+ real(r8), allocatable :: vars_3d(:, :, :, :)
+end type model_type
+
+!>@todo FIXME: this should be an i8 to handle really large
+!> state vectors, but that change ripples through several layers
+!> of code. nevertheless it should be done.
+integer :: model_size
+
+! This list of dimensions used to define fields will be ordered as they are on the caminput.nc file.
+integer :: num_dims
+integer, allocatable :: dim_sizes(:)
+character(len=NF90_MAX_NAME), allocatable :: dim_names(:)
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Grid fields
+! These structures are used by nc_write_model_atts.
+! They are dimensioned in create_grid_1d_instance and filled in read_cam_coord.
+
+! Should this whole type be allocatable, since scalars can be allocated?
+! No, not needed. Deallocating just the allocatable components is enough cleaning.
+
+type grid_1d_type
+ private
+ character(len=8) :: label = ''
+ integer :: dim_id = MISSING_I
+ integer :: length = MISSING_I
+ real(r8) :: resolution = MISSING_R8
+ real(r8), allocatable :: vals(:)
+ integer :: num_atts = MISSING_I
+ character(len=NF90_MAX_NAME), allocatable :: atts_names(:)
+ character(len=NF90_MAX_NAME), allocatable :: atts_vals(:)
+end type grid_1d_type
+
+integer, parameter :: no_lev = MISSING_I ! constant to tell get_val_level there are no levels.
+integer :: iii
+! integer :: grid_num_0d = 0 ! # of grid scalars to read from file
+! P0 now a "coordinate", and may be removed entirely
+! character(len=8),dimension(100) :: grid_names_0d = (/'P0',(' ',iii=1,100)/)
+
+integer :: grid_num_1d = 12 ! # of 1d grid fields to read from file
+character(len=8) :: grid_names_1d(100) = &
+ (/ 'lon ','lat ','lev ','gw ', &
+ 'hyam ','hybm ','hyai ','hybi ', &
+ 'slon ','slat ','ilev ','P0 ', &
+ (' ',iii=1,88 ) /)
+! These names should match the grid_names_1d to keep things clear.
+! All the possible coordinates (not dimensions) on the caminput.nc file.
+type(grid_1d_type), target :: lon ,lat ,lev ,gw ,hyam ,hybm ,hyai ,hybi, slon ,slat ,ilev, P0
+! "Any non-pointer sub-object of an object with the TARGET attribute also has the TARGET attribute."
+! So I can point to, e.g., lat%vals.
+
+! grid_2d_type ?
+! integer :: grid_num_2d = 0 ! # of 2d grid fields to read from file
+! ? should phis be in grid_names_2d?
+! character (len=8),dimension(100) :: grid_names_2d = (/(' ',iii=1,100)/)
+
+! CAM-chem
+! These lists were provided by Jerome Barre' and/or Avelino Arellano.
+! They implemented the unit conversion in subroutine read_cam_init in Lanai (and/or earlier DARTs).
+! The Manhattan implementation at the end of model_interpolate was by Kevin Raeder.
+! FIXME It would be better if the following 2 vectors were read from an external file....
+! If meteorological variables (including PRESSURE), or SURFACE_ELEVATION need to have
+! their units converted, their names and conversion factors could be entered in these lists.
+
+integer, parameter :: chemical_list=128
+! Names of chemical species.
+character(len=16) :: solsym(chemical_list) = &
+(/'O3 ','O ','O1D ','N2O ','NO ', &
+ 'NO2 ','NO3 ','HNO3 ','HO2NO2 ','N2O5 ', &
+ 'H2 ','OH ','HO2 ','H2O2 ','CH4 ', &
+ 'CO ','CH3O2 ','CH3OOH ','CH2O ','CH3OH ', &
+ 'C2H5OH ','C2H4 ','EO ','EO2 ','CH3COOH ', &
+ 'GLYALD ','C2H6 ','C2H5O2 ','C2H5OOH ','CH3CHO ', &
+ 'CH3CO3 ','CH3COOOH ','C3H6 ','C3H8 ','C3H7O2 ', &
+ 'C3H7OOH ','PO2 ','POOH ','CH3COCH3 ','RO2 ', &
+ 'ROOH ','BIGENE ','ENEO2 ','MEK ','MEKO2 ', &
+ 'MEKOOH ','BIGALK ','ALKO2 ','ALKOOH ','ISOP ', &
+ 'ISOPO2 ','ISOPOOH ','MVK ','MACR ','MACRO2 ', &
+ 'MACROOH ','MCO3 ','HYDRALD ','HYAC ','CH3COCHO ', &
+ 'XO2 ','XOOH ','C10H16 ','TERPO2 ','TERPOOH ', &
+ 'TOLUENE ','CRESOL ','TOLO2 ','TOLOOH ','XOH ', &
+ 'BIGALD ','GLYOXAL ','PAN ','ONIT ','MPAN ', &
+ 'ISOPNO3 ','ONITR ','SOA ','SO2 ','DMS ', &
+ 'NH3 ','NH4 ','NH4NO3 ','Rn ','Pb ', &
+ 'HCN ','CH3CN ','C2H2 ','HCOOH ','HOCH2OO ', &
+ 'H2SO4 ','SOAG ','so4_a1 ','pom_a1 ','soa_a1 ', &
+ 'bc_a1 ','dst_a1 ','ncl_a1 ','num_a1 ','so4_a2 ', &
+ 'soa_a2 ','ncl_a2 ','num_a2 ','dst_a3 ','ncl_a3 ', &
+ 'so4_a3 ','num_a3 ','CO01 ','CO02 ','CO03 ', &
+ 'CO04 ','CO05 ','CO06 ','CO07 ','CO08 ', &
+ 'CO09 ','CB1 ','CB2 ','OC1 ','OC2 ', &
+ 'CB101 ','CB201 ','OC101 ','OC201 ', &
+ 'CB102 ','CB202 ','OC102 ','OC202 ' &
+ /)
+
+! The molar mass of each chemical species
+real(r8) :: adv_mass(chemical_list) = &
+(/47.9982_r8, 15.9994_r8, 15.9994_r8, 44.01288_r8, 30.00614_r8, &
+ 46.00554_r8, 62.00494_r8, 63.01234_r8, 79.01174_r8, 108.01048_r8, &
+ 2.0148_r8, 17.0068_r8, 33.0062_r8, 34.0136_r8, 16.0406_r8, &
+ 28.0104_r8, 47.032_r8, 48.0394_r8, 30.0252_r8, 32.04_r8, &
+ 46.0658_r8, 28.0516_r8, 61.0578_r8, 77.0572_r8, 60.0504_r8, &
+ 60.0504_r8, 30.0664_r8, 61.0578_r8, 62.0652_r8, 44.051_r8, &
+ 75.0424_r8, 76.0498_r8, 42.0774_r8, 44.0922_r8, 75.0836_r8, &
+ 76.091_r8, 91.083_r8, 92.0904_r8, 58.0768_r8, 89.0682_r8, &
+ 90.0756_r8, 56.1032_r8, 105.1088_r8, 72.1026_r8, 103.094_r8, &
+ 104.1014_r8, 72.1438_r8, 103.1352_r8, 104.1426_r8, 68.1142_r8, &
+ 117.1198_r8, 118.1272_r8, 70.0878_r8, 70.0878_r8, 119.0934_r8, &
+ 120.1008_r8, 101.0792_r8, 100.113_r8, 74.0762_r8, 72.0614_r8, &
+ 149.1186_r8, 150.126_r8, 136.2284_r8, 185.234_r8, 186.2414_r8, &
+ 92.1362_r8, 108.1356_r8, 173.1406_r8, 174.148_r8, 190.1474_r8, &
+ 98.0982_r8, 58.0356_r8, 121.04794_r8, 119.07434_r8, 147.08474_r8, &
+ 162.11794_r8, 147.12594_r8, 144.132_r8, 64.0648_r8, 62.1324_r8, &
+ 17.02894_r8, 18.03634_r8, 80.04128_r8, 222.0_r8, 207.2_r8, &
+ 27.02514_r8, 41.05094_r8, 26.0368_r8, 46.0246_r8, 63.0314_r8, &
+ 98.0784_r8, 12.011_r8, 115.10734_r8, 12.011_r8, 12.011_r8, &
+ 12.011_r8, 135.064039_r8, 58.442468_r8, 1.0074_r8, 115.10734_r8, &
+ 12.011_r8, 58.442468_r8, 1.0074_r8, 135.064039_r8,58.442468_r8, &
+ 115.10734_r8, 1.0074_r8, 28.0104_r8, 28.0104_r8, 28.0104_r8, &
+ 28.0104_r8, 28.0104_r8, 28.0104_r8, 28.0104_r8, 28.0104_r8, &
+ 28.0104_r8, 12.011_r8, 12.011_r8, 12.011_r8, 12.011_r8, &
+ 12.011_r8, 12.011_r8, 12.011_r8, 12.011_r8, &
+ 12.011_r8, 12.011_r8, 12.011_r8, 12.011_r8 &
+/)
+
+! 2 unit conversion arrays derived from adv_mass will be filled in map_qtys.
+real(r8), parameter :: molar_mass_dry_air = 28.9644_r8
+
+! CAM-chem end
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Namelist variables with default values follow
+
+! Files where basic info about model configuration can be found
+character(len=128) :: &
+ model_config_file = 'caminput.nc', & ! An example cam initial file.
+ cam_phis = 'cam_phis.nc', & ! Separate source of PHIS/topography.
+ model_version = '6.0'
+
+
+! Define location restrictions on which observations are assimilated
+! (values are calculated anyway, but istatus is set to 2)
+! RMA-KR; This would be a good time to change 'log_invP' to 'scale_ht' or 'scaled_h?
+character(len=8) :: vert_coord = 'pressure' ! or 'log_invP'
+real(r8) :: max_obs_lat_degree = 90.0_r8
+real(r8) :: highest_obs_pressure_Pa = 1000.0_r8
+real(r8) :: highest_state_pressure_Pa = 9400.0_r8
+
+! Namelist variables and default values for defining state vector.
+
+integer :: state_num_0d = 0 ! # of scalars fields to read from file
+integer :: state_num_1d = 0 ! # of 1d fields to read from file
+integer :: state_num_2d = 0 ! # of 2d fields to read from file
+integer :: state_num_3d = 0 ! # of 3d fields to read from file
+
+! These can't be allocatable since they are namelist items.
+! They have to have a fixed size at compile time.
+! Large, arbitrary dimension could be avoided by reading in sizes from a first namelist,
+! allocating, setting default values, then get values from second namelist.
+! Or, allocate with defaults values, read in namelist, deallocate and reallocate.
+integer, parameter :: MAX_STATE_NAMES = 100
+character(len=8) :: state_names_0d(MAX_STATE_NAMES) = ' '
+character(len=8) :: state_names_1d(MAX_STATE_NAMES) = ' '
+character(len=8) :: state_names_2d(MAX_STATE_NAMES) = ' '
+character(len=8) :: state_names_3d(MAX_STATE_NAMES) = ' '
+
+! NOVERT
+! There's a danger of having a mismatch of which_vert_Xd with the state_names_Xd.
+! Should this definition be part of a new structure state_names_Xd, which is parsed
+! into a name and which_vert after being read? Not for now.
+
+integer :: which_vert_1d(MAX_STATE_NAMES) = MISSING_I
+integer :: which_vert_2d(MAX_STATE_NAMES) = MISSING_I
+integer :: which_vert_3d(MAX_STATE_NAMES) = MISSING_I
+
+
+! Is there a way to exclude state_nums from namelist and have those filled in
+! the subroutine which sorts state_names?
+! Yes, use two namelists model_nml_1 and model_nml_2 at future date.
+
+! List of fields which this code needs to perturb because they're
+! constant valued model parameters and show no spread when start_from_restart = .true.
+character(len=8) :: pert_names (MAX_STATE_NAMES) = ' '
+real(r8) :: pert_sd (MAX_STATE_NAMES) = MISSING_R8
+real(r8) :: pert_base_vals(MAX_STATE_NAMES) = MISSING_R8
+
+! Special for an experiment. Specify one string kind e.g QTY_CLOUD_LIQUID and
+! observations of that kind will only impact other obs and state vars of that
+! same kind. All other kinds of obs and state vars will not be impacted
+! by obs of this kind. A null string means behave as normal.
+character(len=obstypelength) :: impact_only_same_kind = ' '
+
+
+! Specify shortest time step that the model will support
+! This is limited below by CAMs fixed time step but is also impacted
+! by numerical stability concerns for repeated restarting in leapfrog.
+integer :: Time_step_seconds = 21600, Time_step_days = 0
+
+! set to .true. to get more details about the state vector and the
+! CAM fields and sizes in the init code.
+logical :: print_details = .false.
+
+
+namelist /model_nml/ vert_coord, model_version, cam_phis, &
+ state_num_0d, state_num_1d, state_num_2d, state_num_3d, &
+ state_names_0d, state_names_1d, state_names_2d, state_names_3d, &
+ which_vert_1d, which_vert_2d, which_vert_3d, &
+ pert_names, pert_sd, pert_base_vals, &
+ highest_obs_pressure_Pa, highest_state_pressure_Pa, &
+ max_obs_lat_degree, Time_step_seconds, Time_step_days, &
+ impact_only_same_kind, print_details, &
+ model_config_file
+
+!---- end of namelist (found in file input.nml) ----
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Derived parameters
+
+! make sure static init code only called once
+logical :: module_initialized = .false.
+
+! Variable to keep track of restricting chemistry observations.
+integer :: impact_kind_index = -1
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+type(time_type) :: Time_step_atmos
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Random sequence and init for pert_model_copies
+type(random_seq_type) :: random_seq
+integer :: ens_member = 0
+logical :: output_task0
+
+! common message string used by many subroutines
+character(len=512) :: string1, string2, string3
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+integer :: nflds ! # fields to read
+
+! f_dim_#d are the sizes of the coordinates of each variable as found on caminput file.
+! RMA-KR
+! s_dim_#d and s_dimid_#d are no longer needed, because this model mod is specialized
+! for a single CAM; dynamical core, coordinate orders in the initial file, etc.
+integer, allocatable :: f_dim_3d(:,:), f_dim_2d(:,:), f_dim_1d(:,:), &
+ f_dimid_3d(:,:), f_dimid_2d(:,:), f_dimid_1d(:,:)
+
+integer :: f_dim_max(4,3)
+
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Surface pressures, used by vertical interpolation routines.
+!
+! I assume that staggered grids (US and VS) are staggered only 1 direction (each),
+! so that surface pressure interpolations to get staggered ps use only 2 A-grid ps values.
+! The interpolations for columns of heights are more general, but will do a 2 point interp
+! if the staggering is only in one direction.
+
+! height
+! Surface potential; used for calculation of geometric heights.
+logical :: alloc_phis=.true. ! Flag whether to allocate space for phis
+real(r8), allocatable :: phis(:, :) ! surface geopotential
+
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! RMA-KR; cubed sphere (CAM-SE) section removed from here.
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+! Array 'cflds' is filled with simple loops over state_names_xxx.
+! I could replace that with code which orders namelist input field names
+! into cflds, regardless of their original order, and tallies how many of each.
+! Is there a way to exclude state_nums from namelist and have those filled in
+! the same subroutine?
+! RMA-KR; this may/will be replaced by the ${comp}_variables mechanism.
+
+character(len=8), allocatable :: cflds(:)
+
+! Attribute values for the fields which comprise the state vector.
+! These are filled by nc_read_model_atts.
+character(len=nf90_max_name), allocatable :: state_long_names(:)
+character(len=nf90_max_name), allocatable :: state_units(:)
+
+! Arrays for linking obs_qtys(QTY_) and model variable names are filled in map_qtys.
+! The max size of QTY_ should come from obs_kind_mod
+! These should be dimensioned the same size as the total of state_names_Nd.
+character(len=8) :: dart_to_cam_types(300) = ''
+integer :: cam_to_dart_qtys(300) = MISSING_I
+! Strategy; array elements are only changed for conversion factors that are != 1.0.
+! Then convert_mmr2vmr = MISSING_R8 triggers a convert_units of 1.0 in interp_lonlat.
+! So far, the conversion from obs units back to state units is no needed.
+! If it becomes needed:
+! 1) define array convert_vmr2mmr(MAX_STATE_NAMES) = MISSING_R8
+! 2) Add lines to function map_qtys similar to the convert_mmr2vmr lines:
+! convert_vmr2mmr(i) = 1.0_r8/convert_mmr2vmr(i)
+real(r8) :: convert_mmr2vmr(MAX_STATE_NAMES) = MISSING_R8
+
+!-----------------------------------------------------------------------
+! These are calculated from highest_obs_pressure_Pa
+integer :: highest_obs_level = MISSING_I
+real(r8) :: highest_obs_height_m = MISSING_R8
+! Better damping
+! Variables to deal with CAM's damping of the top levels of the model.
+! These are set in static_init_model and used in get_close_obs.
+real(r8) :: highest_state_scale_h = MISSING_R8
+real(r8) :: model_top = MISSING_R8
+real(r8) :: damp_wght = MISSING_R8
+type(location_type) :: highest_state_loc, model_top_loc
+
+!-----------------------------------------------------------------------
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+contains
+
+!#######################################################################
+
+! static_init_model section
+
+!-----------------------------------------------------------------------
+!>
+!> Static_init_model does many things which must be done once at the beginning
+!> of the use of model_mod:
+!> + set the calendar and time variables,
+!> + read, check and archive the model_nml namelist,
+!> + set some output level variables,
+!> + set the state vector size,
+!> + read coordinate variables from the CAM initial file,
+!> + read the model topography
+! No TYPE_s and SE code
+
+subroutine static_init_model()
+
+! Initializes class data for CAM model (all the stuff that needs to be done once).
+! For now, does this by reading info from a fixed name netcdf file.
+
+integer :: iunit, io, i, nc_file_ID
+integer :: max_levs
+real(r8), allocatable :: clampfield(:,:)
+! RMA-KR; clampfield added to assist restricting the range of some variable values.
+
+! only execute this code once
+if (module_initialized) return
+
+! Make sure we only come through here once.
+module_initialized = .true.
+
+! Register the module
+call register_module(source, revision, revdate)
+
+! setting calendar type
+! calendar types listed in time_manager_mod.f90
+! this information is NOT passed to CAM; it must be set in the CAM namelist
+call set_calendar_type('GREGORIAN')
+
+! Read the namelist entry
+call find_namelist_in_file("input.nml", "model_nml", iunit)
+read(iunit, nml = model_nml, iostat = io)
+call check_namelist_read(iunit, io, "model_nml")
+call verify_namelist()
+
+! Set the printed output logical variable to reduce printed output;
+output_task0 = do_output()
+
+! Record the namelist values
+if (do_nml_file()) write(nmlfileunit, nml=model_nml)
+if (do_nml_term()) write( * , nml=model_nml)
+
+! Set the model minimum time step from the namelist seconds and days input
+Time_step_atmos = set_time(Time_step_seconds, Time_step_days)
+if (print_details .and. output_task0) call print_time(Time_step_atmos)
+
+! Open CAM 'initial' file to read dimensions and coordinates of fields.
+call nc_check(nf90_open(path=trim(model_config_file), mode=nf90_nowrite, ncid=nc_file_ID), &
+ 'static_init_model', 'opening '//trim(model_config_file))
+
+! Get sizes of dimensions/coordinates from netcdf and put in global storage.
+call read_cam_init_size(nc_file_ID)
+
+! RMA-KR; model size is now calculated in state_structure_mod/get_domain_size
+
+! Allocate space for global coordinate arrays and read them in.
+! There's a query of caminput.nc within read_cam_coord for the existence of the field.
+! The second argument is a grid_1d_type structure
+call read_cam_coord(nc_file_ID, 'lon', lon)
+call read_cam_coord(nc_file_ID, 'lat', lat)
+call read_cam_coord(nc_file_ID, 'lev', lev)
+call read_cam_coord(nc_file_ID, 'ilev', ilev)
+call read_cam_coord(nc_file_ID, 'gw', gw)
+call read_cam_coord(nc_file_ID, 'slon', slon)
+call read_cam_coord(nc_file_ID, 'slat', slat)
+
+! read hybrid vert coord coefs
+call read_cam_coord(nc_file_ID, 'hyai', hyai)
+call read_cam_coord(nc_file_ID, 'hybi', hybi)
+call read_cam_coord(nc_file_ID, 'hyam', hyam)
+call read_cam_coord(nc_file_ID, 'hybm', hybm)
+
+! It's a scalar, but I can put it into the same coord structure as previous fields.
+! It's length will be 1
+call read_cam_coord(nc_file_ID, 'P0', P0) ! thats a p-zero
+
+!------------------------------------------------------------------------
+! Better damping algorithm for state variables near/in the CAM damped levels
+! at the top of the model.
+! See get_close_obs and models/cam/doc/highest_state_p_Pa.pptx for details.
+! This section must come after the definition of P0 and hyai.
+if (vert_coord == 'pressure') then
+ ! CAM's model_top is 1/2 level above the highest state variable level, so
+ ! hyai instead of hyam.
+ ! P0 is in Pa.
+ model_top = hyai%vals(1)*P0%vals(1)
+ ! The (lon,lat) here must match the ones in the definition of vert_only_loc in get_close_obs.
+ ! FIXME; is this hard-coding OK?
+ highest_state_loc = set_location(1.0_r8,1.0_r8,highest_state_pressure_Pa,VERTISPRESSURE)
+ model_top_loc = set_location(1.0_r8,1.0_r8,model_top, VERTISPRESSURE)
+ ! damp_wght must be in the same units (dist = radians) as the distances in get_close_obs.
+ if (highest_state_pressure_Pa /= model_top) then
+ damp_wght = 1.0_r8/get_dist(highest_state_loc,model_top_loc,no_vert=.false.)
+ endif
+else if (vert_coord == 'log_invP') then
+ highest_state_scale_h = scale_height(p_surface=P0%vals(1), p_above=highest_state_pressure_Pa)
+ model_top = scale_height(p_surface=P0%vals(1), p_above=(hyai%vals(1)*P0%vals(1)) )
+ highest_state_loc = set_location(1.0_r8,1.0_r8,highest_state_scale_h,VERTISSCALEHEIGHT)
+ model_top_loc = set_location(1.0_r8,1.0_r8,model_top, VERTISSCALEHEIGHT)
+ if (highest_state_scale_h /= model_top) then
+ damp_wght = 1.0_r8/get_dist(highest_state_loc,model_top_loc,no_vert=.false.)
+ endif
+else
+ write(string1, '(A,A)') 'Somehow vert_coord /= {pressure,log_invP}: ', vert_coord
+ call error_handler(E_ERR,'static_init_model',string1,source,revision,revdate)
+endif
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! # fields to read
+nflds = state_num_0d + state_num_1d + state_num_2d + state_num_3d
+if (print_details) then
+ write(string1, '(A,I3,A,4I3)') '# of fields in state vector = ', nflds, &
+ ' = sum of ', state_num_0d ,state_num_1d ,state_num_2d ,state_num_3d
+ call error_handler(E_MSG,'static_init_model',string1,source,revision,revdate)
+endif
+
+! Order the state vector parts into cflds.
+allocate(cflds(nflds))
+call order_state_fields()
+! Construct array of variables to be clamped - used in filter netcdf write not in write_cam_init
+allocate(clampfield(nflds, 2))
+call set_clamp_fields(clampfield)
+
+! Add a component to the state vector
+component_id = add_domain('caminput.nc', nflds, cflds, clamp_vals = clampfield)
+deallocate(clampfield)
+
+! Compute overall model size and put in global storage
+model_size = get_domain_size(component_id)
+if (output_task0) then
+ write(string1, '(A,I9)') 'CAM state vector size: ', model_size
+ call error_handler(E_MSG, 'static_init_model', string1)
+endif
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Get field attributes needed by nc_write_model_atts from caminput.nc.
+allocate(state_long_names(nflds), state_units(nflds))
+call nc_read_model_atts(nc_file_ID, 'long_name', state_long_names)
+call nc_read_model_atts(nc_file_ID, 'units', state_units)
+
+call nc_check(nf90_close(nc_file_ID), &
+ 'static_init_model', 'closing '//trim(model_config_file))
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! height
+! Get dimensions and surface geopotential from a new netcdf file and test for consistency.
+! Open file and read PHIS from it.
+! Allocate global variables which will be used in vertical interpolations
+! Check for pressures on vertically staggered grid, as well as standard grid.
+
+call read_cam_2Dreal(cam_phis, 'PHIS')
+
+max_levs = lev%length
+if (ilev%label /= '') max_levs = max(ilev%length, lev%length)
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! RMA-KR;
+! p_col is now a local variable, allocated when/where it's needed.
+! Fills arrays for the linking of obs_qtys (QTY_) to model field names
+call map_qtys()
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! If restricting impact of a particular kind to only obs and state vars
+! of the same kind, look up and set the kind index.
+! RMA-KR This will/may be replaced by Nancy's more general code for restricting
+! the influence of obs on listed variables.
+if (len_trim(impact_only_same_kind) > 0) then
+ impact_kind_index = get_index_for_quantity(impact_only_same_kind)
+endif
+
+! This validates the namelist value and sets the module global value highest_obs_level.
+call set_highest_obs_limit()
+
+end subroutine static_init_model
+
+!-----------------------------------------------------------------------
+
+subroutine verify_namelist()
+
+! FIXME; PS must always be in the state vector;
+! always add PS in to state vector (if missing)
+! In the future we may want to let people not update PS in filter, or ...?
+
+integer :: i
+logical :: ps_present = .false.
+logical :: mismatch_which = .false.
+logical :: mismatch_size = .false.
+
+if (state_num_0d > 0) then
+ if (state_names_0d(state_num_0d) == ' ' .or. &
+ state_names_0d(state_num_0d+1) /= ' ') mismatch_size = .true.
+endif
+
+if (state_num_1d > 0) then
+ if (state_names_1d(state_num_1d) == ' ' .or. &
+ state_names_1d(state_num_1d+1) /= ' ') mismatch_size = .true.
+ if ( which_vert_1d(state_num_1d) == MISSING_I .or. &
+ which_vert_1d(state_num_1d+1) /= MISSING_I) mismatch_which = .true.
+endif
+
+if (state_num_2d > 0) then
+ if (state_names_2d(state_num_2d) == ' ' .or. &
+ state_names_2d(state_num_2d+1) /= ' ') mismatch_size = .true.
+ if ( which_vert_2d(state_num_2d) == MISSING_I .or. &
+ which_vert_2d(state_num_2d+1) /= MISSING_I) mismatch_which = .true.
+endif
+
+if (state_num_3d > 0) then
+ if (state_names_3d(state_num_3d) == ' ' .or. &
+ state_names_3d(state_num_3d+1) /= ' ') mismatch_size = .true.
+ if ( which_vert_3d(state_num_3d) == MISSING_I .or. &
+ which_vert_3d(state_num_3d+1) /= MISSING_I) mismatch_which = .true.
+endif
+
+if (mismatch_size) then
+ write(string1,*) 'Mismatch between state_num_#d and state_names_#d in model_nml'
+ call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
+endif
+
+if (mismatch_which) then
+ write(string1,*) 'Mismatch between state_num_#d and which_vert_#d in model_nml'
+ call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
+endif
+
+mismatch_which = .false.
+do i=1,max(state_num_1d,state_num_2d,state_num_3d)
+ if (which_vert_1d(i) > 1 ) mismatch_which = .true.
+ if (which_vert_2d(i) > 1 ) mismatch_which = .true.
+ if (which_vert_3d(i) > 1 ) mismatch_which = .true.
+
+ ! PS can't be 0d or 3d.
+ if (state_names_1d(i) == 'PS') ps_present = .true.
+ if (state_names_2d(i) == 'PS') ps_present = .true.
+enddo
+
+if (mismatch_which) then
+ write(string1,*) 'The CAM model state is defined on levels and the surface. ', &
+ ' which_vert_#d must be -2, -1, or 1 for each state variable.'
+ call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
+endif
+
+
+if (.not. ps_present) then
+ write(string1,*) '"PS" (surface pressure) must be one of the state variables, but was not found'
+ call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
+endif
+
+if (vert_coord /= 'pressure' .and. vert_coord /= 'log_invP') then
+ write(string1,*) 'vert_coord must be "pressure" or "log_invP"'
+ call error_handler(E_ERR,'verify_namelist',string1,source,revision,revdate)
+endif
+
+end subroutine verify_namelist
+
+!-----------------------------------------------------------------------
+
+subroutine read_cam_init_size(nc_file_ID)
+
+! Gets the number, names, and sizes of field dimensions from a CAM init netcdf file
+! in file_name (regardless of dynamical core).
+! Called by static_init_model (only).
+
+integer, intent(in) :: nc_file_ID
+
+integer :: i,j
+
+if (.not. module_initialized) call static_init_model()
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! learn how many dimensions are defined in this file.
+call nc_check(nf90_inquire(nc_file_ID, num_dims), 'read_cam_init_size', 'inquire num_dims')
+
+allocate(dim_names(num_dims), dim_sizes(num_dims))
+
+! Cycle through dimension ids until there aren't any more.
+! dimension ids are sequential integers on the NetCDF file.
+do i = 1,num_dims
+ call nc_check(nf90_inquire_dimension(nc_file_ID, i, dim_names(i), dim_sizes(i)), &
+ 'read_cam_init_size', 'inquire for '//trim(dim_names(i)))
+ if (print_details .and. output_task0) then
+ write(string1,*) 'Dims info = ',i, trim(dim_names(i)), dim_sizes(i)
+ call error_handler(E_MSG, 'read_cam_init_size', string1,source,revision,revdate)
+ endif
+
+enddo
+
+! Find and store shapes of all the state vector fields. Grouped by rank of fields into
+! separate f_dim_RANKd arrays.
+call read_coord(nc_file_ID)
+
+
+! The arrays into which CAM fields are put are dimensioned by the largest values of
+! the sizes of the dimensions listed in Y_dim_RANKd, Y=[sf], RANK=[1-3] .
+! The second dimension denotes the rank of the array for which the first dim
+! gives the max size(s).
+if (state_num_1d > 0) then
+ f_dim_max(1:2, 1) = maxval(f_dim_1d, dim=2) ! gets the max value of f_dim_1d (1:2, :)
+else
+ f_dim_max(1:2, 1) = 0
+endif
+
+if (state_num_2d > 0) then
+ f_dim_max(1:3, 2) = maxval(f_dim_2d, dim=2) ! gets the max values of f_dim_2d (1:3, :)
+else
+ f_dim_max(1:3, 2) = 0
+endif
+
+if (state_num_3d > 0) then
+ f_dim_max(1:4, 3) = maxval(f_dim_3d, dim=2) ! gets the max values of f_dim_3d (1:4, :)
+else
+ f_dim_max(1:4, 3) = 0
+endif
+
+if (print_details .and. output_task0 ) then
+ if (state_num_1d > 0) then
+ write(string1,*) 'f_dim_1d = ',f_dim_1d
+ write(string2,*) (f_dim_max(i,1),i=1,3)
+ call error_handler(E_MSG, 'read_cam_init_size', string1,source,revision,revdate, text2=string2)
+ endif
+
+ do i=1,2
+ write(string1,*) 'f_dim_2d = ',(f_dim_2d(i,j),j=1,state_num_2d),'f_dim_max = ',f_dim_max(i,2)
+ call error_handler(E_MSG, 'read_cam_init_size', string1,source,revision,revdate)
+ enddo
+
+ do i=1,3
+ write(string1,'(A,(10I4))') 'f_dim_3d = ',(f_dim_3d(i,j),j=1,state_num_3d)
+ write(string2,'(A,(10I4))') 'f_dim_max = ',f_dim_max(i,3)
+ call error_handler(E_MSG, 'read_cam_init_size', string1,source,revision,revdate, text2=string2)
+ enddo
+endif
+
+end subroutine read_cam_init_size
+
+!-----------------------------------------------------------------------
+
+subroutine read_coord(nc_file_ID)
+
+! Figure out which coordinates are lon, lat, lev, based on CAM version
+! from the namelist, which has form #.#[.#[.#]].
+
+integer, intent(in) :: nc_file_ID
+
+! local workspace
+character(len=4) :: form_version = '(I0)'
+character(len=4) :: char_version
+integer :: part, nchars, tot_chars, i, j, k, varid, next
+integer :: int_version(4)
+
+int_version = (/ (0,i=1,4) /)
+
+! Choose order . . . no longer needed because this model_mod is specialized to
+! CAM-FV in CESM1.x and later.
+
+! Cycle through each field's dimension IDs.
+! Pick the dimensions needed out of dim_sizes, using the dimension names in dim_names.
+! Fill the state dimids according to the order model_mod wants to see. (lev, lon, lat).
+
+! 3D
+if (state_num_3d > 0) then
+ allocate(f_dim_3d(4,state_num_3d), f_dimid_3d(4,state_num_3d))
+ f_dim_3d = 0
+ f_dimid_3d = 0
+endif
+
+do i = 1,state_num_3d
+ ! Get variable id for a 3d field
+ call nc_check(nf90_inq_varid(nc_file_ID, state_names_3d(i), varid), &
+ 'trans_coord', 'inq_varid '//trim(state_names_3d(i)))
+ ! Get dimension ids for the dimensions of the field
+ call nc_check(nf90_inquire_variable(nc_file_ID, varid, dimids=f_dimid_3d(1:4,i)), &
+ 'trans_coord', 'inquire_variable'//trim(state_names_3d(i)))
+
+ Alldim3: do j = 1,4 ! time and 3 space
+ k = f_dimid_3d(j,i) ! shorthand; the dimid of this fields current dim
+ f_dim_3d(j,i) = dim_sizes(k)
+ enddo Alldim3
+
+ if ( f_dim_3d(1,i) == 0 .or. f_dim_3d(2,i) == 0 .or. f_dim_3d(3,i) == 0 ) then
+ call error_handler(E_ERR, 'trans_coord', &
+ 'num_[lons,lats,levs] was not assigned and = 0' , source, revision, revdate)
+ endif
+enddo
+
+! 2D
+if (state_num_2d > 0) then
+ allocate(f_dim_2d(3,state_num_2d), f_dimid_2d(3,state_num_2d))
+ f_dim_2d = 0; f_dimid_2d = 0;
+endif
+
+do i = 1,state_num_2d
+ call nc_check(nf90_inq_varid(nc_file_ID, state_names_2d(i), varid), &
+ 'trans_coord', 'inq_varid '//trim(state_names_2d(i)))
+ call nc_check(nf90_inquire_variable(nc_file_ID, varid, dimids=f_dimid_2d(1:3,i)), &
+ 'trans_coord', 'inquire_variable '//trim(state_names_2d(i)))
+
+ ! Extract spatial dimids from the fields dimids
+ Alldim2: do j = 1,3 ! time and 2 space
+ k = f_dimid_2d(j,i)
+ f_dim_2d(j,i) = dim_sizes(k)
+ enddo Alldim2
+ if ( f_dim_2d(1,i) == 0 .or. f_dim_2d(2,i) == 0 ) then
+ call error_handler(E_ERR, 'trans_coord', &
+ 'num_[lons,lats,levs] was not assigned and = 0' , source, revision, revdate)
+ endif
+enddo
+
+! 1D
+if (state_num_1d > 0) then
+ allocate(f_dim_1d(2,state_num_1d), f_dimid_1d(2,state_num_1d))
+ f_dim_1d = 0; f_dimid_1d = 0;
+endif
+
+do i = 1,state_num_1d
+ call nc_check(nf90_inq_varid (nc_file_ID, state_names_1d(i), varid), &
+ 'trans_coord', 'inq_varid '//trim(state_names_1d(i)))
+ call nc_check(nf90_inquire_variable(nc_file_ID, varid, dimids=f_dimid_1d(1:2,i)), &
+ 'trans_coord', 'inq_varid '//trim(state_names_1d(i)))
+
+ Alldim1: do j = 1,2 ! time and 1 space
+ k = f_dimid_1d(j,i)
+ f_dim_1d(j,i) = dim_sizes(k)
+ enddo Alldim1
+
+ if ( f_dim_1d(1, i) == 0 ) then
+ write(string1, '(A,I3,A)') ' state 1d dimension(',i,') was not assigned and = 0'
+ call error_handler(E_ERR, 'trans_coord',trim(string1), source, revision, revdate)
+ endif
+enddo
+
+end subroutine read_coord
+
+!-----------------------------------------------------------------------
+
+subroutine read_cam_2Dreal(file_name, cfield)
+
+! Subroutine to read in a 2D/horizontal CAM field, such as PHIS.
+! Handles both logically rectangular arrays (FV and Eul) and irregular
+! (SE-CAM/cubed-sphere).
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+character(len=*), intent(in) :: file_name
+character(len=*), intent(in) :: cfield
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+integer :: nc_file_ID, nc_var_ID ! NetCDF variables
+integer :: field_dim_IDs(3) ! Array of dimension IDs for cfield
+ ! (2 space (FV) and time dimension (CAM .h0. files).
+integer :: i_dim1, i_dim2 ! Variables to reference the dimension(s) of cfield
+integer :: num_dim1, num_dim2 ! NetCDF file variable dimension sizes, for comparison to file_name's
+integer :: slon_index, slat_index, lon_index, lat_index !indices of [s]lon and [s]lat
+ ! within the list of dimensions
+integer :: n,m
+character(len=NF90_MAX_NAME) :: name_dim1,name_dim2 ! Names of dimensions of cfield
+real(r8), allocatable :: var(:,:) ! Temp array used by nc_get_var
+
+field_dim_IDs = MISSING_I ! Array of dimension IDs for cfield
+
+if (file_name == cam_phis .and. .not.file_exist(trim(file_name))) then
+ write(string1,'(2A)') trim(file_name), &
+ ' is missing; trying to find a CAM history file (h0) to provide '//cfield
+ call error_handler(E_WARN, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
+endif
+
+! Open the file and get dimension information.
+if (file_exist(trim(file_name))) then
+ call nc_check(nf90_open(path=trim(file_name), mode=nf90_nowrite, ncid=nc_file_ID), &
+ 'static_init_model:read_cam_2Dreal', 'opening '//trim(file_name))
+ if (print_details .and. output_task0) then
+ write(string1, *) 'file_name for ',cfield,' is ', trim(file_name)
+ call error_handler(E_MSG, 'read_cam_2Dreal', string1,source,revision,revdate)
+ endif
+
+ ! get field id
+ call nc_check(nf90_inq_varid(nc_file_ID, trim(cfield), nc_var_ID), &
+ 'read_cam_2Dreal', 'inq_varid: '//cfield)
+
+ ! get dimension 'id's
+ call nc_check(nf90_inquire_variable(nc_file_ID, nc_var_ID, dimids = field_dim_IDs), &
+ 'read_cam_2Dreal', 'inquire_variable: '//cfield)
+
+ ! get dimension sizes
+ ! The first spatial dimension is always present.
+ call nc_check(nf90_inquire_dimension(nc_file_ID, field_dim_IDs(1), name_dim1, num_dim1 ), &
+ 'read_cam_2Dreal', 'inquire_dimension: '//name_dim1)
+ if (field_dim_IDs(2) == MISSING_I) then
+ num_dim2 = 1
+ name_dim2 = 'no2ndDim'
+ else
+ call nc_check(nf90_inquire_dimension(nc_file_ID, field_dim_IDs(2), name_dim2, num_dim2 ), &
+ 'read_cam_2Dreal', 'inquire_dimension: '//name_dim2)
+ endif
+
+ ! Check for consistent dimensions between initial file and cam_phis file.
+ if (file_name == cam_phis) then
+ i_dim1 = dim_sizes(find_name(name_dim1,dim_names))
+ if (num_dim1 /= i_dim1) then
+ write(string1,'(A,2I8,A)') 'i_dim1, num_dim1, name_dim1 =' ,&
+ i_dim1, num_dim1, trim(name_dim1)
+ call error_handler(E_MSG, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
+ write(string1,'(A,4I12)') 'horizontal dimensions mismatch of initial files and topog ' &
+ ,i_dim1, num_dim1
+ call error_handler(E_ERR, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
+ endif
+
+ if (field_dim_IDs(2) /= MISSING_I) then
+ i_dim2 = dim_sizes(find_name(name_dim2,dim_names))
+ if (num_dim2 /= i_dim2) then
+ write(string1,'(A,2I8,A)') 'i_dim2, num_dim2, name_dim2 =', &
+ i_dim2, num_dim2, trim(name_dim2)
+ call error_handler(E_MSG, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
+ write(string1,'(A,4I12)') 'horizontal dimensions mismatch of initial files and topog ', &
+ i_dim2, num_dim2
+ call error_handler(E_ERR, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
+ endif
+ endif
+ endif
+else
+ write(string1,'(2A)') trim(file_name), &
+ ' is missing; I do not know how to find it.'
+ call error_handler(E_ERR, 'read_cam_2Dreal', trim(string1), source, revision, revdate)
+endif
+
+! Allocate local arrays, based on size of this variable on the file.
+allocate(var(num_dim1, num_dim2))
+
+! Read surface geopotential from cam_phis for use in vertical interpolation in height.
+! Coordinate order not affected by CAM model version.
+call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, var, start=(/ 1, 1 /), &
+ count=(/ num_dim1, num_dim2 /)), 'read_cam_2Dreal', trim(cfield))
+
+! assign values to phis grids for use by the rest of the module.
+if (cfield == 'PHIS') then
+
+ if (alloc_phis) allocate(phis(num_dim1, num_dim2))
+ ! Don't want to set alloc_phis = false yet; there may be staggered phis to set.
+ phis(1:num_dim1,1:num_dim2) = var
+
+ ! If needed, generate phis on the staggered grids.
+ slon_index = find_name('slon',dim_names)
+ slat_index = find_name('slat',dim_names)
+ lat_index = find_name('lat',dim_names)
+ lon_index = find_name('lon',dim_names)
+
+ alloc_phis = .false.
+
+endif
+
+call nc_check(nf90_close(nc_file_ID), 'read_cam_2Dreal', 'closing '//trim(file_name))
+
+deallocate(var)
+
+end subroutine read_cam_2Dreal
+
+!-----------------------------------------------------------------------
+
+subroutine read_cam_2Dint(file_name, cfield, field, num_dim1, num_dim2)
+
+! Read 2d integer field from, e.g., HommeMapping.nc
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+character(len=*), intent(in) :: file_name
+character(len=*), intent(in) :: cfield
+integer, allocatable, intent(out) :: field(:,:)
+integer, intent(out) :: num_dim1 !The dimension(s) of cfield
+integer, intent(out) :: num_dim2
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+integer :: nc_file_ID, nc_var_ID !NetCDF variables
+integer :: field_dim_IDs(2) !Array of dimension IDs for cfield
+character(len=NF90_MAX_NAME) :: name_dim1,name_dim2 !Names of dimensions of cfield
+
+field_dim_IDs = MISSING_I !Array of dimension IDs for cfield
+
+if (file_exist(file_name)) then
+ call nc_check(nf90_open(path=trim(file_name), mode=nf90_nowrite, ncid=nc_file_ID), &
+ 'read_cam_2Dint', 'opening '//trim(file_name))
+ if (print_details .and. output_task0) then
+ write(string1,*) 'file_name for ',cfield,' is ', trim(file_name)
+ call error_handler(E_MSG, 'read_cam_2Dint', string1,source,revision,revdate)
+ endif
+
+ ! get field id
+ call nc_check(nf90_inq_varid(nc_file_ID, trim(cfield), nc_var_ID), &
+ 'read_cam_2Dint', 'inq_varid: '//cfield)
+
+ ! get dimension 'id's
+ call nc_check(nf90_inquire_variable(nc_file_ID, nc_var_ID, dimids=field_dim_IDs), &
+ 'read_cam_2Dint', 'inquire_variable: '//cfield)
+
+ ! get dimension sizes
+ ! The first spatial dimension is always present.
+ call nc_check(nf90_inquire_dimension(nc_file_ID, field_dim_IDs(1), name_dim1, num_dim1 ), &
+ 'read_cam_2Dint', 'inquire_dimension: '//name_dim1)
+ if (field_dim_IDs(2) /= MISSING_I) then
+ call nc_check(nf90_inquire_dimension(nc_file_ID, field_dim_IDs(2), name_dim2, num_dim2 ), &
+ 'read_cam_2Dint', 'inquire_dimension: '//name_dim2)
+ else
+ num_dim2 = 1
+ name_dim2 = 'no2ndDim'
+ endif
+
+ if (print_details .and. output_task0) then
+ write(string1,*) cfield,' dimensions num_dim1, num_dim2 = ',num_dim1, num_dim2
+ call error_handler(E_MSG, 'read_cam_2Dint', string1,source,revision,revdate)
+ endif
+else
+ write(string1,'(3A)') 'Required file "',trim(file_name),'" is missing.'
+ call error_handler(E_ERR, 'read_cam_2Dint', string1, source, revision, revdate)
+endif
+
+! Allocate array, based on size of this variable on the file.
+allocate(field(num_dim1,num_dim2))
+
+if (field_dim_IDs(2) /= MISSING_I) then
+ call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, field, start=(/ 1, 1 /), &
+ count=(/ num_dim1, num_dim2 /)), 'read_cam_2Dint', trim(cfield))
+else
+ call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, field), &
+ 'read_cam_2Dint', trim(cfield))
+endif
+
+call nc_check(nf90_close(nc_file_ID), 'read_cam_2Dint', 'closing '//trim(file_name))
+
+end subroutine read_cam_2Dint
+
+!-----------------------------------------------------------------------
+
+subroutine nc_read_model_atts(nc_file_ID, att, att_vals)
+
+! reads the value of an attribute for each of the fields in cflds.
+!
+! should be called with att = one of the attributes from the program variable
+! input file, which will be written to the Posterior and Prior.nc files
+
+integer, intent(in) :: nc_file_ID
+character(len=*), intent(in) :: att
+character(len=nf90_max_name), intent(out) :: att_vals(nflds)
+
+integer :: i, ierr
+integer :: nc_var_ID, att_type
+
+if (print_details .and. output_task0) then
+ write(string1,*) 'nc_read_model_atts: reading ',trim(att)
+ call error_handler(E_MSG, 'nc_read_model_atts', string1,source,revision,revdate)
+endif
+
+do i = 1,nflds
+ att_vals(i) = ' '
+ call nc_check(nf90_inq_varid(nc_file_ID, cflds(i), nc_var_ID), 'nc_read_model_atts', &
+ 'inq_varid '//trim(cflds(i)))
+
+ ierr = nf90_inquire_attribute(nc_file_ID, nc_var_ID, att)
+
+ if (ierr == nf90_noerr) then
+ call nc_check(nf90_get_att(nc_file_ID, nc_var_ID, att, att_vals(i)), &
+ 'nc_read_model_atts', 'get_att '//trim(att))
+ if (print_details .and. output_task0) then
+ write(string1,'(A,1X,I6,1X,A,1X,A)') att, nc_var_ID, cflds(i), trim(att_vals(i))
+ call error_handler(E_MSG, 'nc_read_model_atts', string1,source,revision,revdate)
+ endif
+ endif
+enddo
+
+end subroutine nc_read_model_atts
+
+!-----------------------------------------------------------------------
+
+subroutine nc_read_global_int_att(nc_file_ID, att, att_val)
+
+! Reads the value of a global attribute.
+
+integer, intent(in) :: nc_file_ID
+character(len=*), intent(in) :: att
+integer, intent(out) :: att_val
+
+integer :: ierr
+
+! NF90_GLOBAL is the psuedo-variable name used for global attributes.
+ierr = nf90_inquire_attribute(nc_file_ID, NF90_GLOBAL, att)
+
+if (ierr == nf90_noerr) then
+ call nc_check(nf90_get_att(nc_file_ID, NF90_GLOBAL, att, att_val), &
+ 'nc_read_global_int_att', 'get_att '//trim(att))
+ if (print_details .and. output_task0) then
+ write(string1,'(A,I5,2A, I6)') 'nc_read_global_int_att for file ',nc_file_ID, &
+ ' attribute and value = ',trim(att), att_val
+ call error_handler(E_MSG, 'nc_read_global_int_att', string1,source,revision,revdate)
+ endif
+endif
+
+end subroutine nc_read_global_int_att
+
+!-----------------------------------------------------------------------
+
+subroutine read_cam_coord(nc_file_ID, cfield, var)
+
+! read CAM 'initial' file coordinate, i.e. 'lat', 'lon', 'gw', 'hyai',...
+
+integer, intent(in) :: nc_file_ID
+character(len=*), intent(in) :: cfield
+type(grid_1d_type), intent(out) :: var
+
+integer :: i, coord_size ! grid/array indices
+integer :: nc_var_ID ! file and field IDs
+integer :: fld_exist ! grid field may not exist CAM initial file (e.g. slat)
+integer :: ncerr ! other nc errors; don't abort
+integer :: coord_dimid(1) ! Coordinates can have only 1 dimension,
+ ! but this must be a vector.
+
+! Some attributes are _Fillvalue (real) which I'll ignore for now.
+! The following are used to repack the attributes I want into a compact form
+integer :: num_atts, keep_atts
+integer :: att_type
+character(len=nf90_max_name) :: att_name
+character(len=nf90_max_name), allocatable :: att_names(:)
+character(len=nf90_max_name), allocatable :: att_vals(:)
+real(r8) :: resol, resol_1, resol_n
+
+! Moving this from the specification statement to here caused it to
+! be initialized every time read_cam_coord is called, and 'broke' it.
+! Previously, P0 may have ended up using the value left over from the last call,
+! which was for one of the initial file dimension variables, which was wrong,
+! but seems to have worked.
+coord_dimid = MISSING_I
+
+fld_exist = nf90_inq_varid(nc_file_ID, cfield, nc_var_ID)
+if (fld_exist /= nf90_noerr ) then
+ var%label = ' '
+ return
+endif
+
+ncerr = nf90_inquire_variable(nc_file_ID, nc_var_ID, dimids=coord_dimid, nAtts=num_atts)
+if (ncerr /= nf90_noerr ) then
+ write(string1,*) 'Variable ',cfield,' dimids = ',coord_dimid(1)
+ write(string2,*) 'NetCDF error code = ',nf90_strerror(ncerr)
+ call error_handler(E_MSG, 'read_cam_coord', string1,source,revision,revdate, text2=string2)
+ var%label = ' '
+ var%dim_id = 0
+ return
+endif
+
+if (print_details .and. output_task0) then
+ write(string1,*) 'After inquire_variable for ',cfield,' coord_dimid = ',coord_dimid(1)
+ call error_handler(E_MSG, 'read_cam_coord', string1,source,revision,revdate)
+endif
+
+if (coord_dimid(1) == MISSING_I) then
+ ! to handle P0
+ coord_size = 1
+ coord_dimid(1) = 0 ! This is the dimid for time, which has length 1,
+ ! But time is the record/unlimited dimension, so this may not work.
+else
+ coord_size = dim_sizes(coord_dimid(1))
+endif
+
+allocate(att_names(num_atts), att_vals(num_atts))
+
+keep_atts = 0
+do i=1,num_atts
+ call nc_check(nf90_inq_attname(nc_file_ID, nc_var_ID, i, att_name), &
+ 'read_cam_coord', 'inq_attname '//trim(att_name))
+
+! CAM FV initial files have coordinates with attributes that are numerical, not character
+! (_FillValue). These are not used because the coordinates are dimensioned exactly
+! the right size. I'll test for the type of att, and if it's not char, I'll ignore it.
+
+! Otherwise I need a var%atts_type and separate var%atts_vals_YYY for each NetCDF
+! external type (6 of them) I might run into.
+
+ call nc_check(nf90_inquire_attribute(nc_file_ID, nc_var_ID, att_name, xtype=att_type), &
+ 'read_cam_coord', 'inquire_attribute '//trim(att_name))
+
+ if (att_type == nf90_char) then
+ keep_atts = keep_atts + 1
+ att_vals(keep_atts) = ' '
+ att_names(keep_atts) = att_name
+ call nc_check(nf90_get_att(nc_file_ID, nc_var_ID, att_name, att_vals(keep_atts)), &
+ 'read_cam_coord', 'get_att '//trim(att_name) )
+
+ else
+ if (output_task0) then
+ write(string1,*) ' ignoring attribute ',trim(att_name), &
+ ' because it is not a character type'
+ call error_handler(E_MSG, 'read_cam_coord', string1,source,revision,revdate)
+ endif
+ endif
+enddo
+
+call create_grid_1d_instance(coord_size, keep_atts, var)
+
+! The rest of this routine populates 'var' with values.
+
+var%label = cfield
+var%dim_id = coord_dimid(1)
+
+do i = 1,keep_atts
+ var%atts_names(i) = att_names(i)
+ var%atts_vals(i) = att_vals(i)
+enddo
+
+call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, var%vals, start=(/ 1 /), count=(/ coord_size /)), &
+ 'read_cam_coord', 'get_var '//cfield)
+
+! Determine whether coordinate is regularly spaced,
+! If so, store the coordinate resolution in the grid_1d_type.
+if (cfield(1:2) == 'hy' .or. cfield(1:2) == 'P0') then
+ var%resolution = MISSING_R8
+else
+ resol_1 = var%vals(2) - var%vals(1)
+ if (resol_1 /= 0.0_r8) then
+ var%resolution = resol_1
+
+ ! Test all other coordinate spacings. If any of them differ from the first
+ ! by more than epsilon (smallest meaningful number relative to the coordinate spacings)
+ ! then spacing is irregular.
+ resol = 1.0_r8/resol_1
+ Res: do i = 3,coord_size
+ resol_n = var%vals(i) - var%vals(i-1)
+ if (((resol_n - resol_1) *resol) > epsilon(resol_n)) then
+ var%resolution = MISSING_R8
+ exit Res
+ endif
+ enddo Res
+ else
+ var%resolution = MISSING_R8
+ endif
+endif
+
+if (print_details .and. output_task0) then
+ write(string1,'(3A,I6,A,I8,A,1pE12.4)') 'reading ',cfield,' using id ',nc_var_ID, &
+ ' size ',coord_size,' resolution ', var%resolution
+ write(string2,*) 'first, last val: ', var%vals(1),var%vals(coord_size)
+ call error_handler(E_MSG, 'read_cam_coord', string1,source,revision,revdate, text2=string2)
+endif
+
+deallocate(att_names, att_vals)
+
+end subroutine read_cam_coord
+
+!-----------------------------------------------------------------------
+
+subroutine create_grid_1d_instance(length, num_atts, var)
+
+! Initializes an instance of a cam grid variable
+
+integer, intent(in ) :: length
+integer, intent(in ) :: num_atts
+type(grid_1d_type), intent(inout) :: var
+! Does 'var' need to have the TARGET attribute here?
+! Metcalf p 50 says 'yes'.
+! But Intel says that allocating an object gives it the target attribute:
+! "If an object does not have the TARGET attribute or has not been allocated
+! (using an ALLOCATE statement), no part of it can be accessed by a pointer."
+! And this has worked without specifying the 'target' attribute.
+
+! Initialize the storage space and return
+allocate(var%vals (length))
+allocate(var%atts_names(num_atts))
+allocate(var%atts_vals (num_atts))
+
+var%length = length
+var%num_atts = num_atts
+
+end subroutine create_grid_1d_instance
+
+!-----------------------------------------------------------------------
+
+subroutine end_grid_1d_instance(var)
+
+! Ends an instance of a cam grid_1d variable
+
+type(grid_1d_type), intent(inout) :: var
+
+if (var%label == ' ') return
+
+if (.not. allocated(var%vals)) then
+ write(string1,*) 'Calling end_grid_1d_instance on an uninitialized grid_1d_type'
+ call error_handler(E_ERR,'end_grid_1d_instance',string1, source, revision, revdate)
+endif
+
+deallocate(var%vals, var%atts_names, var%atts_vals)
+
+end subroutine end_grid_1d_instance
+
+!-----------------------------------------------------------------------
+
+subroutine order_state_fields()
+
+! Fills cflds with state_names for use in I/O of caminput.nc.
+
+integer :: i, i1, nfld
+
+nfld = 0
+
+! 0D fields
+do i=1,state_num_0d
+ nfld = nfld + 1
+ cflds(nfld)(:) = state_names_0d(i)
+enddo
+
+! 1D fields (1 spatial *coordinate* on the CAM initial file.
+! The field may have 2 *physical* spatial dimensions.
+do i=1,state_num_1d
+ nfld = nfld + 1
+ cflds(nfld)(:) = state_names_1d(i)
+enddo
+
+! 2D fields
+do i=1,state_num_2d
+ nfld = nfld + 1
+ cflds(nfld)(:) = state_names_2d(i)
+enddo
+
+! 3D fields (including q)
+do i=1,state_num_3d
+ nfld = nfld + 1
+ cflds(nfld)(:) = state_names_3d(i)
+enddo
+
+if (nfld /= nflds) then
+ write(string1, *) 'nfld = ',nfld,', nflds = ',nflds,' must be equal '
+ call error_handler(E_ERR, 'order_state_fields', string1, source, revision, revdate)
+endif
+
+if (output_task0) then
+ if (print_details) then
+ write(string1,'(A)') 'State vector is composed of these fields: '
+ call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
+ ! write(string1,'((8(A8,1X)))') (cflds(i),i=1,nflds)
+ do i=1,state_num_0d
+ write(string1,'(A,I4)') cflds(i)
+ call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
+ end do
+ i1 = state_num_0d
+ do i=1,state_num_1d
+ write(string1,'(A,I4)') cflds(i1+i)
+ call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
+ end do
+ i1 = i1 + state_num_1d
+ do i=1,state_num_2d
+ write(string1,'(A,I4)') cflds(i1+i)
+ call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
+ end do
+ i1 = i1 + state_num_2d
+ do i=1,state_num_3d
+ write(string1,'(A,I4)') cflds(i1+i)
+ call error_handler(E_MSG, 'order_state_fields', string1, source, revision, revdate)
+ end do
+ else
+ call error_handler(E_MSG, 'order_state_fields', 'State vector is composed of these fields: ')
+ do i = 1,nflds
+ call error_handler(E_MSG, 'order_state_fields', trim(cflds(i)))
+ enddo
+ endif
+endif
+
+end subroutine order_state_fields
+
+!-----------------------------------------------------------------------
+
+subroutine map_qtys()
+
+! ? Should this be a function instead; removes need to dimension obs_loc_in arbitrarily
+! and wastefully. But then it's called millions of times, instead of accessing a small
+! array that's defined once.
+
+! Makes an array of 'locations within the state vector' of the obs kinds
+! that come from obs_kind_mod, which we anticipate CAM's model_mod will need.
+! The obs kind that's needed will be the index into this array,
+! the corresponding value will be the name of that field.
+! This name will be used with find_name.
+! This subroutine will be called from static_init_model, so it will not have to be
+! recomputed for every ob.
+! Also maps the model variable names onto the DART QTY_s by the same mechanism.
+
+! other QTY_ possibilities are listed after the 'use obs_kind_mod' statement
+
+integer :: i
+
+! Physically 2D fields
+
+i = find_name('PS',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SURFACE_PRESSURE) = 'PS'
+ cam_to_dart_qtys(i) = QTY_SURFACE_PRESSURE
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('AEROD_v',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_AOD) = 'AEROD_v'
+ cam_to_dart_qtys(i) = QTY_AOD
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFCO',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFCO) = 'SFCO'
+ cam_to_dart_qtys(i) = QTY_SFCO
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFCO01',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFCO01) = 'SFCO01'
+ cam_to_dart_qtys(i) = QTY_SFCO01
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFCO02',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFCO02) = 'SFCO02'
+ cam_to_dart_qtys(i) = QTY_SFCO02
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFCO03',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFCO03) = 'SFCO03'
+ cam_to_dart_qtys(i) = QTY_SFCO03
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFOC1',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFOC1) = 'SFOC1'
+ cam_to_dart_qtys(i) = QTY_SFOC1
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFOC2',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFOC2) = 'SFOC2'
+ cam_to_dart_qtys(i) = QTY_SFOC2
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFCB1',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFCB1) = 'SFCB1'
+ cam_to_dart_qtys(i) = QTY_SFCB1
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFCB2',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFCB2) = 'SFCB2'
+ cam_to_dart_qtys(i) = QTY_SFCB2
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFOC102',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFOC102) = 'SFOC102'
+ cam_to_dart_qtys(i) = QTY_SFOC102
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFOC202',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFOC202) = 'SFOC202'
+ cam_to_dart_qtys(i) = QTY_SFOC202
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFCB102',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFCB102) = 'SFCB102'
+ cam_to_dart_qtys(i) = QTY_SFCB102
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('SFCB202',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SFCB202) = 'SFCB202'
+ cam_to_dart_qtys(i) = QTY_SFCB202
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('EFGWORO',cflds)
+if (i/= MISSING_I) then
+ dart_to_cam_types( QTY_GRAV_WAVE_DRAG_EFFIC) = 'EFGWORO'
+ cam_to_dart_qtys(i) = QTY_GRAV_WAVE_DRAG_EFFIC
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('FRACLDV',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_GRAV_WAVE_STRESS_FRACTION) = 'FRACLDV'
+ cam_to_dart_qtys(i) = QTY_GRAV_WAVE_STRESS_FRACTION
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+! dart_to_cam_types(QTY_SURFACE_TEMPERATURE ? ) = TYPE_TS
+! dart_to_cam_types(QTY_SEA_SURFACE_TEMPERATURE ? ) = TYPE_TSOCN
+! convert_mmr2vmr(i) = mmr2vmr(i)
+
+! Physically 3D fields
+i = find_name('T',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_TEMPERATURE) = 'T'
+ cam_to_dart_qtys(i) = QTY_TEMPERATURE
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('US',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_U_WIND_COMPONENT) = 'US'
+ cam_to_dart_qtys(i) = QTY_U_WIND_COMPONENT
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('VS',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_V_WIND_COMPONENT) = 'VS'
+ cam_to_dart_qtys(i) = QTY_V_WIND_COMPONENT
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('Q',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_SPECIFIC_HUMIDITY) = 'Q'
+ cam_to_dart_qtys(i) = QTY_SPECIFIC_HUMIDITY
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CLDLIQ',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CLOUD_LIQUID_WATER) = 'CLDLIQ'
+ cam_to_dart_qtys(i) = QTY_CLOUD_LIQUID_WATER
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CLDICE',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CLOUD_ICE) = 'CLDICE'
+ cam_to_dart_qtys(i) = QTY_CLOUD_ICE
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+! dart_to_cam_types(QTY_CLOUD_WATER ? ) = 'LCWAT'
+! cam_to_dart_qtys(i) = QTY_CLOUD_WATER ?
+! convert_mmr2vmr(i) = mmr2vmr(i)
+
+i = find_name('CO',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CO) = 'CO'
+ cam_to_dart_qtys(i) = QTY_CO
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CO01',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CO01) = 'CO01'
+ cam_to_dart_qtys(i) = QTY_CO01
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CO02',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CO02) = 'CO02'
+ cam_to_dart_qtys(i) = QTY_CO02
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CO03',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CO03) = 'CO03'
+ cam_to_dart_qtys(i) = QTY_CO03
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('OC1',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_OC1) = 'OC1'
+ cam_to_dart_qtys(i) = QTY_OC1
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('OC2',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_OC2) = 'OC2'
+ cam_to_dart_qtys(i) = QTY_OC2
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CB1',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CB1) = 'CB1'
+ cam_to_dart_qtys(i) = QTY_CB1
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CB2',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CB2) = 'CB2'
+ cam_to_dart_qtys(i) = QTY_CB2
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('OC102',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_OC102) = 'OC102'
+ cam_to_dart_qtys(i) = QTY_OC102
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('OC202',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_OC202) = 'OC202'
+ cam_to_dart_qtys(i) = QTY_OC202
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CB102',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CB102) = 'CB102'
+ cam_to_dart_qtys(i) = QTY_CB102
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CB202',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CB202) = 'CB202'
+ cam_to_dart_qtys(i) = QTY_CB202
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CO2',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CO2) = 'CO2'
+ cam_to_dart_qtys(i) = QTY_CO2
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('NO',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_NO) = 'NO'
+ cam_to_dart_qtys(i) = QTY_NO
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('NO2',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_NO2) = 'NO2'
+ cam_to_dart_qtys(i) = QTY_NO2
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('CH4',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_CH4) = 'CH4'
+ cam_to_dart_qtys(i) = QTY_CH4
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+i = find_name('NH3',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_NH3) = 'NH3'
+ cam_to_dart_qtys(i) = QTY_NH3
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+! i = find_name('O',cflds)
+! if (i /= MISSING_I) then
+! dart_to_cam_types( QTY_O) = 'O'
+! cam_to_dart_qtys(i) = QTY_O
+! endif
+
+i = find_name('O3',cflds)
+if (i /= MISSING_I) then
+ dart_to_cam_types( QTY_O3) = 'O3'
+ cam_to_dart_qtys(i) = QTY_O3
+ convert_mmr2vmr(i) = mmr2vmr(i)
+endif
+
+
+if (print_details .and. output_task0) then
+ write(string1,*) 'OBS_QTY FIELD_TYPE'
+ call error_handler(E_MSG, 'map_qtys', string1,source,revision,revdate)
+ do i=1,300
+ if (dart_to_cam_types(i) /= '') then
+ write(string1,'(I8,A)') i, dart_to_cam_types(i)
+ call error_handler(E_MSG, 'map_qtys', string1,source,revision,revdate)
+ end if
+ end do
+end if
+
+end subroutine map_qtys
+
+!-----------------------------------------------------------------------
+! CAM-chem 3))
+! Function to calculate the unit conversion factors, which make
+! estimated obs have units consistent with actual obs in model_interpolate.
+
+function mmr2vmr(var_index)
+
+integer, intent(in) :: var_index
+
+real(r8) :: mmr2vmr
+integer :: chem_index
+
+mmr2vmr = 1.0_r8
+do chem_index=1,chemical_list
+ if ( cflds(var_index) .eq. solsym(chem_index) ) then
+ mmr2vmr = molar_mass_dry_air/adv_mass(chem_index)
+ write(string1,'(2A,I4)') 'State field(= chemical name), mmr2vmr = ', &
+ solsym(chem_index), mmr2vmr
+ call error_handler(E_MSG, 'mmr2vmr', string1,source,revision,revdate)
+ exit
+ endif
+enddo
+
+end function mmr2vmr
+
+!-----------------------------------------------------------------------
+
+! End of static_init_model section
+!#######################################################################
+
+! Module I/O to/from DART and files
+
+!-----------------------------------------------------------------------
+
+subroutine read_cam_init(file_name, var, model_time)
+
+! Fill the model_type 'var' using fields from a CAM initial file.
+! Init_model_instance must be called before this subroutine.
+
+! CAM initial files are used instead of restart files for (at least) 6 reasons.
+! 1) The contents of the restart files vary depending on both the model release version
+! and the physics packages selected.
+! 2) There is no metadata on the restart files describing the variables.
+! Some information can be tracked down in the atm.log file, but not all of it.
+! 3) The restart files (for non-chemistry model versions) are much larger than the
+! initial files (and we need to deal with an ensemble of them).
+! 4) The temperature on the restart files is virtual equivalent potential temperature (?),
+! which requires (at least) surface pressure, specific humidity, and sensible temperature
+! to calculate.
+! 5) CAM does not call the initialization routines when restart files are used,
+! so fields which are not modified by DART may be inconsistent with fields which are.
+! 6) If DART modifies the contents of the .r. restart file, it might also need to
+! modify the contents of the .rs. restart file, which has similar characteristics
+! (1-3 above) to the .r. file.
+
+character(len=*), intent(in) :: file_name
+type(model_type), intent(inout) :: var
+type(time_type), intent(inout) :: model_time
+
+integer :: i, k, n, m, ifld
+integer :: nc_file_ID, nc_var_ID, dimid, varid, dimlen
+integer :: iyear, imonth, iday, ihour, imin, isec, rem
+integer :: timestep
+integer, allocatable :: datetmp(:), datesec(:)
+real(r8), allocatable :: temp_3d(:,:,:), temp_2d(:,:)
+
+! read CAM 'initial' file domain info
+call nc_check(nf90_open(path=file_name, mode=nf90_nowrite, ncid=nc_file_ID), &
+ 'read_cam_init', 'opening '//trim(file_name))
+
+! Read the time of the current state.
+! CAM initial files have two variables of length 'time' (the unlimited dimension): date, datesec
+! The rest of the routine presumes there is but one time in the file -
+
+call nc_check(nf90_inq_dimid(nc_file_ID, 'time', dimid), &
+ 'read_cam_init', 'inq_dimid time '//trim(file_name))
+call nc_check(nf90_inquire_dimension(nc_file_ID, dimid, len=dimlen), &
+ 'read_cam_init', 'inquire_dimension time '//trim(file_name))
+
+if (dimlen /= 1) then
+ write(string1,*)trim(file_name),' has',dimlen,'times. Require exactly 1.'
+ call error_handler(E_ERR, 'read_cam_init', string1, source, revision, revdate)
+endif
+
+allocate(datetmp(dimlen), datesec(dimlen))
+
+call nc_check(nf90_inq_varid(nc_file_ID, 'date', varid), &
+ 'read_cam_init', 'inq_varid date '//trim(file_name))
+call nc_check(nf90_get_var(nc_file_ID, varid, values=datetmp), &
+ 'read_cam_init', 'get_var date '//trim(file_name))
+
+call nc_check(nf90_inq_varid(nc_file_ID, 'datesec', varid), &
+ 'read_cam_init', 'inq_varid datesec '//trim(file_name))
+call nc_check(nf90_get_var(nc_file_ID, varid, values=datesec), &
+ 'read_cam_init', 'get_var datesec '//trim(file_name))
+
+! for future extensibility, presume we find a 'timeindex' that we want.
+! Since we only support 1 timestep in the file, this is easy.
+
+timestep = 1
+
+! The 'date' is YYYYMMDD ... datesec is 'current seconds of current day'
+iyear = datetmp(timestep) / 10000
+rem = datetmp(timestep) - iyear*10000
+imonth = rem / 100
+iday = rem - imonth*100
+
+ihour = datesec(timestep) / 3600
+rem = datesec(timestep) - ihour*3600
+imin = rem / 60
+isec = rem - imin*60
+
+deallocate(datetmp, datesec)
+
+! some cam files are from before the start of the gregorian calendar.
+! since these are 'arbitrary' years, just change the offset.
+
+if (iyear < 1601) then
+ write(string1,*)' '
+ write(string2,*)'WARNING - ',trim(file_name),' changing year from ',iyear,'to',iyear+1601
+ call error_handler(E_MSG, 'read_cam_init', string1, source, revision, &
+ revdate, text2=string2,text3='to make it a valid Gregorian date.')
+ write(string1,*)' '
+ call error_handler(E_MSG, 'read_cam_init', string1, source, revision)
+ iyear = iyear + 1601
+endif
+
+model_time = set_date(iyear,imonth,iday,ihour,imin,isec)
+
+if (output_task0) then
+ call print_date(model_time,' read_cam_init ... input date')
+ call print_time(model_time,' read_cam_init ... input time')
+ call print_date(model_time,' read_cam_init ... input date',logfileunit)
+ call print_time(model_time,' read_cam_init ... input time',logfileunit)
+endif
+
+! The temporary arrays into which fields are read are dimensioned by the largest values of
+! the sizes of the dimensions listed in f_dim_RANKd
+! f_dim_max contents assume that time is always the last dimension on NetCDF files,
+! so f_dim_max(4,3) and f_dim_max(3,2) are the non-spatial dimensions to ignore here.
+allocate(temp_3d(f_dim_max(1,3),f_dim_max(2,3),f_dim_max(3,3)), &
+ temp_2d(f_dim_max(1,2),f_dim_max(2,2)) )
+
+ifld = 0
+!0d fields; scalars are recognized and handled differently than vectors by NetCDF
+do i= 1, state_num_0d
+ ifld = ifld + 1
+ call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
+ 'read_cam_init', 'inq_varid '//trim(cflds(ifld)))
+ if (print_details .and. output_task0) then
+ write(string1,*) 'reading ',cflds(ifld),' using id ',nc_var_ID
+ call error_handler(E_ERR, 'read_cam_init', string1,source,revision,revdate)
+ endif
+
+ ! Fields on file are 1D; TIME(=1)
+ call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, var%vars_0d(i) ), &
+ 'read_cam_init', 'get_var '//trim(cflds(ifld)))
+enddo
+
+
+!1d fields
+do i= 1, state_num_1d
+ ifld = ifld + 1
+ call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
+ 'read_cam_init', 'inq_varid '//trim(cflds(ifld)))
+ if (print_details .and. output_task0) then
+ write(string1,*) 'reading ',cflds(ifld),' using id ',nc_var_ID
+ call error_handler(E_MSG, 'read_cam_init', string1,source,revision,revdate)
+ endif
+
+ ! s_dim_1d should = f_dim_1d
+ call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, var%vars_1d(1:f_dim_1d(1, i), i), &
+ start=(/ 1, timestep /), count=(/ f_dim_1d(1,i), 1/) ), &
+ 'read_cam_init', 'get_var '//trim(cflds(ifld)))
+enddo
+
+!2d fields on file are 3D; 2 spatial dimensions, then TIME(=1).
+do i= 1, state_num_2d
+ ifld = ifld + 1
+ call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
+ 'read_cam_init', 'inq_varid '//trim(cflds(ifld)))
+ if (print_details .and. output_task0) then
+ write(string1,*) 'reading ',cflds(ifld),' using id ',nc_var_ID
+ call error_handler(E_MSG, 'read_cam_init', string1,source,revision,revdate)
+ endif
+
+ ! Need to use temp_Nd; I am coding for not knowing what the 2 spatial dimensions of this field.
+ call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, temp_2d(1:f_dim_2d(1,i), 1:f_dim_2d(2,i)), &
+ start=(/ 1, 1, timestep/) ,count=(/ f_dim_2d(1,i), f_dim_2d(2,i), 1/) ), &
+ 'read_cam_init', 'get_var '//trim(cflds(ifld)))
+
+ var%vars_2d(1:f_dim_2d(1,i),1:f_dim_2d(2,i),i) = &
+ temp_2d(1:f_dim_2d(1,i),1:f_dim_2d(2,i))
+
+enddo
+
+! Spatially 3d fields on file are 4D; lon, lev, lat, TIME(=1)
+! or; lon, lat, lev, TIME
+do i=1, state_num_3d
+ ifld = ifld + 1
+ call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
+ 'read_cam_init', 'inq_varid '//trim(cflds(ifld)))
+ if (print_details .and. output_task0) then
+ write(string1,*) 'reading ',cflds(ifld),' using id ',nc_var_ID
+ call error_handler(E_MSG, 'read_cam_init', string1,source,revision,revdate)
+ endif
+
+ call nc_check(nf90_get_var(nc_file_ID, nc_var_ID, &
+ temp_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i)), start=(/ 1, 1, 1, timestep/), &
+ count=(/ f_dim_3d(1,i), f_dim_3d(2,i), f_dim_3d(3,i), 1 /) ), &
+ 'read_cam_init', 'get_var '//trim(cflds(ifld)))
+
+ var%vars_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i),i) = &
+ temp_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i))
+
+enddo
+
+call nc_check(nf90_close(nc_file_ID), 'read_cam_init', 'closing '//trim(file_name))
+
+deallocate(temp_3d,temp_2d)
+
+end subroutine read_cam_init
+
+!-----------------------------------------------------------------------
+
+subroutine write_cam_coord_def(nc_file_ID, c_name, coord, dim_id, c_id)
+
+integer, intent(in) :: nc_file_ID
+character(len=*), intent(in) :: c_name
+type(grid_1d_type), intent(in) :: coord
+integer, intent(in) :: dim_id
+integer, intent(out) :: c_id
+
+integer :: i
+
+call nc_check(nf90_def_var(nc_file_ID, name=c_name, xtype=nf90_double, dimids=dim_id, &
+ varid=c_id), 'write_cam_coord_def', 'def_var '//trim(c_name))
+
+do i=1,coord%num_atts
+ call nc_check(nf90_put_att(nc_file_ID, c_id, coord%atts_names(i), coord%atts_vals(i)), &
+ 'write_cam_coord_def', 'put_att '//trim(coord%atts_names(i)))
+enddo
+
+end subroutine write_cam_coord_def
+
+!-----------------------------------------------------------------------
+
+subroutine write_cam_init(file_name, model_time, var)
+
+! Write CAM 'initial' file fields (from var) that have been updated
+! to a CAM initial file.
+
+character(len=*), intent(in) :: file_name
+type(time_type), intent(in) :: model_time
+type(model_type), intent(inout) :: var
+
+type(time_type) :: CAM_time
+integer :: i, k, n, m, ifld
+integer :: nc_file_ID, nc_var_ID
+integer :: dimid, dimlen, varid
+integer :: iyear, imonth, iday, ihour, imin, isec, leftover
+integer :: itime, timeindex
+
+integer, allocatable :: datetmp(:), datesec(:)
+real(r8), allocatable :: temp_3d(:,:,:), temp_2d(:,:)
+
+if (.not. module_initialized) call static_init_model()
+
+call nc_check(nf90_open(path=trim(file_name), mode=nf90_write, ncid=nc_file_ID), &
+ 'write_cam_init', 'opening '//trim(file_name))
+
+! Need to figure out which timeslot to update in the CAM initial file.
+! It is not likely, but possible, that the initial file will have multiple
+! timesteps in it. We have to figure out which slot matches the DART model time.
+! the 'date' and 'datesec' variables contain the CAM state time.
+
+call nc_check(nf90_inq_dimid(nc_file_ID, 'time', dimid), &
+ 'write_cam_init', 'inq_dimid time '//trim(file_name))
+call nc_check(nf90_inquire_dimension(nc_file_ID, dimid, len=dimlen), &
+ 'write_cam_init', 'inquire_dimension time '//trim(file_name))
+
+if (dimlen /= 1) then
+ write(string1,*)'UNUSUAL - ',trim(file_name),' has',dimlen,'times. Expected 1.'
+ call error_handler(E_MSG, 'write_cam_init', string1, source, revision, revdate, &
+ text2='Searching for a matching time ...')
+endif
+
+allocate(datetmp(dimlen), datesec(dimlen))
+
+call nc_check(nf90_inq_varid(nc_file_ID, 'date', varid), &
+ 'write_cam_init', 'inq_varid date '//trim(file_name))
+call nc_check(nf90_get_var(nc_file_ID, varid, values=datetmp), &
+ 'write_cam_init', 'get_var date '//trim(file_name))
+
+call nc_check(nf90_inq_varid(nc_file_ID, 'datesec', varid), &
+ 'write_cam_init', 'inq_varid datesec '//trim(file_name))
+call nc_check(nf90_get_var(nc_file_ID, varid, values=datesec), &
+ 'write_cam_init', 'get_var datesec '//trim(file_name))
+
+timeindex = -1
+TIMELOOP: do itime = 1,dimlen
+
+ iyear = datetmp(itime)/10000
+ leftover = datetmp(itime) - iyear*10000
+ imonth = leftover/100
+ iday = leftover - imonth*100
+ ihour = datesec(itime)/3600
+ leftover = datesec(itime) - ihour*3600
+ imin = leftover/60
+ isec = leftover - imin*60
+
+ CAM_time = set_date(iyear, imonth, iday, ihour, imin, isec)
+
+ if (CAM_time == model_time) then
+ if (dimlen /= 1) then
+ write(string1,*)'Found matching time at index ',itime
+ call error_handler(E_MSG, 'write_cam_init', string1, source, revision, revdate)
+ endif
+
+ timeindex = itime
+ exit TIMELOOP
+ endif
+
+enddo TIMELOOP
+
+deallocate(datetmp, datesec)
+
+if (timeindex < 1) then
+
+ call get_date(model_time, iyear, imonth, iday, ihour, imin, isec)
+
+ write(string1,*)trim(file_name),' had no times that matched the model time.'
+ write(string2,*)'model_time (YYYY MM DD) is ',iyear, imonth, iday
+ write(string3,*)'model_time (SSSSS) is ',isec + imin*60 + ihour*3600
+ call error_handler(E_ERR, 'write_cam_init', string1, source, revision, revdate, &
+ text2=string2,text3=string3)
+endif
+
+! So now we know that the right timeslot is 'timeindex'.
+
+! The temporary arrays into which fields are read are dimensioned by the largest values of
+! the sizes of the dimensions listed in coord_RANKd
+allocate(temp_3d(f_dim_max(1,3),f_dim_max(2,3),f_dim_max(3,3)))
+allocate(temp_2d(f_dim_max(1,2),f_dim_max(2,2)))
+
+if (print_details .and. output_task0) then
+ write(string1,*) 'write_cam_init; f_dim_max(:2) = ',f_dim_max(1,2),f_dim_max(2,2)
+ call error_handler(E_MSG, 'write_cam_init', string1,source,revision,revdate)
+endif
+
+ifld = 0
+
+! 0d fields are first ... there is no concern about shape or dimensions
+do i = 1, state_num_0d
+ ifld = ifld + 1
+ call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
+ 'write_cam_init', 'inq_var '//trim(cflds(ifld)))
+ call nc_check(nf90_put_var(nc_file_ID, nc_var_ID, var%vars_0d(i) ), &
+ 'write_cam_init', 'put_var '//trim(cflds(ifld)))
+enddo
+
+! 1d fields
+do i = 1, state_num_1d
+ ! CS added this from 2d loop below.
+ ! special code: check and error out if the PS field has gone negative
+ if (state_names_1d(i) == 'PS') then
+ if (minval(var%vars_1d(:,i)) < 0.0_r8) then
+ write(string1, *)'PS has negative values; should not happen'
+ call error_handler(E_ERR, 'write_cam_init', string1, source, revision, revdate)
+ endif
+ endif
+ ifld = ifld + 1
+ call nc_check(nf90_inq_varid(nc_file_ID, cflds(ifld), nc_var_ID), &
+ 'write_cam_init', 'inq_var '//trim(cflds(ifld)))
+ call nc_check(nf90_put_var(nc_file_ID, nc_var_ID, var%vars_1d(1:f_dim_1d(1, i),i), &
+ start=(/ 1, timeindex /), count = (/ f_dim_1d(1, i), 1 /)), &
+ 'write_cam_init', 'put_var '//trim(cflds(ifld)))
+enddo
+
+do i = 1, state_num_2d
+ ! special code: check and error out if the PS field has gone negative
+ if (state_names_2d(i) == 'PS') then
+ if (minval(var%vars_2d(:,:,i)) < 0.0_r8) then
+ write(string1, *)'PS has negative values; should not happen'
+ call error_handler(E_ERR, 'write_cam_init', string1, source, revision, revdate)
+ endif
+ endif
+
+ ! 2d fields ; tricky because coordinates may have been rearranged.
+
+ temp_2d(1:f_dim_2d(1, i),1:f_dim_2d(2,i)) = &
+ var%vars_2d(1:f_dim_2d(1, i),1:f_dim_2d(2,i), i )
+
+ ifld = ifld + 1
+ call nc_check(nf90_inq_varid(nc_file_ID, trim(cflds(ifld)), nc_var_ID), &
+ 'write_cam_init','inq_varid '//trim(cflds(ifld)))
+ call nc_check(nf90_put_var(nc_file_ID, nc_var_ID, temp_2d(1:f_dim_2d(1, i),1:f_dim_2d(2,i)), &
+ start=(/ 1, 1, timeindex /), count = (/ f_dim_2d(1, i), f_dim_2d(2,i), 1/)), &
+ 'write_cam_init','put_var '//trim(cflds(ifld)))
+enddo
+
+do i = 1, state_num_3d
+ ! special code: set a minimum threshold for certain variables
+ if (state_names_3d(i) == 'Q') then
+ where (var%vars_3d(:,:,:,i) < 1.0e-12_r8) var%vars_3d(:,:,:,i) = 1.0e-12_r8
+ elseif (state_names_3d(i) == 'CLDLIQ' .or. &
+ state_names_3d(i) == 'CLDICE') then
+ where (var%vars_3d(:,:,:,i) < 0.0_r8) var%vars_3d(:,:,:,i) = 0.0_r8
+ elseif (state_names_3d(i) == 'T') then
+ if (minval(var%vars_3d(:,:,:,i)) < 0.0_r8) then
+ write(string1, *)'T has negative values; should not happen'
+ call error_handler(E_ERR, 'write_cam_init', string1, source, revision, revdate)
+ endif
+ endif
+
+ temp_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i)) = &
+ var%vars_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i),i)
+
+ ifld = ifld + 1
+ call nc_check(nf90_inq_varid(nc_file_ID, trim(cflds(ifld)), nc_var_ID), &
+ 'write_cam_init', 'inq_varid '//trim(cflds(ifld)))
+ call nc_check(nf90_put_var(nc_file_ID, nc_var_ID, &
+ temp_3d(1:f_dim_3d(1,i), 1:f_dim_3d(2,i), 1:f_dim_3d(3,i)), &
+ start=(/ 1, 1, 1, timeindex /), &
+ count=(/ f_dim_3d(1,i), f_dim_3d(2,i), f_dim_3d(3,i), 1/)), &
+ 'write_cam_init', 'put_var '//trim(cflds(ifld)))
+enddo
+
+call nc_check(nf90_close(nc_file_ID), 'write_cam_init', 'close cam initial file')
+
+deallocate(temp_3d, temp_2d)
+
+end subroutine write_cam_init
+
+!-----------------------------------------------------------------------
+
+subroutine write_cam_times(model_time, adv_time)
+! Not needed in CESM+DART framework
+
+! Writes model time and advance time into a file called 'times',
+! which is simply numbers. A script reads those and passes them to CAM's build-namelist.
+! -namelist "&camexp START_YMD=$times[3] START_TOD=$times[4]
+! STOP_YMD=$times[1] STOP_TOD=$times[2] NHTFRQ=$times[5] "
+! End time is first, then beginning time
+
+type(time_type), intent(in) :: model_time
+type(time_type), intent(in) :: adv_time
+
+integer :: tfile_unit, cam_date, cam_tod, nhtfrq
+integer :: year, month, day, hour, minute, second
+type(time_type) :: forecast_length
+
+if (.not. module_initialized) call static_init_model()
+
+! calculate number of hours in forecast, and pass to history tape
+! write frequency
+
+forecast_length = adv_time - model_time
+
+call get_time(forecast_length, second, day)
+
+hour = second/3600
+minute = mod(second,3600)
+if (minute/=0) &
+ call error_handler(E_ERR, 'write_cam_times', &
+ ' not integer number of hours; nhtfrq error', source, revision, revdate);
+
+! convert to hours, and negative to signal units are hours
+
+nhtfrq = -1*(day*24 + hour)
+
+
+tfile_unit = open_file("times", "formatted", "write")
+
+call get_date(adv_time, year, month, day, hour, minute, second)
+
+cam_date = year*10000 + month*100 + day
+cam_tod = hour*3600 + minute*60 + second
+
+write(tfile_unit,'(I8.8,1X,I8)') cam_date, cam_tod
+
+
+call get_date(model_time, year, month, day, hour, minute, second)
+
+cam_date = year*10000 + month*100 + day
+cam_tod = hour*3600 + minute*60 + second
+
+write(tfile_unit,'(I8.8,1X,I8)') cam_date, cam_tod
+
+write(tfile_unit,'(I8)') nhtfrq
+
+close(tfile_unit)
+
+
+end subroutine write_cam_times
+
+!-----------------------------------------------------------------------
+!>
+!> Subroutine get_state_meta_data
+!> Given an integer index into the state vector structure,
+!> returns the associated location and vertical location type 'which_vert'.
+!> Optionally returns the DART QTY of the variable.
+!>
+!> @param[in] index_in
+!> The 'index' of a variable in the state vector, whose physical location
+!> and possibly variable kind are needed,
+!>
+!> @param[inout] location
+!> The DART location_type location of the variable denoted by 'index'
+!>
+!> @param[out] var_kind
+!> The optional argument which can return the DART QTY of the variable.
+
+
+subroutine get_state_meta_data(index_in, location, var_kind)
+
+! Given an integer index into the state vector structure, returns the
+! associated location.
+! The location may have components that are MISSING_R8 values, since some fields
+! don't have locations in all three dimensions, i.e. PS has no vertical level,
+! and other fiendish fields to be devised by parameterization studies may not
+! have a longitude, or latitude. The which_vert should take care of the vertical
+! coordinate (it will be ignored), but the others will require more interesting fixes.
+! See order_state_fields for the QTY_s (and corresponding model variable names).
+
+integer(i8), intent(in) :: index_in
+type(location_type), intent(out) :: location
+integer, optional, intent(out) :: var_kind
+
+integer :: which_vert
+integer :: i, indx, index_1, index_2, index_3, nfld
+integer :: box, slice
+logical :: lfound
+
+real(r8) :: lon_val, lat_val, lev_val
+integer :: ip, jp, kp, dom_id
+integer :: ndims
+
+if (.not. module_initialized) call static_init_model()
+
+lon_val = MISSING_R8
+lat_val = MISSING_R8
+lev_val = MISSING_R8
+
+! get the state indices from dart index
+! RMA-KR; Will this work for cubed sphere or other 'unstructured' grids?
+! I think so; ip, jp, and kp are interpreted according to the dimension
+! name in the coord_val calls, next.
+call get_model_variable_indices(index_in, ip ,jp ,kp ,var_id=nfld, dom_id=dom_id)
+
+! convert to lat, lon, lev coordinates
+call coord_val(get_dim_name(dom_id,nfld,3), kp, lon_val, lat_val, lev_val)
+call coord_val(get_dim_name(dom_id,nfld,2), jp, lon_val, lat_val, lev_val)
+call coord_val(get_dim_name(dom_id,nfld,1), ip, lon_val, lat_val, lev_val)
+
+ndims = get_num_dims(dom_id, nfld)
+
+! RMA-KR; This will need to be changed for CAM-SE; 1d and 2d
+if( ndims == 2 ) then
+ which_vert = which_vert_2d(nfld)
+else
+ which_vert = which_vert_3d(nfld-state_num_2d)
+endif
+
+! This routine should error out for fields that have MISSING_R8 in lat_val or lon_val.
+if (lon_val == MISSING_R8 .or. lat_val == MISSING_R8 ) then
+ write(string1, *) 'Field ',cflds(nfld),' has no lon or lat dimension. ', &
+ 'What should be specified for it in the call to location?'
+ call error_handler(E_ERR, 'get_state_meta_data', string1, source, revision, revdate)
+else
+ location = set_location(lon_val, lat_val, lev_val, which_vert)
+endif
+
+! If the type is wanted, return it
+if (present(var_kind)) then
+ ! used by call from assim_tools_mod:filter_assim, which wants the DART QTY_
+ var_kind = cam_to_dart_qtys(nfld)
+endif
+
+end subroutine get_state_meta_data
+
+!-----------------------------------------------------------------------
+!>
+!> Function get_model_size assigns the 'model_size' calculated in static_init_model
+!> to the function result 'get_model_size'.
+
+function get_model_size()
+
+integer(i8) :: get_model_size
+
+if (.not. module_initialized) call static_init_model()
+
+get_model_size = model_size
+
+end function get_model_size
+
+!-----------------------------------------------------------------------
+!>
+!> Function shortest_time_between_assimilations assigns the 'Time_step_atmos' calculated in
+!> static_init_model to the function result 'shortest_time_between_assimilations'.
+
+function shortest_time_between_assimilations()
+
+! Returns the shortest time you want to ask the model to
+! advance in a single step
+
+type(time_type) :: shortest_time_between_assimilations
+
+if (.not. module_initialized) call static_init_model()
+
+shortest_time_between_assimilations = Time_step_atmos
+
+end function shortest_time_between_assimilations
+
+!-----------------------------------------------------------------------
+!>
+!> nc_write_model_atts
+!> writes the model-specific attributes to a netCDF file.
+!>
+!> @param[in] ncid
+!> netCDF file identifier
+!>
+!> @param[in] domain_id
+!> domain identifier (CAM has only 1 domain).
+
+subroutine nc_write_model_atts( ncid, domain_id )
+
+
+integer, intent(in) :: ncid ! netCDF file identifier
+integer, intent(in) :: domain_id
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+integer :: n_dims, n_vars, n_attribs, unlimited_dim_ID
+integer :: member_dim_ID, state_var_dim_ID, time_dim_ID,scalar_dim_ID
+integer :: x_var_ID,state_var_ID, state_var_var_ID
+! Add 1 to num_dims, for P0.
+! This hard-wiring should be replaced if more D0 'coordinates' are added.
+integer :: P_id(num_dims+1)
+integer :: i, ifld, dim_id, g_id
+integer :: grid_id(grid_num_1d)
+
+if (.not. module_initialized) call static_init_model()
+
+! Write Global Attributes
+
+call nc_redef(ncid)
+
+call nc_add_global_creation_time(ncid)
+
+call nc_add_global_attribute(ncid, "model_source", source)
+call nc_add_global_attribute(ncid, "model_revision", revision)
+call nc_add_global_attribute(ncid, "model_revdate", revdate)
+
+call nc_add_global_attribute(ncid, "model", "CAM")
+
+! Define the new dimensions IDs
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+! They have different dimids for this file than they had for caminput.nc
+! P_id serves as a map between the 2 sets.
+if (print_details .and. output_task0) then
+ write(string1,*) 'num_dims = ',num_dims
+ write(string2,*) ' dimens, name, size, cam dim_id, P[oste]rior id'
+ call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate, text2=string2)
+endif
+
+! P_id debug
+! This loops over the number of DIMENSIONS/COORDINATES on the file, not including P0.
+! So P_id needs to be defined for P0 after this loop.
+do i = 1,num_dims
+ if (trim(dim_names(i)) /= 'time') then
+ call nc_check(nf90_def_dim(ncid, name=trim(dim_names(i)), len=dim_sizes(i), &
+ dimid=P_id(i)), 'nc_write_model_atts','def_dim '//trim(dim_names(i)))
+ else
+ ! time, not P0
+ P_id(i) = 0
+ endif
+ if (print_details .and. output_task0) then
+ write(string1,'(I5,1X,A13,1X,2(I7,2X))') i,trim(dim_names(i)),dim_sizes(i), P_id(num_dims)
+ call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate)
+ endif
+enddo
+
+call nc_check(nf90_def_dim(ncid, name="scalar", len=1, dimid=scalar_dim_ID) &
+ ,'nc_write_model_atts', 'def_dim scalar')
+call nc_check(nf90_def_dim(ncid, name="P0", len=1, dimid=P_id(num_dims+1)) &
+ ,'nc_write_model_atts', 'def_dim scalar')
+if (print_details .and. output_task0) then
+ write(string1,'(I5,1X,A13,1X,2(I7,2X))') i,'P0',P0%length, P_id(i)
+ call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate)
+endif
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Create the (empty) Coordinate Variables and their attributes
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+! grid longitudes, latitudes, levels, and other coordinates.
+! grid_id() is filled here; it's the dimid of the desired coordinate *on this P_Diag.nc file*.
+! It's used to write coordinates. ! There's some overlap of names, unfortunately.
+! The argument after the 'xxx ' label is a structure with all the relevant info in it.
+! The structures are defined in "Grid fields" and filled by calls to create_grid_1d_instance
+! in read_cam_coord.
+
+grid_id = MISSING_I
+
+if (lon%label /= ' ') then
+ dim_id = P_id(lon%dim_id)
+ g_id = find_name('lon',grid_names_1d)
+ call write_cam_coord_def(ncid,'lon',lon , dim_id, grid_id(g_id))
+endif
+if (lat%label /= ' ') then
+ dim_id = P_id(lat%dim_id)
+ g_id = find_name('lat',grid_names_1d)
+ call write_cam_coord_def(ncid,'lat',lat , dim_id, grid_id(g_id))
+endif
+if (lev%label /= ' ') then
+ dim_id = P_id(lev%dim_id)
+ g_id = find_name('lev',grid_names_1d)
+ call write_cam_coord_def(ncid,'lev',lev , dim_id, grid_id(g_id))
+! Gaussian weights -- because they're there.
+endif
+if (gw%label /= ' ') then
+ dim_id = P_id(gw%dim_id)
+ g_id = find_name('gw',grid_names_1d)
+ call write_cam_coord_def(ncid,'gw',gw , dim_id, grid_id(g_id))
+! Hybrid grid level coefficients, parameters
+endif
+if (hyam%label /= ' ') then
+ dim_id = P_id(hyam%dim_id)
+ g_id = find_name('hyam',grid_names_1d)
+ call write_cam_coord_def(ncid,'hyam',hyam, dim_id, grid_id(g_id))
+endif
+if (hybm%label /= ' ') then
+ dim_id = P_id(hybm%dim_id)
+ g_id = find_name('hybm',grid_names_1d)
+ call write_cam_coord_def(ncid,'hybm',hybm, dim_id, grid_id(g_id))
+endif
+if (hyai%label /= ' ') then
+ dim_id = P_id(hyai%dim_id)
+ g_id = find_name('hyai',grid_names_1d)
+ call write_cam_coord_def(ncid,'hyai',hyai, dim_id, grid_id(g_id))
+endif
+if (hybi%label /= ' ') then
+ dim_id = P_id(hybi%dim_id)
+ g_id = find_name('hybi',grid_names_1d)
+ call write_cam_coord_def(ncid,'hybi',hybi, dim_id, grid_id(g_id))
+endif
+if (slon%label /= ' ') then
+ dim_id = P_id(slon%dim_id)
+ g_id = find_name('slon',grid_names_1d)
+ call write_cam_coord_def(ncid,'slon',slon, dim_id, grid_id(g_id))
+endif
+if (slat%label /= ' ') then
+ dim_id = P_id(slat%dim_id)
+ g_id = find_name('slat',grid_names_1d)
+ call write_cam_coord_def(ncid,'slat',slat, dim_id, grid_id(g_id))
+endif
+if (ilev%label /= ' ') then
+ dim_id = P_id(ilev%dim_id)
+ g_id = find_name('ilev',grid_names_1d)
+ call write_cam_coord_def(ncid,'ilev',ilev, dim_id, grid_id(g_id))
+endif
+if (P0%label /= ' ') then
+ dim_id = P_id(num_dims+1)
+ ! At some point, replace the kluge of putting P0 in with 'coordinates'
+ ! by defining grid_0d_kind, etc.
+ g_id = find_name('P0',grid_names_1d)
+ call write_cam_coord_def(ncid,'P0',P0 , dim_id, grid_id(g_id))
+endif
+
+if (print_details .and. output_task0) then
+ write(string1,*) '1d field#, grid_id, grid_names_1d'
+ call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate)
+ do i=1,grid_num_1d
+ write(string1,*) 'grid_ = ', i, grid_id(i), trim(grid_names_1d(i))
+ call error_handler(E_MSG, 'nc_write_model_atts', string1,source,revision,revdate)
+ enddo
+endif
+
+! Leave define mode so we can fill variables
+call nc_enddef(ncid)
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Fill the coordinate variables
+! Each 'vals' vector has been dimensioned to the right size for its coordinate.
+! The default values of 'start' and 'count' write out the whole thing.
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+if (lon%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('lon',grid_names_1d)), lon%vals) &
+ ,'nc_write_model_atts', 'put_var lon')
+if (lat%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('lat',grid_names_1d)), lat%vals) &
+ ,'nc_write_model_atts', 'put_var lat')
+if (lev%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('lev',grid_names_1d)), lev%vals) &
+ ,'nc_write_model_atts', 'put_var lev')
+if (gw%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('gw',grid_names_1d)), gw%vals) &
+ ,'nc_write_model_atts', 'put_var gw')
+if (hyam%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('hyam',grid_names_1d)), hyam%vals) &
+ ,'nc_write_model_atts', 'put_var hyam')
+if (hybm%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('hybm',grid_names_1d)), hybm%vals) &
+ ,'nc_write_model_atts', 'put_var hybm')
+if (hyai%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('hyai',grid_names_1d)), hyai%vals) &
+ ,'nc_write_model_atts', 'put_var hyai')
+if (hybi%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('hybi',grid_names_1d)), hybi%vals) &
+ ,'nc_write_model_atts', 'put_var hybi')
+if (slon%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('slon',grid_names_1d)), slon%vals) &
+ ,'nc_write_model_atts', 'put_var slon')
+if (slat%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('slat',grid_names_1d)), slat%vals) &
+ ,'nc_write_model_atts', 'put_var slat')
+if (ilev%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('ilev',grid_names_1d)), ilev%vals) &
+ ,'nc_write_model_atts', 'put_var ilev')
+if (P0%label /= ' ') &
+ call nc_check(nf90_put_var(ncid, grid_id(find_name('P0',grid_names_1d)), P0%vals) &
+ ,'nc_write_model_atts', 'put_var P0')
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Flush the buffer and leave netCDF file open
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+call nc_sync(ncid)
+
+end subroutine nc_write_model_atts
+
+! End of Module I/O
+
+!#######################################################################
+
+! model_interpolate section
+
+!-----------------------------------------------------------------------
+!>
+!> Subroutine model_interpolate
+!> Interpolates the provided state vector (on model grid points) to an arbitrary
+!> location in the atmosphere (e.g. where an observation is).
+!>
+!> @param[in] state_handle
+!> The DART ensemble_type structure which gives access to the ensemble of model states.
+!>
+!> @param[in] :: ens_size
+!> The size of the ensemble.
+!>
+!> @param[in] :: location
+!> The DART location_type 'location' of the desired state estimate.
+!>
+!> @param[in] :: obs_kind
+!> The DART QTY of the variable being estimated.
+!>
+!> @param[out] :: expected_obs
+!> The ensemble state estimate of the 'obs_kind' at 'location'.
+!>
+!> @param[out] :: istatus
+!> A flag to signal the success of the interpolation.
+
+
+subroutine model_interpolate(state_handle, ens_size, location, obs_kind, expected_obs, istatus)
+
+! This subroutine is now a short routine that calls
+! either a rectangular grid version for eul/FV
+! or non-rectangular for cubed-sphere code.
+! This does get QTYs from filter, not specific obs TYPEs.
+
+! Model_interpolate must return a positive value for istatus for a failure.
+! 0 means success, negative values are reserved for DART internal use.
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location ! The DART location_type 'location' of the desired state estimate.
+integer, intent(in) :: obs_kind ! The DART QTY of the variable being estimated.
+real(r8), intent(out) :: expected_obs(ens_size) ! The state estimate of the 'obs_kind' at 'location'
+integer, intent(out) :: istatus(ens_size) ! A flag to signal the success of the interpolation.
+
+! FIXME; In future DARTs it may be useful to return the DART QTY too.
+! also convert to a field name (DART subroutine (get_raw_...?)).
+
+if (.not. module_initialized) call static_init_model()
+
+! FIXME; Tim test for ob being out of bounds (horizontally, vertically?)
+! and return if it is.
+! But interp_yyy might need to be called anyway (in the future), to get the value,
+! even if it won't be assimilated.
+! Also, lat bounds could be enforced here with a small amount of code,
+! but enforcing vertical bounds would require bringing lots of code from interp_yyy up here,
+! and have if-tests to separate out the lonlat from the cubed_sphere.
+
+! FIXME; Tim Also add an argument to inter_XXX to tell it what to do when the ob
+! is out of bounds, but still calculatable.
+
+call interp_lonlat(state_handle, ens_size, location, obs_kind, expected_obs, istatus)
+
+end subroutine model_interpolate
+
+!-----------------------------------------------------------------------
+
+recursive subroutine interp_lonlat(state_handle, ens_size, obs_loc, obs_kind, interp_val, istatus)
+
+! Find the 4 corners of the lon-lat grid cell that encloses an ob at 'obs_loc'
+! and interpolate the values of obs_kind to that location.
+
+! istatus meaning return expected obs? assimilate?
+! 0 obs and model are fine; yes yes
+! 1 fatal problem; no no
+! 2 exclude valid obs yes no (ob > ! highest_obs_X)
+! 3 unfamiliar obs type no no
+! 4 ob excl by namelist(lat) yes no
+! NM 2 digit number means more than one namelist reason to exclude from assim.
+
+! Any value > 0 will not be assimilated (---> QC non-0).
+! Do we want some istatus values to tell filter to evaluate (---> QC of 1)?
+! That would be nice, but filter has no convention for understanding non-0
+! values from model_mod (from all the available models). So all non-0 values of
+! istatus ---> QC = 4.
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: obs_loc
+integer, intent(in) :: obs_kind
+real(r8), intent(out) :: interp_val(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+! FIXME; In future DARTs it may be useful to return the DART QTY too.
+! also convert to a field name (DART subroutine (get_raw_...?)).
+
+integer :: i, vstatus(ens_size), cur_vstatus(ens_size)
+real(r8) :: bot_lon, top_lon, delta_lon, &
+ lon_below, lat_below, lat_above, lev_below, &
+ lon_fract, lat_fract, temp_lon, a(ens_size, 2), &
+ lon_lat_lev(3), convert_units
+real(r8), dimension(ens_size) :: val_11, val_12, val_21, val_22
+
+! FIXME: Positions within the rank 2 and 3 fields. I don't remember the issue...
+integer :: s_type, s_type_01d,s_type_2d,s_type_3d, &
+ lon_ind_below, lon_ind_above, lat_ind_below, lat_ind_above, &
+ num_lons
+character(len=8) :: lon_name, lat_name, lev_name
+
+! FIXME; idea of right number of dimensions for each field...
+! These are observations and will have 2d or 3d locations, but the
+! corresponding state-vector component could be missing one of the dimensions.
+! Surface pressure is the obvious example, but parameterization tuning might
+! introduce others.
+! Such artificial fields would not have observations associated with them.
+! So assume that observed fields are not missing any dimensions.
+
+! Start with failure, then change as warranted.
+istatus(:) = 1
+cur_vstatus(:) = 1
+vstatus(:) = 0 ! Assume good so you can keep track of vstatus
+val_11(:) = MISSING_R8
+val_12(:) = MISSING_R8
+val_21(:) = MISSING_R8
+val_22(:) = MISSING_R8
+interp_val(:) = MISSING_R8
+! Get the observation (horizontal) position, in degrees
+lon_lat_lev = get_location(obs_loc)
+
+! Check whether model_mod can interpolate the requested variable.
+! Pressure (3d) can't be specified as a state vector field (so s_type will = MISSING_I),
+! but can be calculated for CAM, so obs_kind = QTY_PRESSURE is acceptable.
+! obs_kind truly is a DART QTY variable, generally passed from
+! obs_def/obs_def_XXX.f90: call interpolate.
+! HK I think s_type is the index in cflds
+! RMA-KR; use a new mechanism to define s_type (as in 'clm_variables')
+! > > > Just loop through cflds until I find it.
+! Need the state_name of this obs_kind
+! CLM uses obs_kind. Is there a 1 to 1 match of CAM variables and DART QTYs?
+! > > >It requires hard-wiring all of the potential QTYs in the 'select case (obs_kind)' structure.
+! Could still have dart_to_cam?
+! Does paradigm of separating vars into 0d, 1d, 2d, and 3d make sense?
+s_type = find_name(dart_to_cam_types(obs_kind),cflds)
+
+if (s_type == MISSING_I) then
+ if (obs_kind /= QTY_PRESSURE .and. obs_kind /= QTY_SURFACE_ELEVATION) then
+ write(string1,*) 'Wrong type of obs = ', obs_kind
+ call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate)
+ return
+ else
+ ! CAM-chem 5))
+ ! This will be used when interp_val is calculated,
+ ! but define it here, as soon as it can be.
+ ! Define for the non-chemical, non-state QTYs.
+ convert_units = 1.0_r8
+ endif
+else
+ ! CAM-chem Define it here for state variables
+ convert_units = convert_mmr2vmr(s_type)
+endif
+
+! Get lon and lat dimension names.
+
+! Set [lon,lat,lev] names to a default, which will be overwritten for variables
+! in the state vector, but not for other acceptable variables (3D pressure, surface
+! elevation, ...?)
+lon_name = 'lon'
+lat_name = 'lat'
+if (obs_kind == QTY_SURFACE_ELEVATION) then
+ lev_name = 'none'
+elseif (obs_kind == QTY_PRESSURE) then
+ lev_name = 'lev'
+! else
+! set below
+endif
+
+! Need to get lon, lat, lev dimension names for this field
+
+
+! DART can't handle any 0d or 1d ob fields, so lump them together for elimination in this search.
+s_type_01d = state_num_0d + state_num_1d
+s_type_2d = s_type - s_type_01d
+s_type_3d = s_type_2d - state_num_2d
+
+! HK This if statement is just finding the rank of the variable (0D, 1D, 2D, 3D).
+if (s_type == MISSING_I .and. &
+ (obs_kind == QTY_PRESSURE) .or. (obs_kind == QTY_SURFACE_ELEVATION)) then
+ ! use defaults lon_name and lat_name set above
+elseif (s_type <= state_num_0d + state_num_1d) then
+ ! error; can't deal with observed variables that are 0 or 1D in model_mod.
+! istatus = 1
+! interp_val = MISSING_R8
+ write(string1,*) 'DART cannot handle 0d or 1d observations of ', cflds(s_type), &
+ ' because DART requires a (lon,lat) location for each observation '
+ write(string2,*) 'Skipping this observation'
+ call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate, text2=string2)
+ return
+elseif (s_type_2d > 0 .and. s_type_2d <= state_num_2d) then
+ lon_name = get_lon_name(s_type)
+ lat_name = get_lat_name(s_type)
+ lev_name = 'none'
+elseif (s_type_3d > 0 .and. s_type_3d <= state_num_3d) then
+ lon_name = get_lon_name(s_type)
+ lat_name = get_lat_name(s_type)
+ lev_name = get_lev_name(s_type)
+else
+! istatus = 1
+! interp_val = MISSING_R8
+ write(string1,*) 'Unexpected state type value, s_type = ', s_type
+ call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate)
+ return
+endif
+
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! staggered longitudes; slon (4x5 fv grid) = [-2.5, 2.5,...,352.5] !
+! lon ( " ) = [ 0., 5.,..., 355.]
+! This is a complication for lon = 359, for example. It's not in the range of slon.
+! coord_index handles it.
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+! Compute bracketing lon indices
+! Define a local longitude to deal with CAM-FV's staggered, longitude grid.
+temp_lon = lon_lat_lev(1)
+
+if (lon_name == 'lon') then
+ num_lons = lon%length
+ bot_lon = lon%vals(1)
+ top_lon = lon%vals(num_lons)
+ delta_lon = lon%vals(2) - lon%vals(1)
+elseif (lon_name == 'slon') then
+ num_lons = slon%length
+ bot_lon = slon%vals(1)
+ top_lon = slon%vals(num_lons)
+ delta_lon = slon%vals(2) - slon%vals(1)
+ ! Make certain longitudes conform to the CAM staggered grid.
+ if ((lon_lat_lev(1) - top_lon) >= delta_lon) temp_lon = lon_lat_lev(1) - 360.0_r8
+endif
+
+if (temp_lon >= bot_lon .and. temp_lon < top_lon) then
+ ! adding the 1 makes up for subtracting the bot_lon.
+ lon_ind_below = int((temp_lon - bot_lon) / delta_lon) + 1
+ lon_ind_above = lon_ind_below + 1
+ lon_fract = (temp_lon - ((lon_ind_below - 1) * delta_lon + bot_lon)) / delta_lon
+else
+ ! At wraparound point
+ lon_ind_above = 1
+ lon_ind_below = num_lons
+ lon_fract = (temp_lon - top_lon) / delta_lon
+endif
+
+
+! Next, compute neighboring lat rows
+! NEED TO BE VERY CAREFUL ABOUT POLES; WHAT'S BEING DONE MAY BE WRONG
+! Inefficient search used for latitudes in Gaussian grid. Might want to speed up.
+! CAM-FV; lat = -90., ... ,90.
+! slat = -88.,...,88.
+
+call coord_index(lat_name, lon_lat_lev(2), lat_ind_above, lat_ind_below)
+
+! FIXME; maybe move this into coord_index
+! Probably not; coord_index sometimes returns the single closest index,
+! which will always be the first index returned.
+! I suppose there could be a flag argument telling coord_index
+! whether to return 1 or a pair, with the 2nd index always > first
+! (or vice versa).
+! calculate and return fraction too?
+if (lat_ind_above == lat_ind_below) then
+ if (lat_ind_above == 1) then
+ lat_fract = 0.0_r8
+ else !both must be equal to the max (s)lat index
+ lat_fract = 1.0_r8
+ endif
+else
+ if (lat_ind_above < lat_ind_below) then
+ ! switch order
+ i = lat_ind_above
+ lat_ind_above = lat_ind_below
+ lat_ind_below = i
+ endif
+ ! only lat_xxx is changed by these calls
+ call coord_val(lat_name, lat_ind_below, lon_below, lat_below, lev_below)
+ call coord_val(lat_name, lat_ind_above, lon_below, lat_above, lev_below)
+ lat_fract = (lon_lat_lev(2) - lat_below) / (lat_above - lat_below)
+endif
+
+! Find the values for the four corners
+
+! Determine the vertical coordinate: model level, pressure, or height
+if (obs_kind == QTY_SURFACE_ELEVATION) then
+ ! Acceptable field that's not in the state vector, same across the ensemble
+ ! convert from geopotential height to real height in meters
+ val_11(:) = phis(lon_ind_below, lat_ind_below) / gravity_const
+ val_12(:) = phis(lon_ind_below, lat_ind_above) / gravity_const
+ val_21(:) = phis(lon_ind_above, lat_ind_below) / gravity_const
+ val_22(:) = phis(lon_ind_above, lat_ind_above) / gravity_const
+ if (val_11(1) == MISSING_R8 .or. &
+ val_12(1) == MISSING_R8 .or. &
+ val_21(1) == MISSING_R8 .or. &
+ val_22(1) == MISSING_R8 ) then
+ vstatus(:) = 1
+ write(string1,*) 'interp_lonlat: val_##(mem1) = MISSING_R* for ',&
+ 'lon, lat near ',lon_ind_above, lat_ind_above
+ call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate)
+ endif
+
+elseif (is_vertical(obs_loc, "LEVEL")) then
+ ! Pobs
+ ! FIXME; I may want to change get_val_level to accept REAL level, not INT.
+ ! What's the benefit?
+ ! But it would be inconsistent with lon_ and lat_ indices,
+ ! and I'd have to create an integer level anyway.
+ ! May also want to handle staggered vertical grid (ilev).
+ call get_val_level(state_handle, ens_size, lon_ind_below, lat_ind_below, nint(lon_lat_lev(3)), obs_kind, val_11, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_level(state_handle, ens_size, lon_ind_below, lat_ind_above, nint(lon_lat_lev(3)), obs_kind, val_12, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_level(state_handle, ens_size, lon_ind_above, lat_ind_below, nint(lon_lat_lev(3)), obs_kind, val_21, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_level(state_handle, ens_size, lon_ind_above, lat_ind_above, nint(lon_lat_lev(3)), obs_kind, val_22, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+
+
+elseif (is_vertical(obs_loc, "PRESSURE")) then
+ call get_val_pressure(state_handle, ens_size,lon_ind_below,lat_ind_below,lon_lat_lev(3),obs_kind,val_11,cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_pressure(state_handle, ens_size,lon_ind_below,lat_ind_above,lon_lat_lev(3),obs_kind,val_12,cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_pressure(state_handle, ens_size,lon_ind_above,lat_ind_below,lon_lat_lev(3),obs_kind,val_21,cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_pressure(state_handle, ens_size,lon_ind_above,lat_ind_above,lon_lat_lev(3),obs_kind,val_22,cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+
+elseif (is_vertical(obs_loc, "HEIGHT")) then
+ call get_val_height(state_handle, ens_size, lon_ind_below, lat_ind_below, lon_lat_lev(3), obs_loc, obs_kind, val_11, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_height(state_handle, ens_size, lon_ind_below, lat_ind_above, lon_lat_lev(3), obs_loc, obs_kind, val_12, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_height(state_handle, ens_size,lon_ind_above, lat_ind_below, lon_lat_lev(3), obs_loc, obs_kind, val_21, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_height(state_handle, ens_size,lon_ind_above, lat_ind_above, lon_lat_lev(3), obs_loc, obs_kind, val_22, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+
+elseif (is_vertical(obs_loc, "SURFACE")) then
+ ! The 'lev' argument is set to 1 because there is no level for these types, and 'lev' will be
+ ! ignored.
+ call get_val(state_handle, ens_size, lon_ind_below, lat_ind_below, 1, obs_kind, val_11, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val(state_handle, ens_size, lon_ind_below, lat_ind_above, 1, obs_kind, val_12, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val(state_handle, ens_size, lon_ind_above, lat_ind_below, 1, obs_kind, val_21, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val(state_handle, ens_size, lon_ind_above, lat_ind_above, 1, obs_kind, val_22, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+
+! This needs to be at the end of the block. Otherwise, it short circuits GPS
+! which asks for pressures on heights.
+! elseif (obs_kind == QTY_PRESSURE) then
+! ! Calculate pressures from surface pressures and A and B coeffs.
+! write(string1,'(A)') 'No code available yet for obs_kind = QTY_PRESSURE '
+! call error_handler(E_ERR, 'interp_lon_lat', string1)
+
+elseif (is_vertical(obs_loc, "SCALE_HEIGHT")) then
+ ! Need option for this case
+ write(string1,*)'Scale height is not an acceptable vert coord yet. Skipping observation'
+ call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate)
+ return
+
+! Need option for is_vertical("UNDEFINED")
+else
+ write(string1,*) ' No vert option chosen!'
+ call error_handler(E_WARN, 'interp_lonlat', string1,source,revision,revdate)
+ return
+
+endif
+
+! Conundrum (but unimportant for now): an ob could be excluded for > 1 reason.
+! E.g. it's too far north and it's above the highest_obs_pressure_Pa.
+! What istatus to return? a 2 (or more) digit number? Like vstatus*10 + 4?
+! RMA-KR; Note that there's no early return based on an interpolation failure.
+! The interpolation is done for those members for whom it's possible
+! and the others get 'failed' istatus, which is returned to the calling routine.
+
+if (abs(lon_lat_lev(2)) > max_obs_lat_degree) then
+ ! Define istatus to be a combination of vstatus (= 0 or 2 (for higher than highest_obs...))
+ ! and whether the ob is poleward of the limits set in the namelist (+ 4).
+ ! Too confusing for now;
+ ! istatus(:) = 10*vstatus + 4
+ istatus(:) = 2
+else
+ istatus(:) = vstatus(:)
+endif
+
+where (istatus == 0 .or. istatus == 2) ! These are success codes
+ ! indices of vals are (longitude, latitude)
+ a(:, 1) = lon_fract * val_21 + (1.0_r8 - lon_fract) * val_11
+ a(:, 2) = lon_fract * val_22 + (1.0_r8 - lon_fract) * val_12
+
+ ! CAM-chem 6)); multiply the result by the unit conversion factor
+ interp_val(:) = (lat_fract * a(:, 2) + (1.0_r8 - lat_fract) * a(:, 1)) * convert_units
+endwhere
+
+end subroutine interp_lonlat
+
+!-----------------------------------------------------------------------
+
+! Pobs
+subroutine get_val_level(state_handle, ens_size, lon_index, lat_index, level, obs_kind, val, istatus)
+
+! Gets the value on level for variable obs_kind
+! at lon_index, lat_index horizontal grid point
+!
+! written by Kevin Raeder, based on code from Hui Liu 4/28/2006 and get_val_pressure
+! from Jeff Anderson
+!
+! This routine indicates things with the return code:
+! istatus 0 - success
+! istatus 1 - failure (e.g. above or below highest/lowest level, or can't
+! interpolate the value)
+! istatus 2 - val is set successfully, but level is above highest_obs_level
+!
+! This routine assumes level is an integer value. To make it work for
+! fractional levels (some models do support this) the code would have to be
+! altered to find the value at the level below and above, and interpolate in
+! the vertical.
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: level
+integer, intent(in) :: obs_kind
+real(r8), intent(out) :: val(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+integer :: vstatus(ens_size), i, indx
+real(r8) :: p_surf(ens_size), threshold
+integer :: imem
+real(r8), allocatable :: p_col(:)
+
+! Start with failure condition
+istatus(:) = 1
+vstatus(:) = 1
+val(:) = MISSING_R8
+
+! This assumes that all variables are defined on model levels, not on interface levels.
+! Exclude obs below the model's lowest level and above the highest level,
+! but go ahead with surface fields (level = no_lev).
+if (level /= no_lev .and. (level > lev%length .or. level < 1)) return
+allocate(p_col(lev%length))
+
+! Interpolate in vertical to get two bounding levels, but treat pressure
+! specially since it has to be computed from PS instead of interpolated.
+
+if (obs_kind == QTY_PRESSURE) then
+
+ ! p_surf is returned in pascals, which is the right units for plevs_cam() below.
+ ! RMA-KR; level is irrelevant for PS, and should not cause a failure even now that
+ ! io/state_structure_mod.f90:get_dart_vector_index is the eventual recipient of that index.
+ ! Only lon and lat dimensions will be used to find the index into the state vector;
+ ! 'level' will not be used. Same for the pre-RMA trunk version.
+ call get_val(state_handle, ens_size, lon_index, lat_index, no_lev, QTY_SURFACE_PRESSURE, p_surf, vstatus)
+ if (all(vstatus /= 0)) then
+ deallocate(p_col)
+ return
+ endif
+ ! Next, get the values on the levels for this PS.
+ do imem = 1, ens_size
+ if (vstatus(imem) == 0) then
+ call plevs_cam (p_surf(imem), lev%length, p_col)
+ val(imem) = p_col(level)
+ endif
+ enddo
+
+else
+
+ call get_val(state_handle, ens_size, lon_index, lat_index, level, obs_kind, val, vstatus)
+
+endif
+
+! if this routine is called with a location that has a vertical level above
+! the pressure cutoff, go ahead and compute the value but return an istatus=2
+! (unless some other error occurs later in this routine). note that smaller
+! level numbers are higher up in the atmosphere; level 1 is at the top.
+
+if (level < highest_obs_level) then
+ istatus(:) = 2
+else
+ istatus(:) = vstatus
+endif
+
+deallocate(p_col)
+
+end subroutine get_val_level
+
+!-----------------------------------------------------------------------
+
+subroutine get_val_pressure(state_handle, ens_size, lon_index, lat_index, pressure, obs_qty, val, istatus)
+
+! Gets the vertically interpolated value on pressure for variable obs_qty
+! at lon_index, lat_index horizontal grid point
+!
+! This routine indicates things with the return code:
+! istatus 0 - success
+! istatus 1 - failure (e.g. above or below highest/lowest level, or can't
+! interpolate the value)
+! istatus 2 - val is set successfully, but vert is above highest_obs_pressure
+!
+! Excludes observations below lowest level pressure and above highest level pressure.
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+real(r8), intent(in) :: pressure
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: obs_qty
+real(r8), intent(out) :: val(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+real(r8), dimension(ens_size) :: bot_val, top_val, p_surf, frac
+real(r8), dimension(ens_size) :: ps_local(ens_size, 2)
+integer, dimension(ens_size) :: top_lev, bot_lev, vstatus, cur_vstatus
+! RMA-KR; cur_vstatus was explicitly dimensioned (ens_size), which was redundant.
+integer :: fld_index
+integer(i8) :: i, imem
+real(r8), allocatable :: p_col(:,:)
+
+! Start with error condition.
+istatus(:) = 1
+cur_vstatus(:) = 1
+vstatus(:) = 0 ! so you can track statuses
+val(:) = MISSING_R8
+p_surf(:) = MISSING_R8
+
+! Need to get the surface pressure at this point.
+! Find out whether the observed field is a staggered field in CAM.
+! Check whether the state vector has wind components on staggered grids, i.e. whether CAM is FV.
+! find_name returns 0 if the field name is not found in the cflds list.
+
+fld_index = find_name('PS',cflds)
+i = index_from_grid(1,lon_index,lat_index, fld_index)
+ps_local(:, 1) = get_state(i, state_handle)
+
+if (obs_qty == QTY_U_WIND_COMPONENT .and. find_name('US', cflds) /= 0) then
+ ! ps defined on lat grid (-90...90, nlat = nslat + 1),
+ ! need it on staggered lat grid, which starts half a grid spacing north.
+
+ i = index_from_grid(1,lon_index,lat_index+1,fld_index)
+ ps_local(:, 2) = get_state(i, state_handle)
+ p_surf(:) = (ps_local(:, 1) + ps_local(:, 2))* 0.5_r8
+elseif (obs_qty == QTY_V_WIND_COMPONENT .and. find_name('VS', cflds) /= 0) then
+ ! lon = 0... 255 (for 5 degree grid)
+ !slon = -2.5 ... 252.5
+ if (lon_index == slon%length) then
+ i = index_from_grid(1,1, lat_index ,fld_index)
+ else
+ i = index_from_grid(1,lon_index+1,lat_index ,fld_index)
+ endif
+ ps_local(:, 2) = get_state(i, state_handle)
+ p_surf(:) = (ps_local(:, 1) + ps_local(:, 2))* 0.5_r8
+else
+ ! A-grid ps can be retrieved from state vector, which was used to define ps on entry to
+ ! model_interpolate.
+ p_surf(:) = ps_local(:, 1)
+endif
+
+! Next, get the pressures on the levels for this ps
+! Assuming we'll only need pressures on model mid-point levels, not interface levels.
+! This pressure column will be for the correct grid for obs_qty, since p_surf was taken
+! from the grid-correct ps[_stagr] grid
+allocate(p_col(lev%length, ens_size))
+p_col(:,:) = MISSING_R8
+do imem = 1, ens_size
+ call plevs_cam(p_surf(imem), lev%length, p_col(:, imem))
+enddo
+
+do imem = 1, ens_size
+ if (pressure <= p_col(1, imem) .or. pressure >= p_col(lev%length, imem)) then
+ vstatus(imem) = 1
+ ! Exclude obs below the model's lowest level and above the highest level
+ ! We *could* possibly use ps and p(lev%length) to interpolate for points below the lowest level.
+ !return
+ endif
+enddo
+
+! Interpolate in vertical to get two bounding levels
+
+! Search down through pressures for each ensemble member
+do imem = 1, ens_size
+ if (vstatus(imem) == 0) then
+ levloop: do i = 2, lev%length
+ if (pressure < p_col(i, imem)) then
+ top_lev(imem) = i -1
+ bot_lev(imem) = i
+ frac(imem) = (p_col(i, imem) - pressure) / &
+ (p_col(i, imem) - p_col(i - 1, imem))
+ exit levloop
+ endif
+ enddo levloop
+ else
+ ! This is to avoid top_lev and bot_lev getting nonsense values
+ top_lev(imem) = 1
+ bot_lev(imem) = 2
+ endif
+enddo
+
+if (obs_qty == QTY_PRESSURE) then
+ ! can't get pressure on levels from state vector; get it from p_col instead
+ do imem = 1, ens_size
+ bot_val(imem) = p_col(bot_lev(imem), imem)
+ top_val(imem) = p_col(top_lev(imem), imem)
+ enddo
+else
+ call get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, bot_lev, obs_qty, bot_val, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, top_lev, obs_qty, top_val, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+endif
+
+
+! Failed to get value for interpolation; return istatus = 1
+where (vstatus == 0)
+ istatus = 0
+ val = (1.0_r8 - frac) * bot_val + frac * top_val
+elsewhere
+ istatus = 1
+ val = MISSING_R8
+endwhere
+
+! if this routine is called with a location that has a vertical pressure above
+! the pressure cutoff, go ahead and compute the value but return an istatus=2
+! (unless some other error occurs later in this routine).
+if (pressure < highest_obs_pressure_Pa) then
+ where (istatus == 0) istatus = 2
+endif
+
+deallocate(p_col)
+
+end subroutine get_val_pressure
+
+!-----------------------------------------------------------------------
+
+subroutine get_val_height(state_handle, ens_size, lon_index, lat_index, height, location, obs_kind, val, istatus)
+
+! Gets the vertically interpolated value on height for variable obs_kind
+! at lon_index, lat_index horizontal grid point
+!
+! written by Kevin Raeder, based on code from Hui Liu 4/28/2006 and get_val_pressure
+! from Jeff Anderson
+!
+! This routine indicates things with the return code:
+! istatus 0 - success
+! istatus 1 - failure (e.g. above or below highest/lowest level, or can't
+! interpolate the value)
+! istatus other - val is set successfully, but obs is excluded according to namelist restrictions.
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+real(r8), intent(in) :: height
+type(location_type), intent(in) :: location
+integer, intent(in) :: obs_kind
+real(r8), intent(out) :: val(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+integer :: i, fld_index
+integer, dimension(ens_size) :: top_lev, bot_lev, vstatus, cur_vstatus
+real(r8), dimension(ens_size) :: bot_val, top_val, frac
+integer(i8) :: ind
+real(r8) :: p_surf(ens_size), ps_local(ens_size, 2)
+logical :: stagr_lon, stagr_lat
+real(r8), allocatable :: p_col(:, :), model_h(:, :) !(lev%length, ens_size)
+integer :: imem
+
+! Start with error condition.
+! RMA-KR; should vstatus start with 1? Then change comment to 'start with error condition'.
+! vstatus is first passed to model_heights, which sets it to 1, so this is irrelevant.
+istatus(:) = 1
+vstatus(:) = 1
+cur_vstatus(:) = 1
+val(:) = MISSING_R8
+stagr_lon = .false.
+stagr_lat = .false.
+
+! Assuming we'll only need pressures on model mid-point levels, not interface levels.
+allocate(p_col(lev%length, ens_size))
+allocate(model_h(lev%length, ens_size))
+! Need to get the surface pressure at this point.
+! Check whether the state vector has wind components on staggered grids, i.e. whether CAM is FV.
+! See get_val_pressure for more documentation.
+fld_index = find_name('PS',cflds)
+ind = index_from_grid(1,lon_index,lat_index, fld_index)
+ps_local(:, 1) = get_state(ind, state_handle)
+
+! find_name returns 0 if the field name is not found in the cflds list.
+if (obs_kind == QTY_U_WIND_COMPONENT .and. find_name('US', cflds) /= 0) then
+ stagr_lat = .true.
+ ind = index_from_grid(1,lon_index,lat_index+1,fld_index)
+ ps_local(2, :) = get_state(ind, state_handle)
+ p_surf(:) = (ps_local(1, :) + ps_local(2, :))* 0.5_r8
+elseif (obs_kind == QTY_V_WIND_COMPONENT .and. find_name('VS', cflds) /= 0) then
+ stagr_lon = .true.
+ if (lon_index == slon%length) then
+ ind = index_from_grid(1,1, lat_index ,fld_index)
+ else
+ ind = index_from_grid(1,lon_index+1,lat_index ,fld_index)
+ endif
+ ps_local(:, 2) = get_state(ind, state_handle)
+ p_surf(:) = (ps_local(:, 1) + ps_local(:, 2))* 0.5_r8
+else
+ p_surf(:) = ps_local(:, 1)
+endif
+
+! Next, get the heights on the levels for this ps
+
+! We want to use the new vec for each new ob on height because the state was updated
+! for all previous obs, and we want to use the most up to date state to get the best location.
+! The above comment is untrue - the state is not updated, either it is the forward operator
+! before assimilation, or it is the mean (not updated during assimilation)
+call model_heights(state_handle, ens_size, lev%length, p_surf, location, model_h, vstatus)
+if (all(vstatus == 1)) return ! Failed to get model heights; return istatus = 1
+
+! Exclude obs below the model's lowest level and above the highest level
+do imem = 1, ens_size
+ if (height >= model_h(1, imem) .or. height <= model_h(lev%length, imem)) vstatus(imem) = 1 ! Fail
+enddo
+
+! ? Implement 3Dp here? or should/can it not use the ens mean PS field?
+do imem = 1, ens_size
+ call plevs_cam(p_surf(imem), lev%length, p_col(:, imem))
+enddo
+
+! The highest_obs_pressure_Pa has already been checked to ensure it's a valid value.
+! So this loop will always set the highest_obs_height_m before exiting.
+! This could be refined to interpolate between the p_col to highest_obs_pressure_Pa.
+! Also, if using the nearest lower model level is good enough, then it might be good
+! enough to only calculate highest_obs_height_m once; put if (highest_obs_height_m == MISSING_R8)
+! around the loop.
+! Actually, I see in gph2gmh that the heights in model_h are relative to mean sea level,
+! so they will be independent from the surface height and vertical coordinate system.
+! They will vary slightly with surface pressure.
+! So I think that highest_obs_height_m could be calculated once
+! HK You have a highest_obs_height_m for each ensemble member. Is this what you want?
+! HK The trunk will ens up with highest_obs_height_m equal to its first ensemble
+! member at the first obseravation location.
+!> @todo The location used in the distributed forward operator will be different
+!> on each task for the highest_obs_height_calculation
+if (highest_obs_height_m == MISSING_R8) then
+ ! Search until we find a good member
+ memloop: do imem = 1, ens_size
+ if (vstatus(imem) == 0) then
+ levloop: do i=2,lev%length
+ if (p_col(i, imem) > highest_obs_pressure_Pa) then
+ ! highest_obs_height_m = model_h(i)
+ highest_obs_height_m = model_h(i, imem) + (model_h(i-1, imem)-model_h(i, imem))* &
+ ((p_col(i, imem)-highest_obs_pressure_Pa) / &
+ (p_col(i, imem)-p_col(i-1, imem)))
+ write(string1, *) 'highest_obs_height_m = ',highest_obs_height_m
+ call error_handler(E_MSG,'get_val_height', string1, &
+ source, revision, revdate)
+ exit memloop
+ endif
+ enddo levloop
+ endif
+ enddo memloop
+endif
+
+
+! Interpolate in vertical to get two bounding levels.
+! Search down through heights and set the enclosing level numbers
+! and the fraction between them. There has already been a test to
+! ensure the height is between the levels (and has discarded values
+! exactly equal to the limits), so this will always succeed.
+do imem = 1, ens_size
+ if (vstatus(imem) == 0) then
+ lev2loop: do i = 2, lev%length
+ if (height > model_h(i, imem)) then
+ top_lev(imem) = i -1
+ bot_lev(imem) = i
+ frac(imem) = (model_h(i, imem) - height ) / &
+ (model_h(i, imem) - model_h(i-1, imem))
+ exit lev2loop
+ endif
+ enddo lev2loop
+ else ! This is so you can make a call to get_val_array_of_levels without
+ ! looking at the vstatus of each ensemble member.
+ bot_lev(imem) = 2
+ top_lev(imem) = 1
+ endif
+enddo
+
+if (obs_kind == QTY_PRESSURE) then
+ do imem = 1, ens_size
+ bot_val(imem) = p_col(bot_lev(imem), imem)
+ top_val(imem) = p_col(top_lev(imem), imem)
+ enddo
+else
+ call get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, bot_lev, obs_kind, bot_val, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ call get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, top_lev, obs_kind, top_val, cur_vstatus)
+ call update_vstatus(ens_size, cur_vstatus, vstatus)
+ ! Failed to get a value to use in interpolation
+ !if (vstatus == 1) return
+endif
+
+istatus(:) = vstatus(:)
+
+where (istatus == 0)
+ val = (1.0_r8 - frac) * bot_val + frac * top_val
+endwhere
+
+if (height > highest_obs_height_m ) then
+ ! if this routine is called with a location that has a vertical height above
+ ! the pressure cutoff, pass back the value but return an istatus=2
+ ! (Only for successful forward operators)
+ where(istatus == 0) istatus = 2
+endif
+
+
+deallocate(p_col, model_h)
+
+end subroutine get_val_height
+
+!-----------------------------------------------------------------------
+
+subroutine get_val(state_handle, ens_size, lon_index, lat_index, level, obs_kind, val, istatus)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: level
+integer, intent(in) :: obs_kind
+real(r8), intent(out) :: val(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+integer(i8) :: indx
+integer :: field_type
+
+! Start with error condition.
+istatus(:) = 1
+val(:) = MISSING_R8
+
+field_type = find_name(dart_to_cam_types(obs_kind),cflds)
+if (field_type <= 0 .or. field_type > nflds) return
+
+indx = index_from_grid(level, lon_index, lat_index, field_type)
+!> @todo pull this check out or error
+! HK: This check is not correct for XCESM
+! RMA-KR; is this check related to synthetic obs, which have state indices < 0?
+!if (indx > 0 .and. indx <= model_size) then
+ istatus(:) = 0
+ val = get_state(indx, state_handle)
+!endif
+
+end subroutine get_val
+
+
+!-----------------------------------------------------------------------
+!> Same as get val but accepts an array of levels
+subroutine get_val_array_of_levels(state_handle, ens_size, lon_index, lat_index, levels, obs_kind, val, istatus)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: lon_index
+integer, intent(in) :: lat_index
+integer, intent(in) :: levels(ens_size)
+integer, intent(in) :: obs_kind
+real(r8), intent(out) :: val(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+integer(i8) :: indx(ens_size)
+integer :: field_type
+integer :: imem
+
+! Start with error condition.
+istatus(:) = 1
+val(:) = MISSING_R8
+
+field_type = find_name(dart_to_cam_types(obs_kind),cflds)
+if (field_type <= 0 .or. field_type > nflds) return
+
+do imem = 1, ens_size
+ indx(imem) = index_from_grid(levels(imem), lon_index, lat_index, field_type)
+enddo
+! HK: This check is not correct for XCESM.
+! RMA-KR; is this check related to synthetic obs, which have state indices < 0?
+!if (indx > 0 .and. indx <= model_size) then
+ istatus(:) = 0
+ call get_state_array(val, indx, state_handle)
+!endif
+
+end subroutine get_val_array_of_levels
+
+
+!-----------------------------------------------------------------------
+
+subroutine set_highest_obs_limit()
+
+! Verify that the value for highest_obs_pressure_Pa in the namelist is ok.
+!
+! If this routine detects an error it calls the error handler with a
+! fatal error. If it returns, the namelist value is ok.
+!
+! Sets the module global variable 'highest_obs_level', and references
+! the hybm array.
+
+integer :: i, lowest_ok
+real(r8) :: p_surf, top
+real(r8), allocatable :: p_col(:)
+! This assumes that all variables are defined on model levels, not on interface levels.
+allocate(p_col(lev%length))
+
+! This code determines the model level that is below but closest to the
+! 'highest obs pressure' limit that was set in the namelist. It is counting
+! on the limit being set high enough that the level heights are
+! determined solely by the pressure values with no contribution from the terrain.
+! Instead of computing a surface pressure from an ensemble member at a particular
+! longitude and latitude, assume a surface pressure of 1000 mb and compute
+! a pressure column based on that. Then, verify that the 'hybm' value at
+! the selected level is 0 - otherwise the levels still have a contribution
+! based on terrain and cannot be solely determined based on pressure.
+! Then we can use this single level value for any lat/lon/ensemble member.
+
+! Compute a pressure column based on a 1000 mb (*100 = pascals) surface pressure
+call plevs_cam(P0%vals(1), lev%length, p_col)
+
+! Loop downwards through pressure values (1 = model top, lev%length = bottom).
+! The level is set to the highest level which is below the given threshold.
+
+
+! RMA-KR; this lev%length condition was added to ensure that highest_obs_level
+! doesn't end up with value lev%length+1 due to the loop running all the way through.
+High: do highest_obs_level=1,lev%length
+ if (p_col(highest_obs_level) > highest_obs_pressure_Pa .or. &
+ highest_obs_level == lev%length) exit High
+enddo High
+
+! Test whether user has set highest_obs_pressure_Pa to be uselessly small (high),
+! which causes problems for setting highest_obs_height_m.
+! highest model level (mid-layer) pressure:
+top = hyam%vals(1)*P0%vals(1)
+if (highest_obs_pressure_Pa < top) then
+ write(string1, '(2A)') 'Namelist variable "highest_obs_pressure_Pa" is too small', &
+ ' (located above the model atmosphere)'
+ write(string2, '(A,1pe15.5)') ' Reset to at least ',top
+ call error_handler(E_ERR, 'set_highest_obs_limit', string1, source, revision, revdate, text2=string2)
+endif
+
+! Test to be sure user hasn't set level so low that contributions from
+! terrain are going to be an issue. If they do, tell them in the error
+! message what the valid limit is.
+if (hybm%vals(highest_obs_level) > 0.0_r8) then
+ lowest_ok = 1
+ findzero: do i=2, lev%length
+ if (hybm%vals(i) > 0.0_r8) then
+ lowest_ok = i-1
+ exit findzero
+ endif
+ enddo findzero
+ write(string1, '(A)') 'invalid value for namelist "highest_obs_pressure_Pa"'
+ write(string2, '(A)') 'value is too large (located out of the pure pressure levels of the atmosphere)'
+ write(string3, '(A,F9.3,A)') 'must specify a value located above pressure ', p_col(lowest_ok), ' Pascals'
+ call error_handler(E_ERR, 'set_highest_obs_limit', string1, source, revision, revdate, &
+ text2=string2, text3=string3)
+endif
+
+deallocate(p_col)
+
+end subroutine set_highest_obs_limit
+
+! End of model_interpolate section
+
+!#######################################################################
+
+! Vector-field translations
+
+!-----------------------------------------------------------------------
+
+subroutine prog_var_to_vector(var, st_vec)
+
+type(model_type), intent(in) :: var
+real(r8), intent(out) :: st_vec(:)
+
+integer :: i, j, k, nf, indx
+
+! Load components of state vector, starting with scalars (0D) and finishing with 3D
+! A whole field will be loaded (by columns for 3D) before the next field is started.
+! This is completely different than the B-grid organization, which loaded all the fields
+! at a point before moving on to the next point. The motivations for this change are:
+! 1) This easily allows fields with the same rank, but different sizes to be loaded into
+! the vector (i.e. U_staggered and T in the cam-fv)
+! 2) The dominant form of access into the state vector is vertical interpolations in
+! get_expected_val and computation of columns of virtual temperature from T and Q
+! in model_heights. model_get_close_states, which searched for all variables close
+! to an obs, is not part of the MPI DART, so spatially co-located variables don't
+! need to be close to each other in memory.
+
+if (.not. module_initialized) call static_init_model()
+
+indx = 0
+
+! 0d variables
+do nf = 1, state_num_0d
+ indx = indx + 1
+ st_vec(indx) = var%vars_0d(nf)
+enddo
+
+! 1d variables
+do nf = 1, state_num_1d
+ do i=1,f_dim_1d(1,nf)
+ indx = indx + 1
+ st_vec(indx) = var%vars_1d(i, nf)
+ enddo
+enddo
+
+! 2d variables
+do nf = 1, state_num_2d
+ do j=1,f_dim_2d(2,nf)
+ do i=1,f_dim_2d(1,nf)
+ indx = indx + 1
+ st_vec(indx) = var%vars_2d(i, j, nf)
+ enddo
+ enddo
+enddo
+
+! 3D fields
+! This section is only entered for models with logically rectangular grids,
+! which will have dimensions level, longitude, and latitude.
+! RMA-KR; the indices in vars_3d are reversed compared to the non-RMA trunk,
+! due to no longer re-ordering dimensions to a standard order.
+do nf= 1, state_num_3d
+ do k=1,f_dim_3d(3,nf)
+ do j=1,f_dim_3d(2,nf)
+ do i=1,f_dim_3d(1,nf)
+ indx = indx + 1
+ st_vec(indx) = var%vars_3d(i, j, k, nf)
+ enddo
+ enddo
+ enddo
+enddo
+
+if (indx /= model_size) then
+ write(string1, *) 'Number of elements copied = ',indx,', must equal model_size, ',model_size
+ call error_handler(E_ERR, 'prog_var_to_vector', string1, source, revision, revdate)
+endif
+
+end subroutine prog_var_to_vector
+
+!-----------------------------------------------------------------------
+
+subroutine vector_to_prog_var(st_vec, var)
+
+real(r8), intent(in) :: st_vec(:)
+type(model_type), intent(inout) :: var
+
+integer :: i, j, k, nf, indx
+
+if (.not. module_initialized) call static_init_model()
+
+indx = 0
+
+! 0d arrays
+do nf = 1, state_num_0d
+ indx = indx + 1
+ var%vars_0d(nf) = st_vec(indx)
+enddo
+
+! 1d fields
+do nf = 1, state_num_1d
+ do i=1,f_dim_1d(1, nf)
+ indx = indx + 1
+ var%vars_1d(i, nf) = st_vec(indx)
+ enddo
+enddo
+
+! 2d fields
+do nf = 1, state_num_2d
+ do j = 1, f_dim_2d(2,nf)
+ do i = 1, f_dim_2d(1,nf)
+ indx = indx + 1
+ var%vars_2d(i, j, nf) = st_vec(indx)
+ enddo
+ enddo
+enddo
+
+! 3D fields; see comments in prog_var_to_vect
+! RMA-KR; the indices in vars_3d are reversed compared to the non-RMA trunk,
+! due to no longer re-ordering dimensions to a standard order.
+do nf = 1, state_num_3d
+ do k = 1, f_dim_3d(3,nf)
+ do j = 1, f_dim_3d(2,nf)
+ do i = 1, f_dim_3d(1,nf)
+ indx = indx + 1
+ var%vars_3d(i, j, k, nf) = st_vec(indx)
+ enddo
+ enddo
+ enddo
+enddo
+
+if (indx /= model_size) then
+ write(string1, *) 'Number of elements copied = ',indx,', must equal model_size, ',model_size
+ call error_handler(E_ERR, 'vector_to_prog_var', string1, source, revision, revdate)
+endif
+
+end subroutine vector_to_prog_var
+
+! End of Vector-field translations
+
+
+!#######################################################################
+! get_close section
+
+!-----------------------------------------------------------------------
+!>
+!> Subroutine get_close_obs
+!>
+!> get_close_obs takes as input an "observation" location, a DART TYPE (not QTY),
+!> and a list of all potentially close locations and QTYs on this task.
+!>
+!> get_close_obs
+!> *) converts vertical coordinates as needed to vert_coord,
+!> *) calls location_mod/threed_sphere:get_close_obs,
+!> to which it sends this (converted) array of locations,
+!> *) gets back the distances and indices of those locations that are
+!> "close" to the base observation.
+!> *) tests for being above the highest_obs_pressure_Pa threshold,
+!> and increases the vertical distance based on height above highest_*.
+!>
+!> @param[in] filt_gc
+!> The DART get_close_type containing the state variables which are potentially close to 'location'
+!>
+!> @param[in] base_loc
+!> The DART location_type location of the observation, which is the target of *get_close_obs*
+!>
+!> @param[in] base_type
+!> The DART TYPE (not QTY) of the observation
+!>
+!> @param[inout] locs(:)
+!> The DART location_type locations of the potentially close state variables
+!>
+!> @param[in] kinds(:)
+!> The DART QTYs of the potentially close state variables
+!>
+!> @param[out] num_close
+!> The number of state variables which are deemed to be close to the observation
+!> after get_close_obs has evaluated them
+!>
+!> @param[out] close_indices(:)
+!> The state vector indices of the close state variables.
+!>
+!> @param[out] distances(:)
+!> The distances of the close state variables from the observation.
+!>
+!> @param[in] state_handle
+!> The DART ensemble_type structure which gives access to the ensemble of model states.
+
+subroutine get_close_obs(filt_gc, base_loc, base_type, locs, loc_qtys, loc_types, &
+ num_close, close_indices, distances, state_handle)
+
+type(get_close_type), intent(in) :: filt_gc
+type(location_type), intent(in) :: base_loc
+integer, intent(in) :: base_type
+type(location_type), intent(inout) :: locs(:)
+integer, intent(in) :: loc_qtys(:)
+integer, intent(in) :: loc_types(:)
+integer, intent(out) :: num_close
+integer, intent(out) :: close_indices(:)
+real(r8), intent(out), optional :: distances(:)
+type(ensemble_type), intent(in), optional :: state_handle
+
+call get_close(filt_gc, base_loc, base_type, locs, loc_qtys, &
+ num_close, close_indices, distances, state_handle)
+
+end subroutine get_close_obs
+
+!-----------------------------------------------------------------------
+
+subroutine get_close_state(filt_gc, base_loc, base_type, locs, loc_qtys, loc_indx, &
+ num_close, close_indices, distances, state_handle)
+
+type(get_close_type), intent(in) :: filt_gc
+type(location_type), intent(in) :: base_loc
+integer, intent(in) :: base_type
+type(location_type), intent(inout) :: locs(:)
+integer, intent(in) :: loc_qtys(:)
+integer(i8), intent(in) :: loc_indx(:)
+integer, intent(out) :: num_close
+integer, intent(out) :: close_indices(:)
+real(r8), intent(out), optional :: distances(:)
+type(ensemble_type), intent(in), optional :: state_handle
+
+call get_close(filt_gc, base_loc, base_type, locs, loc_qtys, &
+ num_close, close_indices, distances, state_handle)
+
+end subroutine get_close_state
+
+!-----------------------------------------------------------------------
+
+subroutine get_close(filt_gc, base_loc, base_type, locs, loc_qtys, &
+ num_close, close_indices, distances, state_handle)
+
+! get_close_obs takes as input an "observation" location, a DART TYPE (not QTY),
+! and a list of all potentially close locations and QTYs on this task.
+!
+! get_close_obs
+! *) converts vertical coordinates as needed to vert_coord,
+! *) calls location_mod/threed_sphere:get_close_obs,
+! to which it sends this (converted) array of locations,
+! *) gets back the distances and indices of those locations that are
+! "close" to the base observation.
+! *) tests for being above the highest_obs_pressure_Pa threshold,
+! and increases the vertical distance based on height above highest_*.
+!
+! get_close_obs will use the ensemble average to convert the obs and/or state
+! vertical location(s) to a standard (vert_coord) vertical location
+
+type(get_close_type), intent(in) :: filt_gc
+type(location_type), intent(in) :: base_loc
+integer, intent(in) :: base_type
+type(location_type), intent(inout) :: locs(:)
+integer, intent(in) :: loc_qtys(:)
+integer, intent(out) :: num_close
+integer, intent(out) :: close_indices(:)
+real(r8), intent(out), optional :: distances(:)
+type(ensemble_type), intent(in), optional :: state_handle
+
+! FIXME remove some (unused) variables?
+integer :: k, t_ind
+integer :: base_which, local_base_which, obs_which, local_obs_which
+integer :: base_obs_kind
+real(r8) :: base_array(3), local_base_array(3), obs_array(3), local_obs_array(3)
+real(r8) :: damping_dist, threshold, thresh_wght
+type(location_type) :: local_base_loc, local_loc, vert_only_loc
+
+if (.not. module_initialized) call static_init_model()
+
+! If base_obs vert type is not pressure; convert it to pressure
+base_which = nint(query_location(base_loc))
+base_array = get_location(base_loc)
+base_obs_kind = get_quantity_for_type_of_obs(base_type)
+
+! Upgrading convert_vert to use field profiles at the actual ob location is
+! probably not worthwhile: that approx horiz location of the obs is used only to
+! convert its vert coord to pressure (if necessary),
+! which, in turn, is used to modify the distance if the ob or model variable
+! is higher than highest_XXX_Pa. That modification tapers to 0,
+! so any errors introduced by this approx will be continuous and random,
+! introducing no bias.
+if (base_which == VERTISPRESSURE .and. vert_coord == 'pressure') then
+ local_base_loc = base_loc
+ local_base_array = get_location(base_loc) ! needed in num_close loop
+ local_base_which = base_which
+else
+ call convert_vert(state_handle, base_array, base_which, base_loc, base_obs_kind, &
+ local_base_array, local_base_which)
+ local_base_loc = set_location(base_array(1), base_array(2), local_base_array(3), &
+ local_base_which)
+endif
+
+! Get all the potentially close obs but no distances.
+call loc_get_close(filt_gc, local_base_loc, base_type, locs, loc_qtys, &
+ num_close, close_indices)
+
+do k = 1, num_close
+
+ ! The indices in close_obs refer to the subset of (state) vars or obs ON 1 TASK.
+ ! That subset is (re)labeled 1...num_vars_task#, where num_vars_task# ~ state_vec_size/ntasks.
+ ! So those indices can't tell me which state vector element I'm dealing with.
+ ! I need to use the location of each returned close_indices to learn anything about it.
+
+ t_ind = close_indices(k)
+ obs_array = get_location(locs(t_ind))
+ ! query_location returns location%which_vert, if no 'attr' argument is given.
+ obs_which = nint(query_location(locs(t_ind)))
+
+ ! FIXME Nancy; what about 'ob's on scale height, but vert_coord is pressure.
+ ! KDR: the base ob was converted to pressure, if necessary, in the first section,
+ ! before the loop over num_close.
+ ! And can these if blocks be collapsed by defining local_obs_array(1:2 at least)
+ ! before the if tests.
+ if ((obs_which == VERTISPRESSURE .and. vert_coord == 'pressure') .or. &
+ (obs_which == VERTISSCALEHEIGHT .and. vert_coord == 'log_invP')) then
+ ! put the vertical (pressure) of the state/ob in local storage
+ local_obs_array(3) = obs_array(3)
+ local_obs_which = obs_which
+
+ elseif (obs_which == VERTISUNDEF) then
+ ! obs_which = -2 (VERTISUNDEF) means this ob is vertically close to base_obs, no matter what.
+ ! if (local_obs_array(3) == MISSING_R8) then
+ local_obs_array(3) = local_base_array(3)
+ local_obs_which = local_base_which
+
+ else
+ call convert_vert(state_handle, obs_array, obs_which, locs(t_ind), loc_qtys(t_ind), &
+ local_obs_array, local_obs_which)
+
+ ! save the converted location back into the original list.
+ ! huge improvement in speed since we only do the vertical convert
+ ! once per location, instead of num_close * nobs times.
+ locs(t_ind) = set_location( local_obs_array(1), local_obs_array(2), &
+ local_obs_array(3), local_obs_which)
+
+ endif
+
+! FIXME: I think this line could be replaced by moving 'locs(t_ind) = '
+! out of the last if-block above, and referencing locs(t_ind) below.
+! This is because the lon and lat are not changing: obs_array(1) = local_obs_array(1),...
+ local_loc = set_location(obs_array(1), obs_array(2), local_obs_array(3), &
+ local_obs_which)
+
+!>@todo FIXME this should be removed and replaced by calls to obs_impact
+!> in the assim_tools module.
+! allow a namelist specified kind string to restrict the impact of those
+! obs kinds to only other obs and state vars of the same kind.
+ if ((impact_kind_index >= 0) .and. &
+ (impact_kind_index == base_obs_kind) .and. &
+ (impact_kind_index /= loc_qtys(t_ind))) then
+ if(present(distances)) distances(k) = 999999.0_r8 ! arbitrary very large distance
+
+ else
+ ! Need to damp the influence of all obs (VERTISUNDEF, VERTISSURFACE too) on model state vars
+ ! above highest_state_pressure_Pa.
+
+ ! The which vert of local_base_loc determines how vertical distance to local_loc is calculated.
+ ! It can be VERTISSCALEHEIGHT.
+ if(present(distances)) distances(k) = get_dist(local_base_loc, local_loc, base_type, loc_qtys(t_ind))
+
+ ! Damp the influence of obs, which are below the namelist variable highest_OBS_pressure_Pa,
+ ! on variables above highest_STATE_pressure_Pa.
+ ! This section could also change the distance based on the QTY_s of the base_obs and obs.
+
+ ! distances = 0 for some for synthetic obs.
+
+ ! Better damping
+ ! Should be units of distance (radians), so normalize the distance added to the existing dist(k),
+ ! below, by the vert_normalization_{pressure,scale_height}.
+ ! Vert_norm is not public, so call get_dist with 2 locations having the same
+ ! horiz location, but different verticals, and the appropriate which_vert.
+
+ if ((vert_coord == 'pressure' .and. (local_obs_array(3) < highest_state_pressure_Pa)) .or. &
+ (vert_coord == 'log_invP' .and. (local_obs_array(3) > highest_state_scale_h)) ) then
+ ! The (lon,lat) here must match the definition of highest_state_loc in static_init_mod.
+ ! FIXME; is this hard-coding OK?
+ ! local_obs_which should be consistent with local_base_obs_which, (and vert_coord).
+ vert_only_loc = set_location(1.0_r8,1.0_r8,local_obs_array(3),local_obs_which)
+
+ ! This gets the vertical distance (> 0) only, and uses the appropriate
+ ! vert_normalization to convert from pressure or scale_height to radians.
+ damping_dist = get_dist(highest_state_loc,vert_only_loc,no_vert=.false.)
+
+ ! This (new) added distance varies smoothly from 0 at highest_state_pressure_Pa
+ ! to > 2*cutoff*vert_normalization at the levels where CAM has extra damping
+ ! (assuming that highest_state_pressure_Pa has been chosen low enough).
+
+ if(present(distances)) distances(k) = distances(k) + damping_dist * damping_dist * damp_wght
+
+ endif
+ endif
+
+enddo
+
+end subroutine get_close
+
+!-----------------------------------------------------------------------
+!> wrapper for convert_vert so it can be called from assim_tools
+!>
+!> @param[in] state_handle
+!> The DART ensemble_type structure which gives access to the ensemble of model states.
+!>
+!> @param[inout] obs_loc
+!> The DART location_type location of the observation.
+!>
+!> @param[in] obs_kind
+!> The DART QTY of the observation.
+!>
+!> @param[out] vstatus
+!> The status of the conversion from one vertical location to another.
+!>
+!--------------------------------------------------------------------
+
+subroutine convert_vertical_obs(state_handle, num, locs, loc_qtys, loc_types, &
+ which_vert, status)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: num
+type(location_type), intent(inout) :: locs(:)
+integer, intent(in) :: loc_qtys(:), loc_types(:)
+integer, intent(in) :: which_vert
+integer, intent(out) :: status(:)
+
+real(r8) :: old_array(3)
+integer :: old_which, wanted_vert
+type(location_type) :: old_loc
+
+real(r8) :: new_array(3)
+integer :: new_which, i
+
+
+status(:) = 0 ! I don't think cam has a return status for vertical conversion
+wanted_vert = query_vert_localization_coord()
+
+do i=1, num
+ old_which = query_location(locs(i), 'which_vert')
+ if (old_which == wanted_vert) cycle
+
+ old_loc = locs(i)
+ old_array = get_location(locs(i))
+
+ call convert_vert(state_handle, old_array, old_which, old_loc, loc_qtys(i), new_array, new_which)
+
+ if(new_which == MISSING_I) then
+ status(i) = 1
+ else
+ locs(i) = set_location(new_array(1), new_array(2), new_array(3), new_which)
+ endif
+enddo
+
+
+end subroutine convert_vertical_obs
+
+!--------------------------------------------------------------------
+!>@todo FIXME there should be a more efficient way to convert
+!>state locations - no interpolation in the horizontal is needed.
+
+subroutine convert_vertical_state(state_handle, num, locs, loc_qtys, loc_indx, &
+ which_vert, istatus)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: num
+type(location_type), intent(inout) :: locs(:)
+integer, intent(in) :: loc_qtys(:)
+integer(i8), intent(in) :: loc_indx(:)
+integer, intent(in) :: which_vert
+integer, intent(out) :: istatus
+
+real(r8) :: old_array(3)
+integer :: old_which, wanted_vert
+type(location_type) :: old_loc
+
+real(r8) :: new_array(3)
+integer :: new_which, i
+
+wanted_vert = query_vert_localization_coord()
+
+do i=1, num
+ old_which = query_location(locs(i), 'which_vert')
+ if (old_which == wanted_vert) cycle
+
+ old_loc = locs(i)
+ old_array = get_location(locs(i))
+
+ old_which = query_location(locs(i), 'which_vert')
+ if (old_which == wanted_vert) cycle
+
+ call convert_vert(state_handle, old_array, old_which, old_loc, loc_qtys(i), new_array, new_which)
+
+ ! this is converting state locations. it shouldn't fail.
+ if(new_which == MISSING_I) then
+ istatus = 1
+ return
+ else
+ locs(i) = set_location(new_array(1), new_array(2), new_array(3), new_which)
+ endif
+enddo
+
+istatus = 0
+
+end subroutine convert_vertical_state
+
+
+!-----------------------------------------------------------------------
+
+subroutine convert_vert(state_handle, old_array, old_which, old_loc, old_kind, new_array, new_which)
+
+! Uses model information and subroutines to convert the vertical location of an ob
+! (prior, model state variable, or actual ob) into the standard vertical coordinate
+! (pressure or log_invP = log(P0/ps)).
+! Kevin Raeder 10/26/2006
+! updated 2014 for WACCM use; log_invP vertical coordinate.
+
+type(ensemble_type), intent(in) :: state_handle
+real(r8), intent(in) :: old_array(3)
+integer, intent(in) :: old_which
+type(location_type), intent(in) :: old_loc
+integer, intent(in) :: old_kind
+real(r8), intent(inout) :: new_array(3)
+integer, intent(out) :: new_which
+
+integer :: top_lev, bot_lev
+integer :: istatus(1), closest
+integer :: lon_ind, lat_ind, cam_type
+! p_surf dimensioned (1) because it's input to interp_lonlat,
+! which needs it to be an array because of RMA.
+real(r8) :: p_surf(1), frac, l, m, new_pressure
+type(location_type) :: temp_loc
+integer :: slon_index
+
+character(len=8) :: cam_varname
+integer :: ens_size ! To call interp_lonlat with ens_size of 1
+real(r8), allocatable :: p_col(:)
+real(r8), allocatable :: model_h(:)
+
+ens_size = 1
+
+!HK not building ps arrays.
+slon_index = find_name('slon',dim_names)
+
+! this code does not alter the lat/lon, only the vertical.
+! but still return a full location for subsequent use.
+new_array(1) = old_array(1)
+new_array(2) = old_array(2)
+
+! these should be set by the code below; it's an error if not.
+new_which = MISSING_I
+new_array(3) = MISSING_R8
+allocate(p_col(lev%length))
+
+if (.not. (old_which == VERTISPRESSURE .or. old_which == VERTISHEIGHT .or. &
+ old_which == VERTISLEVEL .or. old_which == VERTISSURFACE .or. &
+ old_which == VERTISUNDEF .or. old_which == VERTISSCALEHEIGHT) ) then
+ ! There's no procedure to translate a which_vert value into text.
+ ! So I'll just point users to location_mod.
+ write(string1,'(A,3(F12.5,1x),A,I2)') 'obs at (', old_array, &
+ ') has unsupported vertical type = ',old_which
+ write(string2,*) 'See location_mod.f90; VERTISxxx to decode this vertical type'
+ call error_handler(E_ERR, 'convert_vert', string1,source,revision,revdate,text2=string2)
+endif
+
+! Need lon and lat indices to select ps for calc of p_col for vertical conversion.
+
+! Find the surface pressure and the column of pressures at this location.
+if (old_which == VERTISLEVEL ) then
+ ! This assumes that if VERTISLEVEL, then the potentially close 'ob' is a
+ ! model state variable, defined at a grid point. So we can figure out the
+ ! grid indices and grab the surface pressure from the global ps array.
+ ! This may not be true; there can be observations on a model level which
+ ! don't lie on a grid point. Then this vertical coordinate conversion
+ ! will be more approximate than if we interpolated the pressure to the
+ ! actual 'ob' horizontal location.
+ cam_type = find_name(dart_to_cam_types(old_kind),cflds)
+ if (cam_type < 0) then
+ write(string1,*)'old_kind is ',old_kind,' | cam_type is ',cam_type
+ write(string2,*)'get_name_for_quantity of old_kind ', trim(get_name_for_quantity(old_kind))
+ call error_handler(E_ERR,'convert_vert',string1,source,revision,revdate,text2=string2)
+ endif
+
+ ! Assumes 2D obs locations are (lon, lat) and 3D are (lev,lon,lat).
+
+ ! Get the column of pressures at this location, from the ensemble mean.
+
+ cam_varname = trim(cflds(cam_type))
+ if (cam_varname == 'US') then
+ call coord_index('lon', old_array(1), lon_ind)
+ call coord_index('slat', old_array(2), lat_ind)
+ !p_surf = ps_stagr_lat(lon_ind,lat_ind)
+ p_surf = 0.5*(get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind) + &
+ get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind +1) )
+ ! WHAT ABOUT FIELDS THAT MIGHT COME ON ilevS ? have lev_which_dimid from above;
+ ! test = ilev%dim_id or lev%dim_id
+ call plevs_cam(p_surf(1), lev%length, p_col)
+ elseif (cam_varname == 'VS') then
+ call coord_index('slon', old_array(1), lon_ind)
+ call coord_index('lat', old_array(2), lat_ind)
+ !p_surf = ps_stagr_lon(lon_ind,lat_ind)
+ if ( lon_ind == 1 ) then
+ p_surf = 0.5*(get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind) + &
+ get_surface_pressure(state_handle, ens_size, dim_sizes(slon_index), lat_ind) )
+ else
+ p_surf = 0.5*(get_surface_pressure(state_handle, ens_size, lon_ind -1, lat_ind) + &
+ get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind) )
+ endif
+ call plevs_cam(p_surf(1), lev%length, p_col)
+ else
+ call coord_index('lon', old_array(1), lon_ind)
+ call coord_index('lat', old_array(2), lat_ind)
+ !p_surf = ps(lon_ind,lat_ind)
+ p_surf = get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind)
+ call plevs_cam(p_surf(1), lev%length, p_col)
+ endif
+else
+ ! Make a vertical location that has a vert type of surface.
+ ! Don't need lon_lat_vert array because old_array is passed in,
+ ! which is get_location(old_loc)
+ temp_loc = set_location(old_array(1), old_array(2), 0.0_r8, VERTISSURFACE)
+ ! Find ps at the ob point. Need to interpolate.
+ ! Only interested in P (columns), so don't need to worry about staggered grids here.
+ call interp_lonlat(state_handle, ens_size, temp_loc, QTY_SURFACE_PRESSURE, p_surf, istatus)
+ if (istatus(1) == 1) then
+ write(string1,'(A,I8)') 'interp_X failed for QTY_SURFACE_PRESSURE.'
+ call write_location(0, old_loc, charstring=string2)
+ call error_handler(E_ERR, 'convert_vert', string1,source,revision,revdate, text2=string2)
+ endif
+
+ call plevs_cam(p_surf(1), lev%length, p_col)
+
+endif
+
+! Convert vertical coordinate to vert_coord (pressure or log_invP).
+if (old_which == VERTISUNDEF) then
+ ! Field with no vertical location; get_dist will only calculate horiz dist unless
+ ! this case is handled by the calling routine.
+
+ ! If a parameter/state variable is supposed to be close to everything,
+ ! then I would need to have the/an other location to set it to,
+ ! Send back new_array empty and test for that in the calling routine,
+ ! where the other location exists.
+ ! For model variables user specifies which_vert for each state field,
+ ! so when user specifies undefined, then this should return;
+ new_array(3) = MISSING_R8
+ new_which = old_which
+
+elseif (old_which == VERTISSURFACE) then
+ ! surface field; change which_vert for the distance calculation
+ if (vert_coord == 'pressure') then
+ new_array(3) = p_surf(1)
+ new_which = VERTISPRESSURE
+ elseif (vert_coord == 'log_invP') then
+ ! Scale height at the surface is 0.0_r8 by definition [log(p_surf/p_surf)]
+ new_array(3) = 0.0_r8
+ new_which = VERTISSCALEHEIGHT
+ endif
+
+elseif (old_which == VERTISPRESSURE) then
+ if (vert_coord == 'pressure') then
+ new_array(3) = old_array(3)
+ new_which = VERTISPRESSURE
+ elseif (vert_coord == 'log_invP') then
+ new_array(3) = scale_height(p_surface=p_surf(1), p_above=old_array(3))
+ new_which = VERTISSCALEHEIGHT
+ endif
+
+elseif (old_which == VERTISSCALEHEIGHT) then
+ if (vert_coord == 'pressure') then
+ new_array(3) = p_surf(1) / exp(old_array(3))
+ new_which = VERTISPRESSURE
+ elseif (vert_coord == 'log_invP') then
+ new_array(3) = old_array(3)
+ new_which = old_which
+ endif
+
+elseif (old_which == VERTISLEVEL) then
+ ! FIXME
+ ! WHAT ABOUT FIELDS THAT MIGHT COME ON ilevS ? have lev_which_dimid from above;
+ ! test = ilev%dim_id or lev%dim_id
+ ! OR do this for all columns in static_init_model_dist, which would make PS (and P)
+ ! globally available for all regions?
+ if (vert_coord == 'pressure') then
+ new_array(3) = p_col(nint(old_array(3)))
+ new_which = VERTISPRESSURE
+ elseif (vert_coord == 'log_invP') then
+ new_array(3) = scale_height(p_surface=p_surf(1), p_above=p_col(nint(old_array(3))))
+ new_which = VERTISSCALEHEIGHT
+ endif
+
+elseif (old_which == VERTISHEIGHT) then
+
+ allocate(model_h(lev%length))
+ call model_heights(state_handle, ens_size, lev%length, p_surf(1), old_loc, model_h, istatus(1))
+ if (istatus(1) == 1) then
+ write(string1, *) 'model_heights failed'
+ call error_handler(E_ERR, 'convert_vert', string1)
+ ! return
+ endif
+
+ ! Search down through heights
+ ! This assumes linear relationship of pressure to height over each model layer,
+ ! when really it's exponential. How bad is that?
+! bot_lev = 2
+! do while (old_array(3) <= model_h(bot_lev) .and. bot_lev <= lev%length)
+! bot_lev = bot_lev + 1
+! end do
+ Bottom: do bot_lev = 2,lev%length
+ if (old_array(3) > model_h(bot_lev) .or. bot_lev == lev%length) exit Bottom
+ end do Bottom
+ if (bot_lev > lev%length) bot_lev = lev%length
+ top_lev = bot_lev - 1
+
+ ! Write warning message if not found within model level heights.
+ ! Maybe this should return failure somehow?
+ if (top_lev == 1 .and. old_array(3) > model_h(1)) then
+ ! above top of model
+ frac = 1.0_r8
+ write(string1, *) 'ob height ',old_array(3),' above CAM levels at ' &
+ ,old_array(1) ,old_array(2) ,' for kind',old_kind
+ call error_handler(E_MSG, 'convert_vert', string1,source,revision,revdate)
+ elseif (bot_lev <= lev%length) then
+ ! within model levels
+ frac = (old_array(3) - model_h(bot_lev)) / (model_h(top_lev) - model_h(bot_lev))
+ else
+ ! below bottom of model
+ frac = 0.0_r8
+ write(string1, *) 'ob height ',old_array(3),' below CAM levels at ' &
+ ,old_array(1) ,old_array(2) ,' for kind',old_kind
+ call error_handler(E_MSG, 'convert_vert', string1,source,revision,revdate)
+ endif
+
+ new_pressure = (1.0_r8 - frac) * p_col(bot_lev) + frac * p_col(top_lev)
+
+ if (vert_coord == 'pressure') then
+ new_array(3) = new_pressure
+ new_which = VERTISPRESSURE
+ else if (vert_coord == 'log_invP') then
+ new_array(3) = scale_height(p_surface=p_surf(1), p_above=new_pressure)
+ new_which = VERTISSCALEHEIGHT
+ endif
+
+ deallocate(model_h)
+
+else
+ write(string1, *) 'model which_vert = ',old_which,' not handled in convert_vert '
+ call error_handler(E_ERR, 'convert_vert', string1,source,revision,revdate)
+endif
+
+deallocate(p_col)
+
+return
+
+end subroutine convert_vert
+
+! End of get_close section
+
+!#######################################################################
+
+! Initial conditions for DART
+
+!------------------------------------------------------------------
+!> Perturbs a model state copy for generating initial ensembles.
+!> Routine which could provide a custom perturbation routine to
+!> generate initial ensembles. The default (if interface is not
+!> provided) is to add gaussian noise to each item in the state vector.
+!>
+!> It is controlled by model_nml namelist variables.
+!> There are two modes of perturbation. The most common will perturb
+!> every state variable by a small random amount.
+!> See model_mod.html for details.
+!>
+!> @param[in] state(:)
+!> The model state which will be perturbed
+!>
+!> @param[out] pert_state(:)
+!> The perturbed model state
+!>
+!> @param[out] interf_provided
+!> A flag to tell filter that this perturbation interface has been provided to it.
+
+subroutine pert_model_copies(state_handle, ens_size, pert_amp, interf_provided)
+
+type(ensemble_type), intent(inout) :: state_handle
+integer, intent(in) :: ens_size
+real(r8), intent(in) :: pert_amp
+logical, intent(out) :: interf_provided
+
+type(model_type) :: var_temp
+integer :: j, k, m, pert_fld, mode, field_num
+integer :: dim1, dim2, dim3, member
+integer, save :: seed
+logical :: perturbed
+integer(i8) :: start_index, end_index, i ! for a variable
+integer :: copy
+real(r8) :: random_number
+
+! The input is a single model state vector that has (different) gaussian
+! noise added to each member to generate an initial ensemble.
+
+if (.not. module_initialized) call static_init_model()
+
+interf_provided = .true.
+
+! This will make the results reproduce for runs with the same number of MPI tasks.
+! It will NOT give the same random sequence if you change the task count.
+k = (my_task_id()+1) * 1000
+call init_random_seq(random_seq, k)
+
+pert_fld = 1
+
+Vars2Perturb : do pert_fld=1,100
+ if (pert_names(pert_fld) == ' ') exit Vars2Perturb
+
+ ! Keep track of whether or not this field is matched and was perturbed.
+ perturbed = .false.
+
+ ExistingVars : do m=1,nflds
+
+ if (pert_names(pert_fld) /= cflds(m)) cycle ExistingVars
+
+ perturbed = .true.
+
+ start_index = get_index_start(component_id, m)
+ end_index = get_index_end(component_id, m)
+ if (output_task0) then
+ write(string1,'(3A,2I8,A,I8)') 'Perturbing ',trim(pert_names(pert_fld)), &
+ ' start,stop = ',start_index,end_index,' seed=', k
+ call error_handler(E_MSG,'pert_model_copies', string1)
+ endif
+
+ ! FIXME : below is not robust. ens_member is always 0 in CESM context.
+ ! Probably should remove this option from future versions; hasn't been used for years.
+
+ ! Choose mode of perturbations/resets;
+ if (pert_sd(pert_fld) <= 0.0_r8 ) then
+ ! Set each ensemble member to its own constant value,
+ ! as found in pert_base_vals(ens_member).
+ ! This only works when setting a single field = to a different constant value
+ ! for each ensemble member.
+ ! Could add more fields by overloading pert_base_vals and
+ ! adding code to find those values.
+ mode = ens_member
+ else
+ ! Set each *field* to it's own pert_base_val +/- pert_sd
+ mode = pert_fld
+ endif
+
+ if (print_details .and. output_task0) then
+ write(string1,'(2A,I8,A,1pE12.3)') &
+ ' WARNING: filter_nml:perturbation_amplitude is not being used. ', &
+ ' INSTEAD: model_nml:pert_sd(',mode,') = ',pert_sd(mode)
+ call error_handler(E_WARN,'pert_model_copies', string1)
+ endif
+
+ ! Handle the fields
+
+ ! reset base values to value provided in namelist.
+ if (pert_base_vals(mode) /= MISSING_R8) then
+ if (print_details) then
+ write(string1,*) 'Using a new base value ',pert_base_vals(mode), 'for ',cflds(m)
+ call error_handler(E_MSG, 'pert_model_copies', string1, source, revision, revdate)
+ endif
+ where (state_handle%my_vars > start_index .and. state_handle%my_vars < end_index)
+ state_handle%copies(copy, :) = pert_base_vals(mode)
+ endwhere
+ endif
+
+ ! randomly perturb each point around its base value.
+ if (pert_sd(pert_fld) > 0.0_r8 ) then
+ do i = 1, state_handle%my_num_vars
+ if (state_handle%my_vars(i) >= start_index .and. state_handle%my_vars(i) <= end_index) then
+ do copy = 1, ens_size
+! RMA-KR This looks like it gives the same seed to each member.
+! But this is how it was done in the trunk, which worked.
+ state_handle%copies(copy, i) = random_gaussian(random_seq, state_handle%copies(copy, i), pert_sd(mode))
+ enddo
+ endif
+ enddo
+ endif
+
+ enddo ExistingVars
+
+ if (.not. perturbed) then
+ write(string1,*)trim(pert_names(pert_fld)),' not found in list of state variables.'
+ write(string2,*)'but was supposed to be used to perturb.'
+ call error_handler(E_ERR,'pert_model_copies', string1, source, revision, revdate, text2=string2)
+ endif
+
+enddo Vars2Perturb
+
+end subroutine pert_model_copies
+
+! End of initial model state section
+
+!#######################################################################
+
+! Utility routines; called by several main subroutines
+
+!-----------------------------------------------------------------------
+
+function index_from_grid(lev_ind, lon_ind, lat_ind, ifld)
+
+! Calculate the index into the state vector, given the coordinate indices
+! and the field number (out of nflds state vector fields).
+
+integer, intent(in) :: lev_ind
+integer, intent(in) :: lon_ind
+integer, intent(in) :: lat_ind
+integer, intent(in) :: ifld
+integer(i8) :: index_from_grid
+
+integer :: i, j, k
+
+i = -1
+j = -1
+k = -1
+
+! Need to convert from lev_ind, lon_ind, lat_ind to i, j, k
+!> @todo Should just store staggared info for each ifld in static_init_model_mod
+!RMA-KR; these sections could be condensed into 1, inside a loop over the 3 dimensions,
+! by defining ijk(3)
+if (get_dim_name(component_id, ifld, 1) == 'lev') i = lev_ind
+if (get_dim_name(component_id, ifld, 1) == 'lon' .or. &
+ get_dim_name(component_id, ifld, 1) == 'slon') i = lon_ind
+if (get_dim_name(component_id, ifld, 1) == 'lat' .or. &
+ get_dim_name(component_id, ifld, 1) == 'slat') i = lat_ind
+
+if (get_dim_name(component_id, ifld, 2) == 'lev') j = lev_ind
+if (get_dim_name(component_id, ifld, 2) == 'lon' .or. &
+ get_dim_name(component_id, ifld, 2) == 'slon') j = lon_ind
+if (get_dim_name(component_id, ifld, 2) == 'lat' .or. &
+ get_dim_name(component_id, ifld, 2) == 'slat') j = lat_ind
+
+
+if (get_dim_name(component_id, ifld, 3) == 'lev') k = lev_ind
+if (get_dim_name(component_id, ifld, 3) == 'lon' .or. &
+ get_dim_name(component_id, ifld, 3) == 'slon') k = lon_ind
+if (get_dim_name(component_id, ifld, 3) == 'lat' .or. &
+ get_dim_name(component_id, ifld, 3) == 'slat') k = lat_ind
+
+index_from_grid = get_dart_vector_index(i, j, k, component_id, ifld)
+
+
+end function index_from_grid
+
+!-----------------------------------------------------------------------
+
+function find_name(nam, list)
+
+character(len=*), intent(in) :: nam
+character(len=*), intent(in) :: list(:)
+integer :: find_name
+
+integer :: i
+
+! find_name = 0
+find_name = MISSING_I
+do i = 1,size(list,1)
+if (nam == list(i)) then
+ find_name = i
+ return
+endif
+enddo
+
+end function find_name
+
+!-----------------------------------------------------------------------
+
+subroutine coord_val(dim_name, indx, lon_val, lat_val, lev_val)
+
+! Given the name of the coordinate to be searched and the index into that array,
+! returns the coordinate value in either lon_val, lat_val, or lev_val.
+! All 3 _val arguments are present so that this routine can return the value
+! in the coordinate that the calling routine wants it to be, and search/placement doesn't
+! have to be done there.
+
+character(len=*), intent(in) :: dim_name
+integer, intent(in) :: indx
+real(r8), intent(inout) :: lon_val
+real(r8), intent(inout) :: lat_val
+real(r8), intent(inout) :: lev_val
+
+! Check for acceptable value of indx?
+! FIXME; replace these ifs with select case and add a failure case.
+
+if (dim_name == 'lon') lon_val = lon%vals(indx)
+if (dim_name == 'lat') lat_val = lat%vals(indx)
+if (dim_name == 'slon') then
+ lon_val = slon%vals(indx)
+ ! CAM staggered longitude grid -2.5, ..., 352.5 (FV4x5)
+ ! but DART wants to see 0.,...,360. only.
+ if (lon_val < 0.0_r8) lon_val = lon_val + 360.0_r8
+endif
+if (dim_name == 'slat') lat_val = slat%vals(indx)
+! RMA-KR; the ncol section was removed for this CAM-FV model_mod.
+! Will be needed for the CAM-SE version.
+
+if (lat_val <= -90.0_r8) lat_val = -89.9999999_r8
+if (lat_val >= 90.0_r8) lat_val = 89.9999999_r8
+
+! FIXME this is returning the NOMINAL vertical location (to get_state_meta_data)
+! Is that good enough? Or do I need to calculate the actual vertical location?
+! This IS good enough for the calls in interp_lonlat because only lat_val is set by those calls.
+! 2FIXME: lev from the initial file is for PS = 1000 hPa (not 10^5 Pa); missing topography and weather.
+! So it's useless for our purposes. (It's not even consistent with units of PS).
+! if (dim_name == 'lev') lev_val = lev%vals(indx) * 100.0_r8
+! if (dim_name == 'ilev') lev_val = ilev%vals(indx) * 100.0_r8
+! Any need for the lev pressure values will be calculated in get_close_obs:convert_vert.
+if (dim_name == 'lev' .or. dim_name == 'ilev') then
+ lev_val = real(indx)
+endif
+! Add more for other coords? hyam...? Not for now; never referenced indirectly
+
+end subroutine coord_val
+
+!-----------------------------------------------------------------------
+
+subroutine coord_index(dim_name, val, indx, other_indx)
+
+! Given the name of the (Eulerian or FV) coordinate to be searched and the value,
+! Returns the index of the closest coordinate value.
+! Optionally returns the next closest index too, which may be < or > the closest.
+
+character(len=*), intent(in) :: dim_name
+real(r8), intent(in) :: val
+integer, intent(out) :: indx
+integer, optional, intent(out) :: other_indx
+
+real(r8), pointer :: coord(:)
+real(r8) :: diff_upper, diff_lower, val_local, resol
+integer :: coord_len, i
+
+nullify(coord)
+val_local = val
+
+if (dim_name == 'lon') then
+ coord => lon%vals
+ coord_len = lon%length
+ resol = lon%resolution
+elseif (dim_name == 'lat') then
+ coord => lat%vals
+ coord_len = lat%length
+ resol = lat%resolution
+elseif (dim_name == 'lev') then
+ coord => lev%vals
+ coord_len = lev%length
+ resol = lev%resolution
+elseif (dim_name == 'slon') then
+ coord => slon%vals
+ coord_len = slon%length
+ resol = slon%resolution
+ ! Make sure longitudes conform to the CAM staggered grid.
+ if ((val - coord(coord_len)) >= (coord(coord_len)-coord(coord_len-1))) &
+ val_local = val_local - 360.0_r8
+elseif (dim_name == 'slat') then
+ coord => slat%vals
+ coord_len = slat%length
+ resol = slat%resolution
+elseif (dim_name == 'ilev') then
+ coord => ilev%vals
+ coord_len = ilev%length
+ resol = ilev%resolution
+else
+ ! should not happen; fatal error.
+ write(string1, *) 'unexpected dim_name, ', trim(dim_name)
+ call error_handler(E_ERR, 'coord_index', string1,source,revision,revdate)
+endif
+
+! Assumes that coordinates are monotonic.
+
+if (val_local <= coord(1)) then
+ indx = 1
+ if (present(other_indx)) other_indx = 1
+ nullify (coord)
+ return
+elseif (val_local >= coord(coord_len)) then
+ indx = coord_len
+ if (present(other_indx)) other_indx = coord_len
+ nullify (coord)
+ return
+else
+ if (resol > 0.0_r8) then
+ ! regularly spaced; calculate the index
+ ! NINT is used because some calls to this routine want the single closest indx,
+ ! regardless of whether val_local is < or > coord(indx).
+ indx = NINT((val_local - coord(1))/resol) + 1
+
+ if (present(other_indx)) then
+ if (val_local > coord(indx)) then
+ other_indx = indx + 1
+ else
+ other_indx = indx - 1
+ endif
+ endif
+ else
+ ! IRregularly spaced (but still monotonically increasing); search for the index
+ ! Replace with a binary search?
+ do i=1, coord_len - 1
+ diff_upper = coord(i+1) - val_local
+ if (diff_upper >= 0.0_r8) then
+ diff_lower = val_local - coord(i)
+ ! Alway return the closer coord point in the first (non-optional) argument
+ if (diff_upper > diff_lower) then
+ indx = i
+ if (present(other_indx)) other_indx = i + 1
+ else
+ indx = i + 1
+ if (present(other_indx)) other_indx = i
+ endif
+ nullify (coord)
+ return
+ endif
+ enddo
+ endif
+endif
+! Try reclaiming coord memory before returning.
+nullify (coord)
+
+end subroutine coord_index
+
+!-----------------------------------------------------------------------
+
+function scale_height(p_surface, p_above)
+
+! Function to calculate scale height, given a surface pressure and a pressure.
+! Using the surface pressure instead of, e.g., mean sea level as the reference pressure
+! ensures that scale height is always positive.
+! FIXME; But is it a distortion to have the scale heights follow the terrain?
+
+real(r8), intent(in) :: p_surface
+real(r8), intent(in) :: p_above
+real(r8) :: scale_height
+
+scale_height = 5000.0_r8 ! arbitrary impossibly large number of scale heights.
+if (p_above > 0.0_r8) scale_height = log(p_surface/p_above)
+
+end function scale_height
+
+!-----------------------------------------------------------------------
+
+subroutine plevs_cam (p_surf, n_levels, pmid )
+
+! Define the pressures of the layer midpoints from the
+! coordinate definitions and the surface pressure.
+
+real(r8), intent(in) :: p_surf ! Surface pressure (pascals)
+integer, intent(in) :: n_levels
+real(r8), intent(out) :: pmid(lev%length) ! Pressure at model levels
+
+integer :: k
+
+! Set midpoint pressures and layer thicknesses
+
+do k=1,n_levels
+ pmid(k) = hyam%vals(k)*P0%vals(1) + hybm%vals(k)*p_surf
+enddo
+
+end subroutine plevs_cam
+
+!-----------------------------------------------------------------------
+
+subroutine model_heights(state_handle, ens_size, n_levels, p_surf, base_obs_loc, model_h, istatus)
+
+! This routine calculates geometrical height (m) at mid-layers of the CAM model
+!
+! was Hui's dcz2ccm1
+! has globally defined inputs:
+! hyam(lev%length),hybm(lev%length),hyai(lev%length),hybi(lev%length) =
+! hybrid vertical coefficients, top to bottom.
+! (P = P0*hyam + ps*hybm)
+! P0 - Hybrid base pressure (pascals)
+!
+! Kevin Raeder converted to single column version 4/28/2006
+! removed longitude dimension entirely and extra arrays 10/2006
+! 5/31/2013; Rewritten to adapt to convert_vert handling obs TYPEs,
+! not obs QTYs, and to handle lonlat and cubed sphere
+! grids/interpolations.
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+integer, intent(in) :: n_levels
+real(r8), intent(in) :: p_surf(ens_size)
+type(location_type), intent(in) :: base_obs_loc
+
+real(r8), intent(out) :: model_h(n_levels, ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+! local variables;
+real(r8), dimension(ens_size, n_levels) :: phi, tv, q, t, mmr_o1, mmr_o2, mmr_h1, mmr_n2
+real(r8), dimension(ens_size) :: h_surf, ht_tmp
+real(r8), dimension(n_levels+1,2) :: hybrid_As, hybrid_Bs
+
+! CS Should these come from common_mod?
+! That might be inconsistent with how levels, etc were defined in CAM originally.
+! DART's values are 287.0_r8 and 461.6_r8.
+real(r8), parameter :: rd = 287.05_r8
+real(r8), parameter :: rv = 461.51_r8
+real(r8), parameter :: rr_factor = (rv/rd) - 1.0_r8
+
+real(r8) :: lon_lat_lev(3)
+type(location_type) :: temp_obs_loc
+
+integer :: k, i, imem
+integer :: vstatus(ens_size)
+istatus(:) = 1
+model_h(:,:) = MISSING_R8
+
+! RMA-KR; CAM-SE section was removed from here.
+
+! lat, lon and vertical in height
+lon_lat_lev = get_location(base_obs_loc)
+
+!> @todo I don't think hybrid_As and hybrid_Bs change thoughout a run of filter
+! RMA-KR; That's true. They could be put in global storage and initialized in static_init_mod
+! after hy[ab][im] have been read in.
+! copy hybrid_As, hybrid_Bs to temporary arrays to pass to dcz2
+! All arrays except hybrid_As, hybrid_Bs are oriented top to bottom.
+
+! The 'interface' levels have an 'extra' level at model bottom, compared to the midpoint levels.
+! Initialize this extra level, before filling the rest in a loop.
+k = n_levels +1
+hybrid_As(1,1) = hyai%vals(k)
+hybrid_Bs(1,1) = hybi%vals(k)
+
+! hyam(n_levels) = 0 -> hybrid_As(2,2) = 0, so it
+! would be safe to set hybrid_As(1,2) = 0.
+! It's safe because this element is used to set pmln in dcz2, but that element of pmln is never used.
+hybrid_As(1,2) = 0.0_r8
+
+! hyb[im] have non-0 values at the bottom, 0s at the top;
+! hyb[im] coeffs multiply sigma in the calculation of pressure on levels,
+! and CAM's vertical coord is pure sigma at the bottom, so hybrid_Bs = 1.0 there.
+hybrid_Bs(1,2) = 1.0_r8
+
+! mid-points: 2nd dimension of hybrid_[AB]s = 2
+! note that hyXm(n_levels + 1) is not defined (= MISSING_R8)
+do k = 2,n_levels +1
+ i = n_levels +2 - k
+ hybrid_As(k,1) = hyai%vals(i)
+ hybrid_Bs(k,1) = hybi%vals(i)
+ hybrid_As(k,2) = hyam%vals(i)
+ hybrid_Bs(k,2) = hybm%vals(i)
+enddo
+
+! Calculate h_surf and tv for this column, for use by dcz2.
+call interp_lonlat(state_handle, ens_size, base_obs_loc, QTY_SURFACE_ELEVATION, h_surf, vstatus)
+if (any(vstatus == 1)) then
+ write(string1,'(A,1p3F12.6)') 'surface elevation could not be interpolated in interp_lonlat at ', &
+ lon_lat_lev
+ call error_handler(E_WARN, 'model_heights', string1)
+ return
+endif
+
+! loop through all levels to get the temperature and moisture.
+! the interp routine will return a vstatus of 2 when the level is
+! above the 'highest obs' threshold but we don't care about that here.
+! error out for other return code values, but continue if vstatus is
+! either 0 (all ok) or 2 (too high)
+do k = 1, n_levels
+ ! construct a location with the same lat/lon but cycle though the model levels
+ temp_obs_loc = set_location(lon_lat_lev(1), lon_lat_lev(2), real(k,r8), VERTISLEVEL)
+
+ call interp_lonlat(state_handle, ens_size, temp_obs_loc, QTY_TEMPERATURE, t(:, k), vstatus)
+ if (any(vstatus == 1)) then
+ write(string1,'(A,I2,A)') 'Temperature level ',k, &
+ ' could not be interpolated in interp_lonlat'
+ call error_handler(E_WARN, 'model_heights', string1)
+ return
+ endif
+ call interp_lonlat(state_handle, ens_size, temp_obs_loc, QTY_SPECIFIC_HUMIDITY, q(:, k), vstatus)
+ if (any(vstatus == 1)) then
+ write(string1,'(A,I2,A)') 'specific humidity level ',k, &
+ ' could not be interpolated in interp_lonlat'
+ call error_handler(E_WARN, 'model_heights', string1)
+ return
+ endif
+
+ tv(:, k) = t(:, k)*(1.0_r8 + rr_factor*q(:, k))
+enddo
+
+do imem = 1, ens_size
+ call dcz2(n_levels, p_surf(imem), h_surf(imem), tv(imem,:), P0%vals(1) , &
+ hybrid_As, hybrid_Bs, phi(imem,:))
+enddo
+
+! used; hybrid_Bs, hybrid_As, hprb
+! output from dcz2; phi
+
+! Conversion from geopotential height to geometric height depends on latitude
+! Convert to kilometers for gph2gmh call, then back to meters for return value.
+do k = 1,n_levels
+ ht_tmp(:) = phi(:, k) * 0.001_r8 ! convert to km for following call only
+ do imem = 1, ens_size
+ model_h(k, imem) = gph2gmh(ht_tmp(imem), lon_lat_lev(2)) * 1000.0_r8
+ enddo
+enddo
+
+! model_heights returns only istatus 0 or 1
+! RMA-KR; model_heights uses a somewhat different status strategy than get_val_...
+! It uses 'return's (istatus(:)(all) set to 1) if it fails along the way,
+! rather than continuing on with calculations for those members that don't fail.
+! So if we arrived here, all is well, and return 'success' in all values of istatus.
+!
+istatus = 0
+
+end subroutine model_heights
+
+!-----------------------------------------------------------------------
+
+subroutine dcz2(kmax,p_surf,h_surf,tv,hprb,hybrid_As,hybrid_Bs,z2)
+
+! Compute geopotential height for a CESM hybrid coordinate column.
+! All arrays except hybrid_As, hybrid_Bs are oriented top to bottom.
+! hybrid_[AB]s first subscript:
+! = 1 for layer interfaces
+! = 2 for layer midpoints
+! hybrid_As coord coeffs for P0 reference pressure term in plevs_cam
+! hybrid_Bs coord coeffs for surf pressure term in plevs_cam (in same format as hybrid_As)
+
+integer, intent(in) :: kmax ! Number of vertical levels
+real(r8), intent(in) :: p_surf ! Surface pressure (pascals)
+real(r8), intent(in) :: h_surf ! Surface height (m)
+real(r8), intent(in) :: tv(kmax) ! Virtual temperature, top to bottom
+real(r8), intent(in) :: hprb ! Hybrid base pressure (pascals)
+real(r8), intent(in) :: hybrid_As(kmax+1,2)
+real(r8), intent(in) :: hybrid_Bs(kmax+1,2)
+real(r8), intent(out) :: z2(kmax) ! Geopotential height, top to bottom
+
+! Local variables
+real(r8), parameter :: r = 287.04_r8 ! Different than model_heights !
+real(r8), parameter :: g0 = 9.80616_r8 ! Different than model_heights:gph2gmh:G !
+real(r8), parameter :: rbyg=r/g0
+real(r8) :: pterm(kmax) ! pressure profile
+real(r8) :: pmln(kmax+1) ! logs of midpoint pressures
+
+integer :: i,k,l
+real(r8) :: ARG
+
+! Compute intermediate quantities using scratch space
+
+! DEBUG: z2 was unassigned in previous code.
+z2(:) = MISSING_R8
+
+! Invert vertical loop
+! Compute top only if top interface pressure is nonzero.
+!
+! newFIXME; p_col could be used here, instead of (re)calculating it in ARG
+do K = kmax+1, 1, -1
+ i = kmax-K+2
+ ARG = hprb*hybrid_As(i,2) + p_surf *hybrid_Bs(i,2)
+ if (ARG > 0.0_r8) THEN
+ pmln(K) = LOG(ARG)
+ else
+ pmln(K) = 0.0_r8
+ endif
+enddo
+
+do K = 2,kmax - 1
+ pterm(k) = rbyg*tv(k)*0.5_r8* (pmln(k+1)-pmln(k-1))
+enddo
+
+! Initialize z2 to sum of ground height and thickness of top half layer
+! DEBUG; this is NOT adding the thickness of the 'top' half layer.
+! it's adding the thickness of the half layer at level K,
+do K = 1,kmax - 1
+ z2(k) = h_surf + rbyg*tv(k)*0.5_r8* (pmln(K+1)-pmln(K))
+enddo
+z2(kmax) = h_surf + rbyg*tv(kmax)* (log(p_surf*hybrid_Bs(1,1))-pmln(kmax))
+
+! DEBUG; THIS is adding the half layer at the BOTTOM.
+do k = 1,kmax - 1
+ z2(k) = z2(k) + rbyg*tv(kmax)* (log(p_surf*hybrid_Bs(1,1))-0.5_r8* &
+ (pmln(kmax-1)+pmln(kmax)))
+enddo
+
+! Add thickness of the remaining full layers
+! (i.e., integrate from ground to highest layer interface)
+
+do K = 1,kmax - 2
+ do L = K+1, kmax-1
+ z2(K) = z2(K) + pterm(L)
+ enddo
+enddo
+
+end subroutine dcz2
+
+!-----------------------------------------------------------------------
+
+function gph2gmh(h, lat)
+
+! Convert a list of geopotential altitudes to mean sea level altitude.
+
+real(r8), intent(in) :: h ! geopotential altitude (in km)
+real(r8), intent(in) :: lat ! latitude of profile in degrees.
+real(r8) :: gph2gmh ! MSL altitude, in km.
+
+real(r8), parameter :: be = 6356.7516_r8 ! min earth radius, km
+real(r8), parameter :: ae = 6378.1363_r8 ! max earth radius, km
+real(r8), parameter :: pi = 3.14159265358979_r8
+! FIXME; another definition of gravitational acceleration. See g0 and gravity_constant elsewhere.
+real(r8), parameter :: G = 0.00980665_r8 ! WMO reference g value, km/s**2, at 45.542N(S)
+
+real(r8) :: g0
+real(r8) :: r0
+real(r8) :: latr
+
+latr = lat * (pi/180.0_r8) ! in radians
+call gravity(latr, 0.0_r8, g0)
+
+! compute local earth's radius using ellipse equation
+
+r0 = sqrt( ae**2 * cos(latr)**2 + be**2 * sin(latr)**2)
+
+! Compute altitude above sea level
+gph2gmh = (r0 * h) / (((g0*r0)/G) - h)
+
+end function gph2gmh
+
+!-----------------------------------------------------------------------
+
+subroutine gravity(xlat,alt,galt)
+
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! This subroutine computes the Earth's gravity at any altitude
+! and latitude. The model assumes the Earth is an oblate
+! spheriod rotating at a the Earth's spin rate. The model
+! was taken from "Geophysical Geodesy, Kurt Lambeck, 1988".
+!
+! input: xlat, latitude in radians
+! alt, altitude above the reference ellipsiod, km
+! output: galt, gravity at the given lat and alt, km/sec**2
+!
+! Compute acceleration due to the Earth's gravity at any latitude/altitude
+! author Bill Schreiner 5/95
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+real(r8), intent(in) :: xlat
+real(r8), intent(in) :: alt
+real(r8), intent(out) :: galt
+
+real(r8),parameter :: xmu = 398600.4415_r8 ! km^3/s^2
+real(r8),parameter :: ae = 6378.1363_r8 ! km
+real(r8),parameter :: f = 1.0_r8/298.2564_r8
+real(r8),parameter :: w = 7.292115e-05_r8 ! rad/s
+real(r8),parameter :: xm = 0.003468_r8 !
+real(r8),parameter :: f2 = 5.3481622134089e-03_r8 ! f2 = -f + 5.0* 0.50*xm - 17.0/14.0*f*xm + 15.0/4.0*xm**2
+real(r8),parameter :: f4 = 2.3448248012911e-05_r8 ! f4 = -f**2* 0.50 + 5.0* 0.50*f*xm
+
+real(r8) :: ge
+real(r8) :: g
+
+
+! compute gravity at the equator, km/s2
+ge = xmu/ae**2/(1.0_r8 - f + 1.5_r8*xm - 15.0_r8/14.0_r8*xm*f)
+
+! compute gravity at any latitude, km/s2
+g = ge*(1.0_r8 + f2*(sin(xlat))**2 - 1.0_r8/4.0_r8*f4*(sin(2.0_r8*xlat))**2)
+
+! compute gravity at any latitude and at any height, km/s2
+galt = g - 2.0_r8*ge*alt/ae*(1.0_r8 + f + xm + (-3.0_r8*f + 5.0_r8* 0.50_r8*xm)* &
+ (sin(xlat))**2) + 3.0_r8*ge*alt**2/ae**2
+
+end subroutine gravity
+
+!-----------------------------------------------------------------------
+
+subroutine init_model_instance(var)
+
+! Initializes an instance of a cam model state variable
+
+type(model_type), intent(inout) :: var
+
+if (.not. module_initialized) call static_init_model()
+
+! Initialize the storage space and return
+
+! The temporary arrays into which fields are read are dimensioned by the largest values of
+! the sizes of the dimensions listed in f_dim_RANKd. Those are stored in f_dim_max.
+
+allocate(var%vars_0d( state_num_0d))
+allocate(var%vars_1d(f_dim_max(1,1), state_num_1d))
+allocate(var%vars_2d(f_dim_max(1,2),f_dim_max(2,2), state_num_2d))
+allocate(var%vars_3d(f_dim_max(1,3),f_dim_max(2,3),f_dim_max(3,3), state_num_3d))
+
+end subroutine init_model_instance
+
+!-----------------------------------------------------------------------
+
+subroutine end_model_instance(var)
+
+! Ends an instance of a cam model state variable
+
+type(model_type), intent(inout) :: var
+
+if (.not. module_initialized) call static_init_model()
+
+if (.not. allocated(var%vars_0d)) then
+ write(string1,*) 'Calling end_model_instance on an uninitialized state structure'
+ call error_handler(E_ERR,'end_model_instance',string1, source, revision, revdate)
+endif
+
+deallocate(var%vars_0d, var%vars_1d, var%vars_2d, var%vars_3d)
+
+end subroutine end_model_instance
+
+
+! End of utility routines
+
+!#######################################################################
+
+!-----------------------------------------------------------------------
+!>
+!> Subroutine end_model
+!> deallocates arrays that are in module global storage.
+
+subroutine end_model()
+
+deallocate(dim_names, dim_sizes, phis)
+deallocate(state_long_names, state_units)
+deallocate(cflds)
+
+if (allocated(f_dim_3d)) then
+ deallocate(f_dim_3d, f_dimid_3d)
+endif
+if (allocated(f_dim_2d)) then
+ deallocate(f_dim_2d, f_dimid_2d)
+endif
+if (allocated(f_dim_1d)) then
+ deallocate(f_dim_1d, f_dimid_1d)
+endif
+
+call end_grid_1d_instance(lon)
+call end_grid_1d_instance(lat)
+call end_grid_1d_instance(lev)
+call end_grid_1d_instance(gw)
+call end_grid_1d_instance(hyam)
+call end_grid_1d_instance(hybm)
+call end_grid_1d_instance(hyai)
+call end_grid_1d_instance(hybi)
+call end_grid_1d_instance(slon)
+call end_grid_1d_instance(slat)
+call end_grid_1d_instance(ilev)
+call end_grid_1d_instance(P0)
+
+end subroutine end_model
+
+!-------------------------------------------------------------------------
+!> This replaces set_ps_arrays. It handles the whole ensemble,
+!> when needed, as required by RMA.
+function get_surface_pressure(state_handle, ens_size, lon_ind, lat_ind)
+
+integer, intent(in) :: ens_size
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: lon_ind
+integer, intent(in) :: lat_ind
+
+real(r8) :: get_surface_pressure(ens_size)
+integer :: ifld ! pressure field index
+integer(i8) :: ind ! index into state vector
+
+ifld = find_name('PS ',cflds)
+
+! find index into state
+ind = index_from_grid(1, lon_ind, lat_ind, ifld)
+
+! get correct piece of state
+get_surface_pressure = get_state(ind, state_handle)
+
+end function get_surface_pressure
+
+!-----------------------------------------------------------------------
+subroutine update_vstatus(ens_size, current_vstatus, vstatus)
+
+integer, intent(in) :: ens_size
+integer, intent(in) :: current_vstatus(ens_size)
+integer, intent(out) :: vstatus(ens_size)
+logical :: bail_out ! quit because all the ensemble members have failed
+
+! RMA-KR; Is this bail_out code commented out because it's handled in the calling routines?
+!bail_out = .false.
+! only update if there are no previous failures
+where(vstatus == 0) vstatus = current_vstatus
+!if(all(vstatus /= 0)) bail_out = .true. ! Every ensemble member has reached failure
+
+end subroutine update_vstatus
+!-----------------------------------------------------------------------
+
+! RMA-KR; set_print_details is not used in this module.
+subroutine set_print_details(how)
+
+! reset the print_details module global variable to control
+! how much output there is
+
+logical, intent(in) :: how
+
+print_details = how
+
+end subroutine set_print_details
+
+!--------------------------------------------------------------------
+!> construct restart file name for reading
+!> model time for CESM format?
+function construct_file_name_in(stub, domain, copy)
+
+character(len=512), intent(in) :: stub
+integer, intent(in) :: domain
+integer, intent(in) :: copy
+character(len=256) :: construct_file_name_in
+
+! fv_testcase.cam_0003.i.2004-01-15-00000.nc
+! RMA-KR; Why is the file type (i) and date hard-wired?
+! Where is this used?
+! io/io_filenames_mod.f90; when restart name can't be read from rpointer, build a name.
+write(construct_file_name_in, '(A, i4.4, A)') TRIM(stub), copy, '.i.2004-01-15-00000.nc'
+
+end function construct_file_name_in
+
+!--------------------------------------------------------------------
+!> pass the vertical localization coordinate to assim_tools_mod
+function query_vert_localization_coord()
+
+integer :: query_vert_localization_coord
+
+query_vert_localization_coord = VERTISUNDEF
+
+if (vert_coord == 'pressure') query_vert_localization_coord = VERTISPRESSURE
+if (vert_coord == 'log_invP') query_vert_localization_coord = VERTISSCALEHEIGHT
+
+end function query_vert_localization_coord
+
+!--------------------------------------------------------------------
+!> read the time from the input file
+function read_model_time(file_name)
+
+character(len=256), intent(in) :: file_name
+
+type(time_type) :: read_model_time
+
+integer :: i, k, n, m, ifld
+integer :: nc_file_ID, nc_var_ID, dimid, varid, dimlen
+integer :: iyear, imonth, iday, ihour, imin, isec, rem
+integer :: timestep
+integer, allocatable :: datetmp(:), datesec(:)
+
+! read CAM 'initial' file domain info
+call nc_check(nf90_open(path=file_name, mode=nf90_nowrite, ncid=nc_file_ID), &
+ 'read_cam_init', 'opening '//trim(file_name))
+
+! Read the time of the current state.
+! CAM initial files have two variables of length 'time' (the unlimited dimension): date, datesec
+! The rest of the routine presumes there is but one time in the file -
+
+call nc_check(nf90_inq_dimid(nc_file_ID, 'time', dimid), &
+ 'read_cam_init', 'inq_dimid time '//trim(file_name))
+call nc_check(nf90_inquire_dimension(nc_file_ID, dimid, len=dimlen), &
+ 'read_cam_init', 'inquire_dimension time '//trim(file_name))
+
+if (dimlen /= 1) then
+ write(string1,*)trim(file_name),' has',dimlen,'times. Require exactly 1.'
+ call error_handler(E_ERR, 'read_cam_init', string1, source, revision, revdate)
+endif
+
+allocate(datetmp(dimlen), datesec(dimlen))
+
+call nc_check(nf90_inq_varid(nc_file_ID, 'date', varid), &
+ 'read_cam_init', 'inq_varid date '//trim(file_name))
+call nc_check(nf90_get_var(nc_file_ID, varid, values=datetmp), &
+ 'read_cam_init', 'get_var date '//trim(file_name))
+
+call nc_check(nf90_inq_varid(nc_file_ID, 'datesec', varid), &
+ 'read_cam_init', 'inq_varid datesec '//trim(file_name))
+call nc_check(nf90_get_var(nc_file_ID, varid, values=datesec), &
+ 'read_cam_init', 'get_var datesec '//trim(file_name))
+
+! for future extensibility, presume we find a 'timeindex' that we want.
+! Since we only support 1 timestep in the file, this is easy.
+
+timestep = 1
+
+! The 'date' is YYYYMMDD ... datesec is 'current seconds of current day'
+iyear = datetmp(timestep) / 10000
+rem = datetmp(timestep) - iyear*10000
+imonth = rem / 100
+iday = rem - imonth*100
+
+ihour = datesec(timestep) / 3600
+rem = datesec(timestep) - ihour*3600
+imin = rem / 60
+isec = rem - imin*60
+
+deallocate(datetmp, datesec)
+
+! some cam files are from before the start of the gregorian calendar.
+! since these are 'arbitrary' years, just change the offset.
+
+if (iyear < 1601) then
+ write(string1,*)' '
+ write(string2,*)'WARNING - ',trim(file_name),' changing year from ',iyear,'to',iyear+1601
+ call error_handler(E_MSG, 'read_cam_init', string1, source, revision, &
+ revdate, text2=string2,text3='to make it a valid Gregorian date.')
+ write(string1,*)' '
+ call error_handler(E_MSG, 'read_cam_init', string1, source, revision)
+ iyear = iyear + 1601
+endif
+
+read_model_time = set_date(iyear,imonth,iday,ihour,imin,isec)
+
+end function read_model_time
+
+!-----------------------------------------------------------------------
+!>@todo this routine should write the model time when
+!> creating files from scratch
+subroutine write_model_time(ncid, dart_time)
+
+integer, intent(in) :: ncid !< netcdf file handle
+type(time_type), intent(in) :: dart_time
+
+call error_handler(E_MSG, 'write_model_time', 'no routine for cam-fv write model time')
+
+end subroutine write_model_time
+
+
+!--------------------------------------------------------------------
+!> Construct an arry to pass to add_domain that contains the clamping info
+!> for each variable. Note for non-netcdf read this is done in write_cam_init
+subroutine set_clamp_fields(clampfield)
+
+real(r8), intent(out) :: clampfield(nflds, 2) ! min, max for each field
+
+integer :: i
+
+clampfield(:, :) = MISSING_R8 ! initalize to no clamping
+
+do i = 1, nflds
+ if(cflds(i) == 'Q') clampfield(i, 1) = 1.0e-12_r8
+ if(cflds(i) == 'CLDLIQ') clampfield(i, 1) = 0.0_r8
+ if(cflds(i) == 'CLDICE') clampfield(i, 1) = 0.0_r8
+enddo
+
+end subroutine
+
+!--------------------------------------------------------------------
+function get_lon_name(var)
+
+integer, intent(in) :: var ! s_type - order in state vectors
+character(len=8) :: get_lon_name
+
+integer :: i
+
+get_lon_name = 'lon' ! default to not staggered
+
+do i = 1, get_num_dims(component_id, var)
+ if (get_dim_name(component_id, var, i)=='slon') then
+ get_lon_name = 'slon'
+ exit
+ endif
+enddo
+
+end function get_lon_name
+
+!--------------------------------------------------------------------
+function get_lat_name(var)
+
+integer, intent(in) :: var ! s_type - order in state vectors
+character(len=8) :: get_lat_name
+
+integer :: i
+
+get_lat_name = 'lat' ! default to not staggered
+
+do i = 1, get_num_dims(component_id, var)
+ if (get_dim_name(component_id, var, i)=='slat') then
+ get_lat_name = 'slat'
+ exit
+ endif
+enddo
+
+end function get_lat_name
+
+!--------------------------------------------------------------------
+function get_lev_name(var)
+
+integer, intent(in) :: var ! s_type - order in state vectors
+character(len=8) :: get_lev_name
+
+integer :: i
+
+get_lev_name = 'lev' ! default to not staggered
+
+do i = 1, get_num_dims(component_id, var)
+ if (get_dim_name(component_id, var, i)=='ilev') then
+ get_lev_name = 'ilev'
+ exit
+ endif
+enddo
+
+end function get_lev_name
+
+!#######################################################################
+end module model_mod
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/models/cam-fv/shell_scripts/cesm2_0/setup_single_from_ens b/models/cam-fv/shell_scripts/cesm2_0/setup_single_from_ens
new file mode 100755
index 0000000000..1316dcc7a0
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_0/setup_single_from_ens
@@ -0,0 +1,810 @@
+#!/bin/csh -f
+
+#--------------------------------------------
+# The job name should be the name of this script(file),
+# or this file may not be archived in $caseroot causing DART_config to fail.
+#PBS -N setup_single_from_ens
+
+#PBS -A P86850054
+# #PBS -A your_account_there
+# #PBS -q shared_node_queue_for_this_setup_script
+#PBS -q share
+# Resources I want:
+# select=#nodes
+# ncpus=#CPUs/node
+# mpiprocs=#MPI_tasks/node
+#PBS -l select=1:ncpus=2:mpiprocs=2
+#PBS -l walltime=00:30:00
+
+# Send email after a(bort) or e(nd)
+#PBS -m ae
+#PBS -M you@email.org
+# #PBS -M raeder@ucar.edu
+
+# Send standard output and error to this file.
+# It's helpful to use the $casename here.
+#PBS -o Debug_hybrid.bld1
+#PBS -j oe
+#--------------------------------------------
+
+# ---------------------
+# Purpose
+#
+# This script is designed to set up, stage, and build a single-instance run
+# of CESM2 using an Fxxx compset, in which CAM, CLM, and CICE are active
+# and the initial conditions are taken froma single instance of a
+# multi-instance CAM forecast (the "reference case" or "REFCASE").
+# The case described here should have the exact same set of active physics
+# as the REFCASE, so that the restart files have matching lists of variables.
+
+# ==============================================================================
+# case options:
+#
+# case The value of "case" will be used many ways; directory and file
+# names both locally and on HPSS, and script names; so consider
+# its length and information content.
+# compset Defines the vertical resolution and physics packages to be used.
+# Must be a standard CESM compset; see the CESM documentation.
+# compset_args The local variable passed to create_newcase, which contains $compset
+# and any signal(s) that this compset is non-standard.
+# resolution Defines the horizontal resolution and dynamics; see CESM docs.
+# T85 ... eulerian at ~ 1 degree
+# ne30np4_gx1v6 ... SE core at ~ 1 degree
+# f09_f09 ... FV core at ~ 1 degree
+# BUG 1384 may apply, check if ocean and atm/land must be at same resolution.
+# Notes about the creation of the 0.25x0.25 ocean + 1deg FV resolution are in
+# /glade/work/raeder/Models/CAM_init/SST/README"
+# user_grid Tells create_newcase whether $resolution has any user defined grids,
+# such as the high resolution SST grid, and where to find the definition of that resolution.
+# cesmtag The version of the CESM source code to use when building the code.
+# A directory with this name must exist in your home directory,
+# and have SourceMods in it. See the SourceMods section.
+# http://www.image.ucar.edu/pub/DART/CESM/README
+# sourcemods DART no longer requires a SourceMods directory in order to work with CESM.
+# If you have modifications to CESM, they should be provided in a
+# CESM-structured SourceMods directory, which this script expects to be in
+# $user/$cesmtag/SourceMods.
+# ==============================================================================
+
+setenv case Debug_hybrid
+
+setenv compset HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+# setenv compset F2000_DEV
+
+setenv compset_args "--run-unsupported --compset $compset"
+
+# A grid long name may need to be in the --res argument,
+# even if an alias is defined for the user's grid.
+# (2018-10-11 create_newcase --help says a long name must be used,
+# but that is incorrect according ot Jim Edwards and experience;
+# an alias must be used.)
+# set resolution = a%0.9x1.25_l%0.9x1.25_oi%d.25x.25_r%r05_m%d.25x.25_g%null_%null
+setenv resolution f09_d025
+
+# CESM2; set user_grid to '' to use standard SST files
+# or '--user-grid' for hi-res (user-defined)
+set user_grid = '--user-grid'
+if ($user_grid !~ '') then
+ # --gridfile must have the name of a config_grids.xml file
+ # which has the user's grid installed in it.
+ set user_grid = "${user_grid} --gridfile /glade/work/raeder/Models/CAM_init/SST"
+ set user_grid = "${user_grid}/config_grids+fv1+2deg_oi0.25_gland20.xml"
+ # If the glc/CISM resolution is changed, also change GLC_GRID below.
+endif
+echo "user_grid is $user_grid"
+
+setenv cesmtag cesm2_0
+setenv sourcemods ~/${cesmtag}/SourceMods
+
+setenv num_instances 1
+
+# ==============================================================================
+# machines and directories:
+#
+# mach Computer name
+# cesmroot Location of the CESM code base.
+# This version of the script only supports version cesm2_#.
+# Alternative locations might be
+# /glade/p/cesm/cseg/collections/${cesmtag} for a released model on cheyenne
+# /glade/p/cesmdata/cseg/.dev/${cesmtag} for beta tags.
+# caseroot Will create the CESM case directory here, where the CESM+DART
+# configuration files will be stored. This should probably not
+# be in scratch (on yellowstone, your 'work' partition is suggested).
+# This script will delete any existing caseroot, so this script,
+# and other useful things should be kept elsewhere.
+# cesmdata Location of some supporting CESM data files.
+# rundir Will create the CESM run directory here. Will need large
+# amounts of disk space, generally on a scratch partition.
+# exeroot Will create the CESM executable directory here, where the
+# CESM executables will be built. Medium amount of space
+# needed, generally on a scratch partition.
+# archdir Will create the CESM short-term archive directories here.
+# Large, generally on a scratch partition. Files will remain
+# here until the long-term archiver moves it to permanent storage.
+# ==============================================================================
+
+setenv mach cheyenne
+
+setenv cesmroot /glade/work/${USER}/Models/${cesmtag}
+setenv caseroot /glade/work/${USER}/Exp/${case}
+setenv cesmdata /gpfs/fs1/p/cesmdata/cseg/inputdata/glade/p/cesmdata/cseg/inputdata
+
+setenv rundir /glade/scratch/${USER}/${case}/run
+setenv exeroot /glade/scratch/${USER}/${case}/bld
+setenv archdir /glade/scratch/${USER}/${case}/archive
+
+# ==============================================================================
+# runtime settings:
+#
+# starttype 'branch' for an exact restart from the REFCASE CAM restart file
+# 'hybrid' for starting from REFCASE CAM initial file, like assimilations do.
+
+# refcase The multi-instance case name, from which the IC files will come.
+# refyear Year of the refcase
+# refmon Month (2 digits)
+# refday Day (2 digits)
+# reftod Time (5 digits, seconds)
+# stagedir Script "stage_cesm_files" (below) stages the files from $refcase
+# into the run directory, with single instance names.
+# inst The instance number of the refcase to use as the ICs
+# Usually this will be an instance that died,
+# but could be a healthy instance to use for comparison.
+
+# start_year Generally this is the same as the reference case date,
+# stop_year The end year of the SST data file.
+# start_month but it can be different if you want to start this run
+# start_day as if it was a different time.
+# start_tod (Same formats as refYYY)
+#
+# sst_use_defaults Controls what data ocean files are used.
+# 'true' makes CESM use default files, which are climatological, not monthly,
+# 'false' requires you to supply a set of files; monthly or high resolution.
+# Also be sure to set $user_grid correctly.
+# sst_dataset Data ocean file
+# sst_grid Supporting (consistent) grid file
+# sst_year_start Years included in the sst files.
+# sst_year_end
+# The default SST (as of 2015-3) goes through 2012.
+# Don't use the last few months, since they are incomplete.
+#
+# short_term_archiver Copies the files from each job step to a 'rest' directory.
+#
+# resubmit How many job steps to run on continue runs (should be 0 initially)
+# stop_option Units for determining the forecast length between assimilations
+# stop_n Number of time units in each forecast
+#
+# If the long-term archiver is off, you get a chance to examine the files before
+# they get moved to long-term storage. You can always submit $CASE.l_archive
+# whenever you want to free up space in the short-term archive directory.
+# ==============================================================================
+
+setenv starttype 'hybrid'
+
+setenv refcase CAM6_80mem
+setenv refyear 2010
+setenv refmon 07
+setenv refday 03
+setenv reftod 64800
+setenv stagedir /glade/scratch/${USER}/${refcase}/run
+setenv inst 3
+
+setenv start_year $refyear
+setenv stop_year $start_year
+setenv start_month $refmon
+setenv start_day $refday
+setenv start_tod $reftod
+
+# useful combinations of time that we use below
+setenv refdate $refyear-$refmon-$refday
+setenv reftimestamp $refyear-$refmon-$refday-$reftod
+
+setenv sst_use_defaults 'false'
+
+if ($sst_use_defaults == 'false') then
+ # Daily, 1/4-degree SSTs from Reynolds,...,Tomas
+ # These require the new 'resolution', as described in the argument to --user-grid, above.
+ # WARNING; these files must have the 'calendar=gregorian' attribute added to the variable 'time',
+ # which can be done with $p/Models/CAM_init/SST/add_calendar_attr.csh.
+ setenv sst_dataset \
+ "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20100101_cat_20101231_filled_c130829.nc"
+# "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20130101_cat_20130731_filled_c170223.nc"
+ setenv sst_grid /glade/work/raeder/Models/CAM_init/SST/domain.ocn.d025.120821.nc
+ setenv sst_year_start $start_year
+ setenv sst_year_end $stop_year
+ # Monthly, 1 degree data set.
+# setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2013_c140701.nc
+# setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv0.9x1.25_gx1v6.130409.nc
+# setenv sst_year_start 1850
+# setenv sst_year_end 2013
+endif
+setenv short_term_archiver off
+
+setenv resubmit 0
+setenv stop_option nhours
+setenv stop_n 2
+
+# ==============================================================================
+# job settings:
+#
+# queue can be changed during a series by changing the ${case}.run
+# timewall can be changed during a series by changing the ${case}.run
+#
+# TJH: Advancing 30 instances for 6 hours and assimilating took
+# less than 10 minutes on yellowstone using 1800 pes (120 nodes)
+# ==============================================================================
+
+setenv ACCOUNT P86850054
+# setenv ACCOUNT Your_account
+setenv queue economy
+setenv timewall 0:15
+
+# ==============================================================================
+# standard commands:
+
+# This prevents user's aliases from giving unintended results.
+
+# The FORCE options are not optional.
+# The VERBOSE options are useful for debugging though
+# some systems don't like the -v option to any of the following
+
+if ($?LS_SUBCWD) then
+ echo "changing directory to $LS_SUBCWD"
+ cd $LS_SUBCWD
+else if ($?PBS_O_WORKDIR) then
+ echo "changing directory to $PBS_O_WORKDIR"
+ cd $PBS_O_WORKDIR
+endif
+
+set MOVE = '/bin/mv -f'
+set COPY = '/bin/cp -f --preserve=timestamps'
+set LINK = '/bin/ln -fs'
+set REMOVE = '/bin/rm -fr'
+
+# If your shell commands don't like the -v option and you want copies to be echoed,
+# set this to be TRUE. Otherwise, it should be FALSE.
+set COPYV = FALSE
+set REMOVEV = FALSE
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+# ==============================================================================
+# ==============================================================================
+# Make sure the CESM directories exist.
+# VAR is the shell variable name, DIR is the value
+# ==============================================================================
+
+foreach VAR ( cesmroot )
+ set DIR = `eval echo \${$VAR}`
+ if ( ! -d $DIR ) then
+ echo "ERROR: directory '$DIR' not found"
+ echo " In the setup script check the setting of: $VAR "
+ exit 10
+ endif
+end
+
+# ==============================================================================
+# Create the case - this creates the CASEROOT directory.
+#
+# For list of the pre-defined component sets: ./create_newcase -list
+# To create a variant compset, see the CESM documentation and carefully
+# incorporate any needed changes into this script.
+# ==============================================================================
+
+# fatal idea to make caseroot the same dir as where this setup script is
+# since the build process removes all files in the caseroot dir before
+# populating it. try to prevent shooting yourself in the foot.
+
+if ( $caseroot == `dirname $0` ) then
+ echo "ERROR: the setup script should not be located in the caseroot"
+ echo "directory, because all files in the caseroot dir will be removed"
+ echo "before creating the new case. move the script to a safer place."
+ exit 20
+endif
+
+echo "removing old files from ${caseroot}"
+echo "removing old files from ${exeroot}"
+echo "removing old files from ${rundir}"
+${REMOVE} ${caseroot}
+${REMOVE} ${exeroot}
+${REMOVE} ${rundir}
+
+# CIMEROOT Must be set before create_newcase.
+setenv CIMEROOT $cesmroot/cime
+
+${CIMEROOT}/scripts/create_newcase \
+ --case ${caseroot} \
+ --mach ${mach} \
+ --queue $queue \
+ --walltime $timewall \
+ --res ${resolution} ${compset_args} ${user_grid}
+
+set cr_stat = $status
+if ( $cr_stat != 0 ) then
+ echo "ERROR: Case could not be created. Code $cr_stat"
+ exit 30
+endif
+
+# Preserve a copy of this script as it was run. (Must be after create_newcase)
+if ($?LSB_JOBNAME) then
+ # This only works if the job name in the BSUB or PBS directives
+ # is the name of this script.
+ setenv setup_file_name $LSB_JOBNAME
+else if ($?PBS_JOBNAME) then
+ setenv setup_file_name $PBS_JOBNAME
+else
+ setenv setup_file_name = $0:t
+endif
+${COPY} $setup_file_name ${caseroot}/${setup_file_name}.original
+
+# ==============================================================================
+# Configure the case.
+# ==============================================================================
+
+cd ${caseroot}
+
+setenv CASEROOT `./xmlquery CASEROOT --value`
+setenv COMPSET `./xmlquery COMPSET --value`
+# setenv TEST_MPI `./xmlquery MPI_RUN_COMMAND --value`
+setenv CLM_CONFIG_OPTS `./xmlquery CLM_CONFIG_OPTS --value`
+setenv COMP_OCN `./xmlquery COMP_OCN --value`
+# setenv BATCHSUBMIT `./xmlquery BATCHSUBMIT --value`
+# setenv BATCH_SYSTEM `./xmlquery BATCHSUBMIT --value`
+setenv BATCH_SYSTEM 'manually'
+setenv MAX_TASKS_PER_NODE `./xmlquery MAX_TASKS_PER_NODE --value`
+
+# Make sure the case is configured with a data ocean.
+if ( ${COMP_OCN} != docn ) then
+ echo " "
+ echo "ERROR: This setup script is not appropriate for active ocean compsets."
+ echo "ERROR: Please use the models/CESM/shell_scripts examples for that case."
+ echo " "
+ exit 40
+endif
+
+# Copy the xml files for debugging purposes.
+foreach FILE ( *xml )
+ if ( ! -e ${FILE}.original ) then
+ if ($COPYV == "FALSE") echo "Copying $FILE ${FILE}.original"
+ ${COPY} $FILE ${FILE}.original
+ endif
+end
+
+# NOTE: If you require bit-for-bit agreement between different runs,
+# in particular, between pmo (single instance) and assimilations (NINST > 1),
+# or if you need to change the number of nodes/member due to changing memory needs,
+# then env_run.xml:BFBFLAG must be set to TRUE, so that the coupler will
+# generate bit-for-bit identical results, regardless of the number of tasks
+# given to it. The time penalty appears to be ~ 0.5% in the forecast.
+# Alternatively, you can set cpl_tasks = same_number in both experiments
+
+# Task layout:
+# Set the nodes_per_instance below to match your case. If you get 'out of memory'
+# errors OR failures without any messages, try increasing the nodes_per_instance.
+# CAM6-FV 1 degree can run on 3 nodes/instance on cheyenne.
+# By computing task counts like we do below, we guarantee each instance uses
+# a whole number of nodes which is the recommended configuration.
+
+# Edwards says there's no speed up by running non-active components concurrently,
+# after ATM has run, so just run all components sequentially.
+
+# MAX_TASKS_PER_NODE comes from $case/Tools/mkbatch.$machine
+@ use_tasks_per_node = $MAX_TASKS_PER_NODE
+@ nthreads = 1
+# nodes_per_instance = 3 may be marginal for 1 degree CAM6 on cheyenne.
+@ nodes_per_instance = 4
+
+
+@ atm_tasks = $use_tasks_per_node * $num_instances * $nodes_per_instance
+@ lnd_tasks = $use_tasks_per_node * $num_instances * $nodes_per_instance
+@ ice_tasks = $use_tasks_per_node * $num_instances * $nodes_per_instance
+@ ocn_tasks = $use_tasks_per_node * $num_instances
+@ cpl_tasks = $use_tasks_per_node * $num_instances
+@ glc_tasks = $use_tasks_per_node * $num_instances
+@ rof_tasks = $use_tasks_per_node * $num_instances * $nodes_per_instance
+@ wav_tasks = $use_tasks_per_node * $num_instances
+
+
+echo "ATM gets $atm_tasks"
+echo "LND gets $lnd_tasks"
+echo "ICE gets $ice_tasks"
+echo "OCN gets $ocn_tasks"
+echo "CPL gets $cpl_tasks"
+echo "GLC gets $glc_tasks"
+echo "ROF gets $rof_tasks"
+echo "WAV gets $wav_tasks"
+echo ""
+
+./xmlchange NTHRDS_ATM=$nthreads,NTASKS_ATM=$atm_tasks,NINST_ATM=$num_instances
+./xmlchange NTHRDS_LND=$nthreads,NTASKS_LND=$lnd_tasks,NINST_LND=$num_instances
+./xmlchange NTHRDS_ICE=$nthreads,NTASKS_ICE=$ice_tasks,NINST_ICE=$num_instances
+./xmlchange NTHRDS_OCN=$nthreads,NTASKS_OCN=$ocn_tasks,NINST_OCN=1
+./xmlchange NTHRDS_CPL=$nthreads,NTASKS_CPL=$cpl_tasks
+./xmlchange NTHRDS_GLC=$nthreads,NTASKS_GLC=$glc_tasks,NINST_GLC=1
+./xmlchange NTHRDS_ROF=$nthreads,NTASKS_ROF=$rof_tasks,NINST_ROF=$num_instances
+./xmlchange NTHRDS_WAV=$nthreads,NTASKS_WAV=$wav_tasks,NINST_WAV=1
+./xmlchange ROOTPE_ATM=0
+./xmlchange ROOTPE_LND=0
+./xmlchange ROOTPE_ICE=0
+./xmlchange ROOTPE_OCN=0
+./xmlchange ROOTPE_CPL=0
+./xmlchange ROOTPE_GLC=0
+./xmlchange ROOTPE_ROF=0
+./xmlchange ROOTPE_WAV=0
+
+./xmlchange RUN_TYPE=$starttype
+
+if ($starttype =~ 'hybrid') then
+ ./xmlchange RUN_STARTDATE=${start_year}-${start_month}-${start_day}
+ ./xmlchange START_TOD=$start_tod
+endif
+
+# The refcase needs to have the instance number removed from the file names,
+# so this script stages the IC files and CESM should not.
+./xmlchange GET_REFCASE=FALSE
+./xmlchange RUN_REFDIR=$rundir
+./xmlchange RUN_REFCASE=$refcase
+./xmlchange RUN_REFDATE=$refdate
+./xmlchange RUN_REFTOD=$reftod
+
+./xmlchange EXEROOT=${exeroot}
+./xmlchange RUNDIR=${rundir}
+
+if ($sst_use_defaults == 'false') then
+ ./xmlchange SSTICE_DATA_FILENAME=$sst_dataset
+ ./xmlchange SSTICE_GRID_FILENAME=$sst_grid
+ ./xmlchange SSTICE_YEAR_ALIGN=$sst_year_start
+ ./xmlchange SSTICE_YEAR_START=$sst_year_start
+ ./xmlchange SSTICE_YEAR_END=$sst_year_end
+endif
+
+
+./xmlchange CALENDAR=GREGORIAN
+./xmlchange CONTINUE_RUN=FALSE
+
+./xmlchange STOP_OPTION=$stop_option
+./xmlchange STOP_N=$stop_n
+./xmlchange RESUBMIT=$resubmit
+
+./xmlchange PIO_TYPENAME=pnetcdf
+
+# set TEST_MPI = `./xmlquery MPI_RUN_COMMAND --value | sed -e 's/MPI_RUN_COMMAND//'`
+# echo "passed assignment of TEST_MPI = $TEST_MPI"
+# if (${TEST_MPI} == 'UNSET') then
+# ./xmlchange MPI_RUN_COMMAND=mpirun.lsf
+# endif
+
+# Extract pieces of the COMPSET for choosing correct setup parameters.
+# E.g. "AMIP_CAM5_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM1%NOEVOLVE_SWAV"
+set comp_list = `echo $COMPSET | sed -e "s/_/ /g"`
+
+# River Transport Model
+./xmlchange ROF_GRID='r05'
+# ./xmlchange RTM_MODE='null'
+echo "comp_list[6] = $comp_list[6]"
+set roff = `echo "$comp_list[6]" | sed -e "s/%/ /g"`
+echo "roff = $roff"
+set river_runoff = "$roff[1]"
+echo "river_runoff = $river_runoff, from $comp_list[6]"
+if ($river_runoff != 'RTM' && $river_runoff != 'MOSART' && \
+ $river_runoff != 'DROF' && $river_runoff != 'SROF') then
+ echo "river_runoff is $river_runoff, which is not supported"
+ exit 50
+endif
+
+
+# COUPLING discussion. F compsets are 'tight' coupling.
+# Only change the ATM_NCPL ... everything is based on this one value,
+# including CAM physics and dynamics timesteps.
+# Default values for coupling are preserved in env_run.xml.original.
+
+./xmlchange NCPL_BASE_PERIOD=day
+./xmlchange ATM_NCPL=48
+
+# CAM physics (etc.) selection.
+# ./xmlchange CAM_CONFIG_OPTS="-phys cam5.4 -club_sgs"
+# ./xmlchange CAM_CONFIG_OPTS="-phys cam4"
+# setenv CAM_CONFIG_OPTS `./xmlquery CAM_CONFIG_OPTS --value`
+# echo $CAM_CONFIG_OPTS | grep 'cam4'
+# CLMBuildNamelist::setup_logic_initial_conditions() :
+# using ignore_ic_date is incompatable with crop!
+# If you choose to ignore this error, the counters since planting for crops will be messed up.
+# -- Add -ignore_warnings option to CLM_BLDNML_OPTS to ignore this warning
+echo $compset | grep 'CROP'
+if ($status == 0) then
+ setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+ set clm_opts = "$CLM_BLDNML_OPTS -ignore_warnings "
+ ./xmlchange CLM_BLDNML_OPTS="$clm_opts"
+ # DEBUG/confirm
+ setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+ echo "CLM_BLDNML_OPTS has been changed to $CLM_BLDNML_OPTS"
+endif
+
+# These are archiving options that may be used.
+# You can turn the short/long term archivers on or off,
+# but these settings should be made in either event.
+
+./xmlchange DOUT_S_ROOT=${archdir}
+# ./xmlchange DOUT_S_SAVE_INTERIM_RESTART_FILES=TRUE
+
+if ($short_term_archiver == 'off') then
+ ./xmlchange DOUT_S=FALSE
+else
+ ./xmlchange DOUT_S=TRUE
+endif
+
+# DEBUG = TRUE implies turning on run and compile time debugging.
+# INFO_DBUG level of debug output, 0=minimum, 1=normal, 2=more, 3=too much.
+# WARNING: CAM-SE fails if DEBUG=TRUE
+# ./xmlchange DEBUG=FALSE
+# ./xmlchange INFO_DBUG=0
+# Debug_lwdn
+./xmlchange DEBUG=TRUE
+./xmlchange INFO_DBUG=2
+# Reduce the MPI activity messages. 2 = default (too much).
+# ATM_forcXX: not in the config_definition file: ./xmlchange MP_INFOLEVEL=0
+
+
+
+# ==============================================================================
+# Update source files.
+# DART does not require any modifications to the model source.
+# ==============================================================================
+
+# Import your SourceMods, if you have any. DART doesn't have any of its own.
+if (-d ${sourcemods} ) then
+ echo ' '
+ if ($COPYV == "FALSE") \
+ echo "Copying SourceMods from $sourcemods to $caseroot "
+ ${COPY} -r ${sourcemods}/* ${caseroot}/SourceMods/ || exit 60
+ echo ' '
+ echo ' '
+else
+ echo "No SourceMods directory for this case."
+endif
+
+# ==============================================================================
+# Set up the case.
+# This creates the EXEROOT and RUNDIR directories.
+# ==============================================================================
+
+echo 'Setting up the case ...'
+
+./case.setup
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be set up."
+ exit 70
+# else if (! (-f config_cache.xml || -f Buildconf/camconf/config_cache.xml)) then
+# echo "ERROR: No config_cach.xml."
+# exit 80
+endif
+
+# ==============================================================================
+# Edit the run script to reflect queue and wallclock
+# ==============================================================================
+
+echo ''
+echo 'Updating the run script to set wallclock and queue.'
+echo ''
+
+# ===========================================================================
+
+set inst_string = `printf _%04d $inst`
+
+# ===========================================================================
+set fname = "user_nl_cam"
+
+echo " inithist = 'ENDOFRUN'" >> ${fname}
+echo " ncdata = 'cam_initial${inst_string}.nc'" >> ${fname}
+echo " empty_htapes = .true. " >> ${fname}
+echo " fincl1 = '' " >> ${fname}
+# >0 means the number of time steps.
+echo " nhtfrq = 1 " >> ${fname}
+
+
+# ===========================================================================
+set fname = "user_nl_clm"
+
+# Debugging runs will probably never want to interpolate the CLM restart files.
+echo "use_init_interp = .false. " >> ${fname}
+# echo "init_interp_fill_missing_with_natveg = .true. " >> ${fname}
+
+echo "finidat = '${refcase}.clm2.r.${reftimestamp}.nc'" >> ${fname}
+echo "hist_empty_htapes = .true." >> ${fname}
+echo "hist_fincl1 = 'TSA'" >> ${fname}
+echo "hist_nhtfrq = -$stop_n" >> ${fname}
+# This needs to match the settings in $refcase, or the restart files will be mismatched.
+echo "urban_hac = 'OFF'" >> ${fname}
+echo "building_temp_method = 0 " >> ${fname}
+
+# ATM_forcXX Test coupler forcing file output
+# ===========================================================================
+set fname = "user_nl_cpl"
+
+# J1850G(lofverstrom) + river (Lindsay)
+# echo " histaux_a2x3hr = .true." >> ${fname}
+# echo " histaux_a2x24hr = .true." >> ${fname}
+# echo " histaux_a2x1hri = .true." >> ${fname}
+# echo " histaux_a2x1hr = .true." >> ${fname}
+# echo " histaux_r2x = .true." >> ${fname}
+# ./xmlchange AVGHIST_OPTION=nsteps
+# ./xmlchange AVGHIST_N=1
+
+./preview_namelists || exit 100
+
+# ===================================================================================
+
+set init_time = ${reftimestamp}
+
+cat << EndOfText >! stage_cesm_files
+#!/bin/csh -f
+# This script can be used to help restart an experiment from any previous step.
+# The appropriate files are copied to the RUN directory.
+#
+# Before running this script:
+# 1) be sure CONTINUE_RUN is set correctly in the env_run.xml file in
+# your caseroot directory.
+# CONTINUE_RUN=FALSE => start at REFTIME.
+# CONTINUE_RUN=TRUE => start from a previous step after REFTIME.
+# 2) be sure 'restart_time' is set to the day and time from which you want to
+# restart, if not the initial time.
+
+set restart_time = $init_time
+
+# ---------------------------------------------------------
+# Get the settings for this case from the CESM environment
+# ---------------------------------------------------------
+cd ${caseroot}
+setenv RUNDIR \`./xmlquery RUNDIR --value\`
+setenv CONTINUE_RUN \`./xmlquery CONTINUE_RUN --value\`
+
+# ---------------------------------------------------------
+
+cd \${RUNDIR}
+
+echo 'Copying the required CESM files to the run directory to rerun a previous step. '
+echo 'CONTINUE_RUN from env_run.xml is' \${CONTINUE_RUN}
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+ echo 'so files for some later step than the initial one will be restaged.'
+ echo "Date to reset files to is: \${restart_time}"
+else
+ echo 'so files for the initial step of this experiment will be restaged.'
+ echo "Date to reset files to is: ${init_time}"
+endif
+echo ''
+
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+
+ #----------------------------------------------------------------------
+ # This block copies over a set of restart files from any previous step of
+ # the experiment that is NOT the initial step.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+ echo "Staging restart files for run date/time: " \${restart_time}
+
+ if ( \${DOUT_S} =~ TRUE ) then
+
+ # The restarts should be in the short term archive 'rest' restart directories.
+
+ set RESTARTDIR = \${DOUT_S_ROOT}/rest/\${restart_time}
+
+ if ( ! -d \${RESTARTDIR} ) then
+
+ echo "restart file directory not found: "
+ echo " \${RESTARTDIR}"
+ exit 100
+
+ endif
+
+ ${COPY} \${RESTARTDIR}/* . || exit 101
+
+ else
+
+ # The short term archiver is off, which leaves all the restart files
+ # in the run directory. The rpointer files must still be updated to
+ # point to the files with the right day/time.
+
+ echo "${case}.cam.r.\${restart_time}.nc" >! rpointer.atm
+ echo "${case}.clm2.r.\${restart_time}.nc" >! rpointer.lnd
+ echo "${case}.cice.r.\${restart_time}.nc" >! rpointer.ice
+ echo "${case}.cpl.r.\${restart_time}.nc" >! rpointer.drv
+ echo "${case}.docn.r.\${restart_time}.nc" >! rpointer.ocn
+ echo "${case}.docn.rs1.\${restart_time}.bin" >> rpointer.ocn
+
+ if ($river_runoff == 'RTM') then
+ echo "${case}.rtm.r.\${restart_time}.nc" >! rpointer.rof
+ else if ($river_runoff == 'MOSART') then
+ echo "${case}.mosart.r.\${restart_time}.nc" >! rpointer.rof
+ endif
+
+
+ endif
+
+ # Relink the CAM initial file back to the hardwired name set in the namelist
+
+ ${LINK} ${case}.cam.i.\${restart_time}.nc cam_initial.nc
+
+ echo "All files reset to rerun experiment step using (ref)time " \$restart_time
+
+
+else # CONTINUE_RUN == FALSE
+
+ #----------------------------------------------------------------------
+ # This block links the right files to rerun the initial (very first)
+ # step of an experiment. The names and locations are set during the
+ # building of the case; to change them rebuild the case.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+
+ echo ' '
+ echo "Staging initial files for instance $inst of $num_instances"
+
+ if ($starttype =~ 'hybrid') then
+ ${LINK} ${stagedir}/${refcase}.cam${inst_string}.i.\${restart_time}.nc ${refcase}.cam.i.\${restart_time}.nc
+ endif
+
+ ${LINK} ${stagedir}/${refcase}.cam${inst_string}.r.\${restart_time}.nc ${refcase}.cam.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.cam${inst_string}.rs.\${restart_time}.nc ${refcase}.cam.rs.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.clm2${inst_string}.r.\${restart_time}.nc ${refcase}.clm2.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.clm2${inst_string}.rh0.\${restart_time}.nc ${refcase}.clm2.rh0.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.cice${inst_string}.r.\${restart_time}.nc ${refcase}.cice.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.cpl${inst_string}.r.\${restart_time}.nc ${refcase}.cpl.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.docn${inst_string}.rs1.\${restart_time}.bin ${refcase}.docn.rs1.\${restart_time}.bin
+
+ echo "${refcase}.cam.r.\${restart_time}.nc" >! rpointer.atm
+ echo "${refcase}.clm2.r.\${restart_time}.nc" >! rpointer.lnd
+ echo "${refcase}.cice.r.\${restart_time}.nc" >! rpointer.ice
+ echo "${refcase}.cpl.r.\${restart_time}.nc" >! rpointer.drv
+ echo "${refcase}.docn.r.\${restart_time}.nc" >! rpointer.ocn
+ echo "${refcase}.docn.rs1.\${restart_time}.bin" >> rpointer.ocn
+
+ if ($river_runoff == 'RTM') then
+ ${LINK} ${stagedir}/${refcase}.rtm${inst_string}.r.\${restart_time}.nc \
+ ${refcase}.rtm.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.rtm${inst_string}.rh0.\${restart_time}.nc \
+ ${refcase}.rtm.rh0.\${restart_time}.nc
+ echo "${refcase}.rtm.r.\${restart_time}.nc" >! rpointer.rof
+ else if ($river_runoff == 'MOSART') then
+ ${LINK} ${stagedir}/${refcase}.mosart${inst_string}.r.\${restart_time}.nc \
+ ${refcase}.mosart.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.mosart${inst_string}.rh0.\${restart_time}.nc \
+ ${refcase}.mosart.rh0.\${restart_time}.nc
+ echo "${refcase}.mosart.r.\${restart_time}.nc" >! rpointer.rof
+ endif
+
+ echo "All files set to run the FIRST experiment step using (ref)time" $init_time
+
+endif
+
+cd ..
+
+exit 0
+
+EndOfText
+chmod 0755 stage_cesm_files
+
+./stage_cesm_files
+
+# ==============================================================================
+# build
+# ==============================================================================
+
+echo ''
+echo 'Building the case'
+echo ''
+
+# --skip-provenance-check because of svn or git timing out during build
+# of CLM. It wanted authentication(?) to access a private repository.
+# A better solution would be to find out why(whether) it thinks CLM is
+# a private repository.
+./case.build --skip-provenance-check
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be built."
+ exit 200
+endif
+
+exit 0
+
diff --git a/models/cam-fv/shell_scripts/cesm2_1/DART_config.template b/models/cam-fv/shell_scripts/cesm2_1/DART_config.template
new file mode 100644
index 0000000000..21941620c5
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/DART_config.template
@@ -0,0 +1,399 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+# ---------------------
+# Purpose
+# ---------------------
+#
+# This script integrates DART with a pre-existing CESM multi-instance case.
+# It must be run from a valid CASEROOT directory and some environment variables
+# must be set (as in cesm#_#/setup_XXX).
+#
+# CAM is the only model component used for assimilation.
+# CESM starts and stops to allow for CAM to assimilate every 6 hours.
+#
+# This script will try to build the DART executables if they are not found.
+# This might result in a preproc_nml being used, which is wrong for your observation set.
+#
+# There may be CESM binary files in big-endian format, and DART reads some of them,
+# so you MUST compile DART accordingly e.g.,
+# ifort -convert big_endian
+# Contact dart@ucar.edu if you want to use another compiler.
+#
+# ---------------------
+# How to set up the script
+# ---------------------
+#
+# -- > cd $CASEROOT
+# -- Script DART_config should have been created there by setup_{hybrid,advanced,...}
+# -- If not, copy and rename this script into the $CASEROOT directory.
+# > cp $DART_CESM_scripts/DART_config.template $CASEROOT/DART_config
+# -- Ensure the following variables are set correctly;
+# DARTROOT references a valid DART directory.
+# DART_SCRIPTS_DIR $DARTROOT/models/cam-fv/shell_scripts/your_setup_script_dir
+# BASEOBSDIR your_observation_path
+# SAVE_EVERY_MTH_RESTART days_between_archiving_restarts
+# -- Examine the whole script to identify things to change for your experiments.
+# This includes choosing [no_]assimilate.csh.
+# -- Optionally provide any initial inflation files needed by your run.
+# -- Run this script.
+# > ./DART_config | & tee DART_config.out1
+# -- Edit the DART input.nml, that appears in the ${CASEROOT} directory,
+# to replace default values with your preferred values.
+#
+# -- Submit the job using ${CASEROOT}/${CASE}.submit
+#
+# ==============================================================================
+# Get the environment of the case - defines number of instances/ensemble size ...
+# Each model component has their own number of instances.
+# ==============================================================================
+
+echo "==================="
+echo "Starting DART_config"
+echo "==================="
+
+# baseobsdir Part of the directory name containing the obs_seq.out files to be used by the
+# assimilation. Assimilate.csh looks for a directory with the year and month:
+# $baseobsdir/YYYYMM_6H_CESM.
+# Will be inherited by CESM#_#_DART_config and inserted into assimilate.csh
+# save_every_Mth_day_restarts
+# assimilate.csh uses this to remove extraneous restart sets in the DART context.
+# This permits more cycles per job and reduces the data volume that's st_archived.
+
+# DART_SCRIPTS_DIR should be set to the DART directory from which this script was copied,
+# and which contains the setup_ script used to build the CASE,
+# and the assimilate.csh which will run the assimilation.
+
+setenv DARTROOT your_dart_path
+setenv DART_SCRIPTS_DIR $DARTROOT/models/cam-fv/shell_scripts/your_setup_script_dir
+echo "DART_SCRIPTS_DIR = $DART_SCRIPTS_DIR"
+
+setenv BASEOBSDIR your_observation_path
+
+setenv SAVE_EVERY_MTH_RESTART days_between_archiving_restarts
+
+if ( ! -e ./xmlquery ) then
+ echo "ERROR: $0 must be run from a CASEROOT directory".
+ exit 1
+endif
+
+setenv CASE `./xmlquery --value CASE`
+setenv CASEROOT `./xmlquery --value CASEROOT`
+setenv COMPSET `./xmlquery --value COMPSET`
+setenv EXEROOT `./xmlquery --value EXEROOT`
+setenv RUNDIR `./xmlquery --value RUNDIR`
+setenv num_instances `./xmlquery --subgroup ATM --value NINST`
+
+# ==============================================================================
+# Turn on the assimilation in CESM
+
+# The assimilation script to be run is determined by
+# CESM's env_run.xml DATA_ASSIMILATION* variables.
+# If DATA_ASSIMILATION = false (default), then neither {no_}assimilate.csh will be run,
+# and CAM restart files (instead of initial) will be used after the first cycle.
+# So always set DATA_ASSIMILATION = TRUE.
+# DATA_ASSIMILATION_CYCLES says how many cycles to run in each job.
+# It's wise to set to 1 for the first cycle, so that successfull completion can be
+# verified before using lots of resources.
+# When the job (not each cycle) is finished the short_term archiver may run
+# as a separate job and, if RESUBMIT > 0, (re)submit a new case.run job.
+
+./xmlchange DATA_ASSIMILATION_ATM=TRUE
+./xmlchange DATA_ASSIMILATION_CYCLES=1
+
+# The default is to tell CESM to use no_assimilate.csh.
+# If this script is run by setup_advanced, use one of its environment variables
+# to turn on assimilation.
+# In any case, you can change the value of DATA_ASSIMILATION_SCRIPT in env_run.xml.
+./xmlchange DATA_ASSIMILATION_SCRIPT=${CASEROOT}/no_assimilate.csh
+if ($?CIMEROOT) ./xmlchange DATA_ASSIMILATION_SCRIPT=${CASEROOT}/assimilate.csh
+
+# ==============================================================================
+
+# ==============================================================================
+# Set the system commands to avoid user's aliases.
+# ==============================================================================
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+# If the -f argument is needed, it is added to commands where they are used.
+# The verbose (-v) argument has been separated from these command definitions
+# because these commands may not accept it on some systems. On those systems
+# set VERBOSE = ''
+set VERBOSE = '-v'
+set MOVE = '/usr/bin/mv'
+set COPY = '/usr/bin/cp --preserve=timestamps'
+set LINK = '/usr/bin/ln'
+set REMOVE = '/usr/bin/rm'
+
+echo ""
+
+# ==============================================================================
+# make sure the required directories exist
+# VAR is the shell variable name, DIR is the value
+# ==============================================================================
+
+# Make a place to store inflation restarts to protect from purging until
+# st_archive can make a home for them.
+if (! -d ${EXEROOT}/archive/esp/hist) mkdir -p ${EXEROOT}/archive/esp/hist
+
+foreach DIR ( $CASEROOT $DART_SCRIPTS_DIR ${EXEROOT}/archive/esp/hist)
+ if ( ! -d $DIR ) then
+ echo "ERROR: directory '$DIR' not found"
+ echo " In the setup script check the setting of: $VAR"
+ exit 10
+ endif
+end
+
+# ==============================================================================
+# Make sure the DART executables exist or build them if we can't find them.
+# The DART input.nml in the model directory IS IMPORTANT during this part
+# because it defines what observation types are supported.
+# ==============================================================================
+
+foreach MODEL ( cam-fv )
+ set targetdir = $DARTROOT/models/$MODEL/work
+ if ( ! -x $targetdir/filter ) then
+ echo ""
+ echo "WARNING: executable file 'filter' not found."
+ echo " Looking for: $targetdir/filter "
+ echo " Trying to rebuild all executables for $MODEL now ..."
+ echo " This will be incorrect, if input.nml:preprocess_nml is not correct."
+ (cd $targetdir; ./quickbuild.csh -mpi)
+ if ( ! -x $targetdir/filter ) then
+ echo "ERROR: executable file 'filter' not found."
+ echo " Unsuccessfully tried to rebuild: $targetdir/filter "
+ echo " Required DART assimilation executables are not found."
+ echo " Stopping prematurely."
+ exit 20
+ endif
+ endif
+end
+
+# ==============================================================================
+# Stage the required parts of DART in the CASEROOT directory.
+# ==============================================================================
+
+sed -e "s#BOGUSNUMINST#$num_instances#" \
+ ${DART_SCRIPTS_DIR}/no_assimilate.csh.template > no_assimilate.csh || exit 30
+
+sed -e "s#BOGUSBASEOBSDIR#$BASEOBSDIR#" \
+ -e "s#BOGUS_save_every_Mth#$SAVE_EVERY_MTH_RESTART#" \
+ ${DART_SCRIPTS_DIR}/assimilate.csh.template > assimilate.csh || exit 40
+
+chmod 755 assimilate.csh
+chmod 755 no_assimilate.csh
+# chmod 755 perfect_model.csh
+
+if (-f ${DART_SCRIPTS_DIR}/compress.csh) then
+ $COPY -f -${VERBOSE} ${DART_SCRIPTS_DIR}/compress.csh . || exit 43
+else
+ echo "ERROR: no compress.csh in ${DART_SCRIPTS_DIR}"
+ exit 45
+endif
+
+# ==============================================================================
+# Stage the DART executables in the CESM execution root directory: EXEROOT
+# If you recompile the DART code (maybe to support more observation types)
+# we're making a script to make it easy to install new DART executables.
+# ==============================================================================
+
+cat << EndOfText >! stage_dart_files
+#!/bin/sh
+
+# Run this script in the ${CASEROOT} directory.
+# This script copies over the dart executables and POSSIBLY a namelist
+# to the proper directory. If you have to update any dart executables,
+# do it in the ${DARTROOT} directory and then rerun stage_dart_files.
+# If an input.nml does not exist in the ${CASEROOT} directory,
+# a default one will be copied into place.
+#
+# This script was autogenerated by $0 using the variables set in that script.
+
+if [[ -e input.nml ]]; then
+ echo "stage_dart_files: Using existing ${CASEROOT}/input.nml"
+ if [[ -e input.nml.original ]]; then
+ echo "input.nml.original already exists - not making another"
+ else
+ ${COPY} ${VERBOSE} input.nml input.nml.original
+ fi
+
+elif [[ -e ${DARTROOT}/models/cam-fv/work/input.nml ]]; then
+ ${COPY} ${VERBOSE} ${DARTROOT}/models/cam-fv/work/input.nml input.nml
+ if [[ -x update_dart_namelists ]]; then
+ ./update_dart_namelists
+ fi
+else
+ echo "ERROR: stage_dart_files could not find an input.nml. Aborting"
+ exit 50
+fi
+
+${COPY} -f ${DARTROOT}/models/cam-fv/work/filter ${EXEROOT} || exit 55
+${COPY} -f ${DARTROOT}/models/cam-fv/work/perfect_model_obs ${EXEROOT} || exit 56
+${COPY} -f ${DARTROOT}/models/cam-fv/work/fill_inflation_restart ${EXEROOT} || exit 57
+
+exit 0
+
+EndOfText
+chmod 0755 stage_dart_files
+
+./stage_dart_files || exit 60
+
+# ==============================================================================
+# Ensure the DART namelists are consistent with the ensemble size,
+# suggest settings for num members in the output diagnostics files, etc.
+# The user is free to update these after setup and before running.
+# ==============================================================================
+
+# If we are using WACCM{-X} (i.e. WCxx or WXxx) we have preferred namelist values.
+# Extract pieces of the COMPSET for choosing correct setup parameters.
+# E.g. "AMIP_CAM5_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM1%NOEVOLVE_SWAV"
+set comp_list = `echo $COMPSET | sed -e "s/_/ /g"`
+set waccm = "false"
+set atm = `echo $comp_list[2] | sed -e "s#%# #"`
+if ($#atm > 1) then
+ echo $atm[2] | grep WC
+ if ($status == 0) set waccm = "true"
+endif
+
+cat << EndOfText >! update_dart_namelists
+#!/bin/sh
+
+# This script makes certain namelist settings consistent with the number
+# of ensemble members built by the setup script.
+# This script was autogenerated by $0 using the variables set in that script.
+
+# Ensure that the input.nml ensemble size matches the number of instances.
+# WARNING: the output files contain ALL ensemble members ==> BIG
+
+ex input.nml < 1 ) then
+
+ set SAMP_ERR_DIR = assimilation_code/programs/gen_sampling_err_table/work
+ set SAMP_ERR_FILE = ${DARTROOT}/${SAMP_ERR_DIR}/sampling_error_correction_table.nc
+
+ if ( -e ${SAMP_ERR_FILE} ) then
+ ${COPY} -f ${VERBOSE} ${SAMP_ERR_FILE} ${RUNDIR} || exit 75
+ if ( $num_instances < 3 || $num_instances > 200 ) then
+ echo ""
+ echo "ERROR: sampling_error_correction_table.nc handles ensemble sizes 3...200."
+ echo "ERROR: Yours is $num_instances"
+ echo ""
+ exit 75
+ endif
+ else
+ set list = `grep sampling_error_correction input.nml | sed -e "s/[=\.,]//g`
+ if ($list[2] == "true") then
+ echo ""
+ echo "ERROR: No sampling_error_correction_table.nc file found ..."
+ echo "ERROR: the input.nml:assim_tool_nml:sampling_error_correction"
+ echo "ERROR: is 'true' so this file must exist."
+ echo ""
+ exit 80
+ endif
+ endif
+
+endif
+
+# ==============================================================================
+# What to do next
+# ==============================================================================
+
+
+cat << EndOfText >! DART_instructions.txt
+
+-------------------------------------------------------------------------
+
+Check the DART configuration:
+
+1) The default behavior setup_hybrid is too not run DART_config, which sets up assimilation.
+ The default behavior of setup_advanced is to invoke DART_config.
+
+2) If you want to turn DART on or off, edit the
+ env_run.xml: DATA_ASSIMILATION_* to specify which DART script
+ to use after the model forecast;
+ assimilate.csh, no_assimilate.csh, or perfect_model.csh.
+
+3) Modify what you need to in the DART namelist file, i.e. ${CASEROOT}/input.nml
+
+4) If you have recompiled any part of the DART system, 'stage_dart_files'
+ will copy them into the correct places.
+
+5) If you stage your own inflation files, make sure you read the "INFLATION" section
+ in ${CASEROOT}/assimilate.csh. At the very least, copy your inflation files
+ in ${RUNDIR} into the appropriate names:
+ input_priorinf_mean.nc
+ input_priorinf_sd.nc
+ input_postinf_mean.nc
+ input_postinf_sd.nc
+ If assimilate.csh does not find inflation files, it will call fill_inflation_restart
+ to create some from the inflation values in input.nml.
+
+6) Make sure the observation directory name in assimilate.csh or perfect_model.csh
+ matches the one on your system.
+
+7) Submit the CESM job in the normal way.
+
+8) You can use ${CASEROOT}/stage_cesm_files to stage an ensemble of files
+ to restart a run at a date for which you have a restart set.
+
+-------------------------------------------------------------------------
+
+EndOfText
+
+cat DART_instructions.txt
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/shell_scripts/cesm2_1/assimilate.csh.template b/models/cam-fv/shell_scripts/cesm2_1/assimilate.csh.template
new file mode 100644
index 0000000000..ab756f8935
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/assimilate.csh.template
@@ -0,0 +1,1039 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+# ------------------------------------------------------------------------------
+# Purpose: assimilate with a CAM ensemble and perform advanced archiving
+# and compression in support of multiple assimilation cycles in a
+# single CESM job.
+#
+# The (resulting) assimilate.csh script is called by CESM with two arguments:
+# 1) the CASEROOT, and
+# 2) the assimilation cycle number in this CESM job
+# ------------------------------------------------------------------------------
+# This template is lightly modified by the setup scripts to be appropriate
+# for specific hardware and other configurations. The modified result is
+# then given execute permission and is appropriate to use for an assimilation.
+# All of this is automatically performed by the DART-supplied setup scripts.
+#
+# Tag DART's state output with names using CESM's convention:
+# ${case}.${scomp}[_$inst].${filetype}[.$dart_file].${date}.nc
+# These should all be named with $scomp = "cam" to distinguish
+# them from the same output from other components in multi-component assims.
+#
+# This script also has logic in it to manage disk space in a way that allows
+# for more assimilation cycles to be performed before archiving without losing
+# critical restart capability. The same logic is also useful for assimilations
+# that may require multiple timesteps to be available.
+#
+# As a specific example, consider the case when 3 assimilation cycles have been
+# performed: 6Z, 12Z, 18Z.
+# If we want to keep a restart set and a backup
+# restart set, we only need the 18Z and 12Z, so the 6Z set can be removed.
+# Let's also say that its the last cycle of job - which automatically kicks off
+# the short-term archiver. If we did 'nothing', the 12Z and 18Z get archived
+# and the 18Z gets restaged
+
+# machine-specific dereferencing
+
+if ($?SLURM_JOB_ID) then
+
+ # SLURM environment variables:
+ # env | grep SLURM | sort
+
+ setenv ORIGINALDIR $SLURM_SUBMIT_DIR
+ setenv JOBNAME $SLURM_JOB_NAME
+ setenv JOBID $SLURM_JOBID
+ setenv MYQUEUE $SLURM_JOB_PARTITION
+ setenv NODENAMES $SLURM_NODELIST
+ setenv LAUNCHCMD "mpirun -np $SLURM_NTASKS -bind-to core"
+# untested method for determining NUMTASKS_PERNODE with SLURM
+# set ANY_OLD_NODE = `head -n 1 $SLURM_NODELIST`
+# setenv NUMTASKS_PERNODE `grep $ANY_OLD_NODE $SLURM_NODELIST | wc -l`
+
+else if ($?PBS_NODEFILE) then
+
+ # PBS environment variables:
+ # env | grep PBS | sort
+
+ setenv ORIGINALDIR $PBS_O_WORKDIR
+ setenv JOBNAME $PBS_JOBNAME
+ setenv JOBID $PBS_JOBID
+ setenv MYQUEUE $PBS_O_QUEUE
+ setenv NUMCPUS $NCPUS
+ setenv NUMTASKS `cat $PBS_NODEFILE | wc -l`
+ setenv NUMNODES `uniq $PBS_NODEFILE | wc -l`
+ set ANY_OLD_NODE = `head -n 1 $PBS_NODEFILE`
+ setenv NUMTASKS_PERNODE `grep $ANY_OLD_NODE $PBS_NODEFILE | wc -l`
+ setenv MPIEXEC_MPT_DEBUG 0
+ setenv MP_DEBUG_NOTIMEOUT yes
+ setenv LAUNCHCMD mpiexec_mpt
+
+ echo "jobname : $JOBNAME"
+ echo "numcpus : $NUMCPUS"
+ echo "numtasks : $NUMTASKS"
+ echo "numnodes : $NUMNODES"
+ echo "tasks_per_node : $NUMTASKS_PERNODE"
+ echo " "
+
+else if ($?LSB_HOSTS) then
+
+ # LSF environment variables:
+ # env | grep LS | grep -v LS_COLORS | sort
+
+ setenv ORIGINALDIR $LS_SUBCWD
+ setenv JOBNAME $LSB_OUTPUTFILE:ar
+ setenv JOBID $LSB_JOBID
+ setenv MYQUEUE $LSB_QUEUE
+ setenv NODENAMES ${LSB_HOSTS}
+ setenv MP_DEBUG_NOTIMEOUT yes
+ setenv LAUNCHCMD mpirun.lsf
+# untested method for determining NUMTASKS_PERNODE with LSF
+# setenv NUMTASKS_PERNODE \
+# `echo $LSB_SUB_RES_REQ | sed -ne '/ptile/s#.*\[ptile=\([0-9][0-9]*\)]#\1#p'`
+
+endif
+
+# ==============================================================================
+# Block 0: Set command environment
+# ==============================================================================
+# This block is an attempt to localize all the machine-specific
+# changes to this script such that the same script can be used
+# on multiple platforms. This will help us maintain the script.
+
+echo "`date` -- BEGIN CAM_ASSIMILATE"
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+setenv CASEROOT $1
+
+# CESM uses C indexing on loops; cycle = [0,....,$DATA_ASSIMILATION_CYCLES - 1]
+# "Fix" that here, so the rest of the script isn't confusing.
+
+@ cycle = $2 + 1
+
+cd ${CASEROOT}
+
+setenv scomp `./xmlquery COMP_ATM --value`
+setenv CASE `./xmlquery CASE --value`
+setenv ensemble_size `./xmlquery NINST_ATM --value`
+setenv CAM_DYCORE `./xmlquery CAM_DYCORE --value`
+setenv EXEROOT `./xmlquery EXEROOT --value`
+setenv RUNDIR `./xmlquery RUNDIR --value`
+setenv archive `./xmlquery DOUT_S_ROOT --value`
+setenv TOTALPES `./xmlquery TOTALPES --value`
+setenv CONT_RUN `./xmlquery CONTINUE_RUN --value`
+setenv CHECK_TIMING `./xmlquery CHECK_TIMING --value`
+setenv DATA_ASSIMILATION_CYCLES `./xmlquery DATA_ASSIMILATION_CYCLES --value`
+
+# Switch CESM's timer script off for the rest of the forecasts of this job.
+# The timer takes a significant amount of time, which grows by ~15 s
+# for each cycle. This can double the cycle time in a 2 week job.
+
+./xmlchange CHECK_TIMING=FALSE
+
+cd ${RUNDIR}
+
+# A switch to save all the inflation files
+setenv save_all_inf TRUE
+
+# This may be needed before the short-term archiver has been run.
+if (! -d ${archive}/esp/hist) mkdir -p ${archive}/esp/hist
+
+# If they exist, mean and sd will always be saved.
+# A switch to signal how often to save the stages' ensemble members.
+# valid values are: NONE, RESTART_TIMES, ALL
+setenv save_stages_freq RESTART_TIMES
+
+# This next line ultimately specifies the location of the observation files.
+set BASEOBSDIR = BOGUSBASEOBSDIR
+
+# suppress "rm" warnings if wildcard does not match anything
+set nonomatch
+
+# Make sure that this script is using standard system commands
+# instead of aliases defined by the user.
+# If the standard commands are not in the location listed below,
+# change the 'set' commands to use them.
+# The VERBOSE options are useful for debugging, but are optional because
+# some systems don't like the -v option to any of the following.
+
+set MOVE = '/usr/bin/mv -v'
+set COPY = '/usr/bin/cp -v --preserve=timestamps'
+set LINK = '/usr/bin/ln -s'
+set LIST = '/usr/bin/ls '
+set REMOVE = '/usr/bin/rm -r'
+
+# ==============================================================================
+# Block 1: Determine time of current model state from file name of member 1
+# These are of the form "${CASE}.cam_${ensemble_member}.i.2000-01-06-00000.nc"
+# ==============================================================================
+
+# Piping stuff through 'bc' strips off any preceeding zeros.
+
+set FILE = `head -n 1 rpointer.atm_0001`
+set FILE = $FILE:r
+set ATM_DATE_EXT = $FILE:e
+set ATM_DATE = `echo $FILE:e | sed -e "s#-# #g"`
+set ATM_YEAR = `echo $ATM_DATE[1] | bc`
+set ATM_MONTH = `echo $ATM_DATE[2] | bc`
+set ATM_DAY = `echo $ATM_DATE[3] | bc`
+set ATM_SECONDS = `echo $ATM_DATE[4] | bc`
+set ATM_HOUR = `echo $ATM_DATE[4] / 3600 | bc`
+
+echo "valid time of model is $ATM_YEAR $ATM_MONTH $ATM_DAY $ATM_SECONDS (seconds)"
+echo "valid time of model is $ATM_YEAR $ATM_MONTH $ATM_DAY $ATM_HOUR (hours)"
+
+# Move the hidden restart set back into $rundir so that it is processed properly.
+
+${LIST} -d ../Hide*
+if ($status == 0) then
+ echo 'Moving hidden restarts into the run directory so they can be used or purged.'
+ ${MOVE} ../Hide*/* .
+ rmdir ../Hide*
+endif
+
+# We need to know the names of the current cesm.log files - one log file is created
+# by each CESM model advance.
+
+set log_list = `${LIST} -t cesm.log.*`
+
+echo "most recent log is $log_list[1]"
+echo "oldest log is $log_list[$#log_list]"
+echo "entire log list is $log_list"
+echo " "
+
+# ==============================================================================
+# Block 2: Populate a run-time directory with the input needed to run DART.
+# ==============================================================================
+
+echo "`date` -- BEGIN COPY BLOCK"
+
+# Put a pared down copy (no comments) of input.nml in this assimilate_cam directory.
+# The contents may change from one cycle to the next, so always start from
+# the known configuration in the CASEROOT directory.
+
+if ( -e ${CASEROOT}/input.nml ) then
+
+ sed -e "/#/d;/^\!/d;/^[ ]*\!/d" \
+ -e '1,1i\WARNING: Changes to this file will be ignored. \n Edit \$CASEROOT/input.nml instead.\n\n\n' \
+ ${CASEROOT}/input.nml >! input.nml || exit 10
+else
+ echo "ERROR ... DART required file ${CASEROOT}/input.nml not found ... ERROR"
+ echo "ERROR ... DART required file ${CASEROOT}/input.nml not found ... ERROR"
+ exit 11
+endif
+
+echo "`date` -- END COPY BLOCK"
+
+# If possible, use the round-robin approach to deal out the tasks.
+# This facilitates using multiple nodes for the simultaneous I/O operations.
+
+if ($?NUMTASKS_PERNODE) then
+ if ($#NUMTASKS_PERNODE > 0) then
+ ${MOVE} input.nml input.nml.$$ || exit 20
+ sed -e "s#layout.*#layout = 2#" \
+ -e "s#tasks_per_node.*#tasks_per_node = $NUMTASKS_PERNODE#" \
+ input.nml.$$ >! input.nml || exit 21
+ ${REMOVE} -f input.nml.$$
+ endif
+endif
+
+# ==============================================================================
+# Block 3: Identify requested output stages, warn about redundant output.
+# ==============================================================================
+
+set MYSTRING = `grep stages_to_write input.nml`
+set MYSTRING = (`echo $MYSTRING | sed -e "s#[=,'\.]# #g"`)
+set STAGE_input = FALSE
+set STAGE_forecast = FALSE
+set STAGE_preassim = FALSE
+set STAGE_postassim = FALSE
+set STAGE_analysis = FALSE
+set STAGE_output = FALSE
+
+# Assemble lists of stages to write out, which are not the 'output' stage.
+
+set stages_except_output = "{"
+@ stage = 2
+while ($stage <= $#MYSTRING)
+ if ($MYSTRING[$stage] == 'input') then
+ set STAGE_input = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}input"
+ endif
+ if ($MYSTRING[$stage] == 'forecast') then
+ set STAGE_forecast = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}forecast"
+ endif
+ if ($MYSTRING[$stage] == 'preassim') then
+ set STAGE_preassim = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}preassim"
+ endif
+ if ($MYSTRING[$stage] == 'postassim') then
+ set STAGE_postassim = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}postassim"
+ endif
+ if ($MYSTRING[$stage] == 'analysis') then
+ set STAGE_analysis = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}analysis"
+ endif
+ if ($stage == $#MYSTRING) then
+ set stages_all = "${stages_except_output}"
+ if ($MYSTRING[$stage] == 'output') then
+ set STAGE_output = TRUE
+ set stages_all = "${stages_all},output"
+ endif
+ endif
+ @ stage++
+end
+
+# Add the closing }
+set stages_all = "${stages_all}}"
+set stages_except_output = "${stages_except_output}}"
+
+# Checking
+echo "stages_except_output = $stages_except_output"
+echo "stages_all = $stages_all"
+if ($STAGE_output != TRUE) then
+ echo "ERROR: assimilate.csh requires that input.nml:filter_nml:stages_to_write includes stage 'output'"
+ exit 40
+endif
+
+# ==============================================================================
+# Block 4: Preliminary clean up, which can run in the background.
+# ==============================================================================
+# CESM2_0's new archiver has a mechanism for removing restart file sets,
+# which we don't need, but it runs only after the (multicycle) job finishes.
+# We'd like to remove unneeded restarts as the job progresses, allowing more
+# cycles to run before needing to stop to archive data. So clean them out of
+# RUNDIR, and st_archive will never have to deal with them.
+# ------------------------------------------------------------------------------
+
+# For safety, leave the most recent *2* restart sets in place.
+# Prevents catastrophe if the last restart set is partially written before a crash.
+# Add 1 more because the restart set used to start this will be counted:
+# there will be 3 restarts when there are only 2 cesm.log files,
+# which caused all the files to be deleted.
+
+if ($#log_list >= 3) then
+
+ # List of potential restart sets to remove. The coupler restart files
+ # may or may not have an 'instance' string in them, depending on whether
+ # or not you are using the multi-driver or not, so we must check for both.
+
+ set re_list = `${LIST} -t *cpl.r.*`
+ if ($#re_list == 0) set re_list = `${LIST} -t *cpl_0001.r.*`
+
+ if ($#re_list < 3) then
+ echo "ERROR: Too many cesm.log files ($#log_list) for the $#re_list restart sets."
+ echo " Clean out the cesm.log files from failed cycles."
+ exit 50
+ endif
+
+ # Find the date of the oldest restart set from filenames like:
+ # setup_test.cpl_0001.r.2016-12-11-21600.nc ... or ...
+ # setup_test.cpl.r.2016-12-11-21600.nc
+ #
+ # Grab the root of the filename (removes the .nc 'extension')
+ # and then the extension is the bit we need.
+ # Want the YYYY-MM-DD-SSSSS part as well as 'DD-SSSSS'
+
+ set FILE = $re_list[3]
+ set FILE = $FILE:r
+ if ($FILE:e == 'nc') set FILE = $FILE:r
+ set rm_date = $FILE:e
+ set RM_DATE_PARTS = `echo $rm_date | sed -e "s#-# #g"`
+ set day_o_month = $RM_DATE_PARTS[3]
+ set sec_o_day = $RM_DATE_PARTS[4]
+ set day_time = ${day_o_month}-${sec_o_day}
+
+ # Identify log files to be removed or moved.
+ # [3] means the 3rd oldest restart set is being (re)moved.
+ set rm_log = `echo $log_list[3] | sed -e "s/\./ /g;"`
+ set rm_slot = $#rm_log
+ if ($rm_log[$#rm_log] == 'gz') @ rm_slot--
+ echo 'oldest restart set is from job tagged $rm_log['$rm_slot']='$rm_log[$rm_slot]
+
+ # This first half of the statement removes unwanted restarts.
+ # The 'else' block preserves the restarts in the archive directory.
+
+ if ( $sec_o_day !~ '00000' || \
+ ($sec_o_day =~ '00000' && $day_o_month % BOGUS_save_every_Mth != 0) ) then
+
+ # Optionally save inflation restarts, even if it's not a 'save restart' time.
+ if ($save_all_inf =~ TRUE) ${MOVE} ${CASE}*inf*${day_time}* ${archive}/esp/hist
+
+ # Remove intermediate member restarts,
+ # but not DART means, sd, obs_seq, inflation restarts output.
+ # Note that *cpl.h[ar]* are retained, and any h#, #>0.
+
+ echo "Removing unneeded restart file set (DD_SSSSS ${day_time}) from RUNDIR: "
+ echo " ${CASE}"'*.{r,rs,rs1,rh0,h0}.*'"${day_time}"
+ ${REMOVE} ${CASE}*.{r,rs,rs1,rh0,h0}.*${day_time}* &
+
+ # Handle .i. separately to avoid sweeping up .i.${scomp}_{in,out}put_{mean,sd,...} files.
+ echo " ${CASE}"'*.i.[0-9]*'"${day_time}"
+ ${REMOVE} ${CASE}*.i.[0-9]*${day_time}* &
+
+ if ($save_stages_freq =~ NONE || $save_stages_freq =~ RESTART_TIMES) then
+ # 'output' will have been renamed by the time the purging happens.
+ echo " ${CASE}"'*'[0-9].${stages_except_output}'*'${day_time}
+ ${REMOVE} ${CASE}.*[0-9].${stages_except_output}*${day_time}* &
+ endif
+ else
+
+ echo "Preserving (compressed) restart file set (DD_SSSSS ${day_time})"
+
+ # Optionally COPY inflation restarts to the same place as the other inflation restarts.
+ if ($save_all_inf =~ TRUE) then
+ ${COPY} ${CASE}*inf*${day_time}* ${archive}/esp/hist &
+ endif
+
+ # Optionally REMOVE stages' ensemble members (not means and sds).
+ if ($save_stages_freq =~ NONE ) then
+ echo "Removing unneeded stages' ensemble members (DD_SSSSS ${day_time}) from RUNDIR: "
+ echo " ${CASE}"'*'[0-9].${stages_except_output}'*'${day_time}
+ ${REMOVE} ${CASE}.*[0-9].${stages_except_output}*${day_time}* &
+ endif
+
+ wait
+
+ # The list of components determines which restarts are compressed by this call.
+ # List the large files first (more efficient and reliable).
+ # There is another call farther down to compress the DART files every cycle.
+ echo "compress.csh started at `date`"
+ ${CASEROOT}/compress.csh $CASE ${rm_date} $ensemble_size "clm2 cpl cam cice" "$stages_all"
+ if ($status != 0) then
+ echo "compress.csh failed at `date`"
+ exit 55
+ endif
+ echo "compress.csh finished at `date`"
+
+ # Save the restart set to archive/rest/$datename,
+ # where it will be safe from removes of $component/rest.
+ # There is an implicit assumption that some sort of inflation will be used.
+
+ set save_root = ${archive}/rest/${rm_date}
+ if (! -d $save_root) then
+ mkdir -p $save_root
+ (${MOVE} ${CASE}*.{r,rs,rs1,rh0,h0}.*${day_time}* $save_root || exit 60) &
+ (${MOVE} ${CASE}*.i.[0-9]*${day_time}* $save_root || exit 61) &
+ (${COPY} *.output*inf*${day_time}* $save_root || exit 62) &
+ (${MOVE} *0001*${rm_log[$rm_slot]}* $save_root || exit 63) &
+ (${MOVE} cesm*${rm_log[$rm_slot]}* $save_root || exit 64) &
+ else
+ echo "WARNING: $save_root already exists. Did st_archive make it?"
+# exit 65
+ endif
+ endif
+
+ # Remove log files: *YYMMDD-HHMMSS*. Except not da.log files
+ ${REMOVE} [^d]*${rm_log[$rm_slot]}* &
+
+ # I'd like to remove the CAM .r. files, since we always use the .i. files to do a hybrid start,
+ # but apparently CESM needs them to be there, even though it doesn't read fields from them.
+ # ${REMOVE} ${CASE}.cam*.r.*${day_time}.nc &
+
+endif
+
+# ==============================================================================
+# Block 5: Get observation sequence file ... or die right away.
+# The observation file names have a time that matches the stopping time of CAM.
+#
+# Make sure the file name structure matches the obs you will be using.
+# PERFECT model obs output appends .perfect to the filenames
+# ==============================================================================
+
+set YYYYMM = `printf %04d%02d ${ATM_YEAR} ${ATM_MONTH}`
+
+if (! -d ${BASEOBSDIR}/${YYYYMM}_6H_CESM) then
+ echo "CESM+DART requires 6 hourly obs_seq files in directories of the form YYYYMM_6H_CESM"
+ echo "The directory ${BASEOBSDIR}/${YYYYMM}_6H_CESM is not found. Exiting"
+ exit 70
+endif
+
+set OBSFNAME = `printf obs_seq.%04d-%02d-%02d-%05d ${ATM_YEAR} ${ATM_MONTH} ${ATM_DAY} ${ATM_SECONDS}`
+
+set OBS_FILE = ${BASEOBSDIR}/${YYYYMM}_6H_CESM/${OBSFNAME}
+echo "OBS_FILE = $OBS_FILE"
+
+${REMOVE} obs_seq.out
+if ( -e ${OBS_FILE} ) then
+ ${LINK} ${OBS_FILE} obs_seq.out || exit 80
+else
+ echo "ERROR ... no observation file ${OBS_FILE}"
+ echo "ERROR ... no observation file ${OBS_FILE}"
+ exit 81
+endif
+
+# ==============================================================================
+# Block 6: DART INFLATION
+# This block is only relevant if 'inflation' is turned on AND
+# inflation values change through time:
+# filter_nml
+# inf_flavor(:) = 2 (or 3 (or 4 for posterior))
+# inf_initial_from_restart = .TRUE.
+# inf_sd_initial_from_restart = .TRUE.
+#
+# This block stages the files that contain the inflation values.
+# The inflation files are essentially duplicates of the DART model state,
+# which have names in the CESM style, something like
+# ${case}.dart.rh.${scomp}_output_priorinf_{mean,sd}.YYYY-MM-DD-SSSSS.nc
+# The strategy is to use the latest such files in ${RUNDIR}.
+# If those don't exist at the start of an assimilation,
+# this block creates them with 'fill_inflation_restart'.
+# If they don't exist AFTER the first cycle, the script will exit
+# because they should have been available from a previous cycle.
+# The script does NOT check the model date of the files for consistency
+# with the current forecast time, so check that the inflation mean
+# files are evolving as expected.
+#
+# CESM's st_archive should archive the inflation restart files
+# like any other "restart history" (.rh.) files; copying the latest files
+# to the archive directory, and moving all of the older ones.
+# ==============================================================================
+
+# If we need to run fill_inflation_restart, CAM:static_init_model()
+# always needs a caminput.nc and a cam_phis.nc for geometry information, etc.
+
+set MYSTRING = `grep cam_template_filename input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+set CAMINPUT = $MYSTRING[2]
+${REMOVE} ${CAMINPUT}
+${LINK} ${CASE}.cam_0001.i.${ATM_DATE_EXT}.nc ${CAMINPUT} || exit 90
+
+# All of the .h0. files contain the same PHIS field, so we can link to any of them.
+
+set hists = `${LIST} ${CASE}.cam_0001.h0.*.nc`
+set MYSTRING = `grep cam_phis_filename input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+set CAM_PHIS = $MYSTRING[2]
+${REMOVE} ${CAM_PHIS}
+${LINK} $hists[1] ${CAM_PHIS} || exit 100
+
+# Now, actually check the inflation settings
+
+set MYSTRING = `grep inf_flavor input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,'\.]# #g"`
+set PRIOR_INF = $MYSTRING[2]
+set POSTE_INF = $MYSTRING[3]
+
+set MYSTRING = `grep inf_initial_from_restart input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,'\.]# #g"`
+
+# If no inflation is requested, the inflation restart source is ignored
+
+if ( $PRIOR_INF == 0 ) then
+ set PRIOR_INFLATION_FROM_RESTART = ignored
+ set USING_PRIOR_INFLATION = false
+else
+ set PRIOR_INFLATION_FROM_RESTART = `echo $MYSTRING[2] | tr '[:upper:]' '[:lower:]'`
+ set USING_PRIOR_INFLATION = true
+endif
+
+if ( $POSTE_INF == 0 ) then
+ set POSTE_INFLATION_FROM_RESTART = ignored
+ set USING_POSTE_INFLATION = false
+else
+ set POSTE_INFLATION_FROM_RESTART = `echo $MYSTRING[3] | tr '[:upper:]' '[:lower:]'`
+ set USING_POSTE_INFLATION = true
+endif
+
+if ($USING_PRIOR_INFLATION == false ) then
+ set stages_requested = 0
+ if ( $STAGE_input == TRUE ) @ stages_requested++
+ if ( $STAGE_forecast == TRUE ) @ stages_requested++
+ if ( $STAGE_preassim == TRUE ) @ stages_requested++
+ if ( $stages_requested > 1 ) then
+ echo " "
+ echo "WARNING ! ! Redundant output is requested at multiple stages before assimilation."
+ echo " Stages 'input' and 'forecast' are always redundant."
+ echo " Prior inflation is OFF, so stage 'preassim' is also redundant. "
+ echo " We recommend requesting just 'preassim'."
+ echo " "
+ endif
+endif
+
+if ($USING_POSTE_INFLATION == false ) then
+ set stages_requested = 0
+ if ( $STAGE_postassim == TRUE ) @ stages_requested++
+ if ( $STAGE_analysis == TRUE ) @ stages_requested++
+ if ( $STAGE_output == TRUE ) @ stages_requested++
+ if ( $stages_requested > 1 ) then
+ echo " "
+ echo "WARNING ! ! Redundant output is requested at multiple stages after assimilation."
+ echo " Stages 'output' and 'analysis' are always redundant."
+ echo " Posterior inflation is OFF, so stage 'postassim' is also redundant. "
+ echo " We recommend requesting just 'output'."
+ echo " "
+ endif
+endif
+
+# IFF we want PRIOR inflation:
+
+if ($USING_PRIOR_INFLATION == true) then
+ if ($PRIOR_INFLATION_FROM_RESTART == false) then
+
+ echo "inf_flavor(1) = $PRIOR_INF, using namelist values."
+
+ else
+ # Look for the output from the previous assimilation (or fill_inflation_restart)
+ # If inflation files exists, use them as input for this assimilation
+ (${LIST} -rt1 *.dart.rh.${scomp}_output_priorinf_mean* | tail -n 1 >! latestfile) > & /dev/null
+ (${LIST} -rt1 *.dart.rh.${scomp}_output_priorinf_sd* | tail -n 1 >> latestfile) > & /dev/null
+ set nfiles = `cat latestfile | wc -l`
+
+ if ( $nfiles > 0 ) then
+
+ set latest_mean = `head -n 1 latestfile`
+ set latest_sd = `tail -n 1 latestfile`
+ # Need to COPY instead of link because of short-term archiver and disk management.
+ ${COPY} $latest_mean input_priorinf_mean.nc
+ ${COPY} $latest_sd input_priorinf_sd.nc
+
+ else if ($CONT_RUN == FALSE) then
+
+ # It's the first assimilation; try to find some inflation restart files
+ # or make them using fill_inflation_restart.
+ # Fill_inflation_restart needs caminput.nc and cam_phis.nc for static_model_init,
+ # so this staging is done in assimilate.csh (after a forecast) instead of stage_cesm_files.
+
+ if (-x ${EXEROOT}/fill_inflation_restart) then
+
+ ${EXEROOT}/fill_inflation_restart
+
+ else
+ echo "ERROR: Requested PRIOR inflation restart for the first cycle."
+ echo " There are no existing inflation files available "
+ echo " and ${EXEROOT}/fill_inflation_restart is missing."
+ echo "EXITING"
+ exit 112
+ endif
+
+ else
+ echo "ERROR: Requested PRIOR inflation restart, "
+ echo ' but files *.dart.rh.${scomp}_output_priorinf_* do not exist in the ${RUNDIR}.'
+ echo ' If you are changing from cam_no_assimilate.csh to assimilate.csh,'
+ echo ' you might be able to continue by changing CONTINUE_RUN = FALSE for this cycle,'
+ echo ' and restaging the initial ensemble.'
+ ${LIST} -l *inf*
+ echo "EXITING"
+ exit 115
+ endif
+ endif
+else
+ echo "Prior Inflation not requested for this assimilation."
+endif
+
+# POSTERIOR: We look for the 'newest' and use it - IFF we need it.
+
+if ($USING_POSTE_INFLATION == true) then
+ if ($POSTE_INFLATION_FROM_RESTART == false) then
+
+ # we are not using an existing inflation file.
+ echo "inf_flavor(2) = $POSTE_INF, using namelist values."
+
+ else
+ # Look for the output from the previous assimilation (or fill_inflation_restart).
+ # (The only stage after posterior inflation.)
+ (${LIST} -rt1 *.dart.rh.${scomp}_output_postinf_mean* | tail -n 1 >! latestfile) > & /dev/null
+ (${LIST} -rt1 *.dart.rh.${scomp}_output_postinf_sd* | tail -n 1 >> latestfile) > & /dev/null
+ set nfiles = `cat latestfile | wc -l`
+
+ # If one exists, use it as input for this assimilation
+ if ( $nfiles > 0 ) then
+
+ set latest_mean = `head -n 1 latestfile`
+ set latest_sd = `tail -n 1 latestfile`
+ ${LINK} $latest_mean input_postinf_mean.nc || exit 120
+ ${LINK} $latest_sd input_postinf_sd.nc || exit 121
+
+ else if ($CONT_RUN == FALSE) then
+ # It's the first assimilation; try to find some inflation restart files
+ # or make them using fill_inflation_restart.
+ # Fill_inflation_restart needs caminput.nc and cam_phis.nc for static_model_init,
+ # so this staging is done in assimilate.csh (after a forecast) instead of stage_cesm_files.
+
+ if (-x ${EXEROOT}/fill_inflation_restart) then
+ ${EXEROOT}/fill_inflation_restart
+ ${MOVE} prior_inflation_mean.nc input_postinf_mean.nc || exit 125
+ ${MOVE} prior_inflation_sd.nc input_postinf_sd.nc || exit 126
+
+ else
+ echo "ERROR: Requested POSTERIOR inflation restart for the first cycle."
+ echo " There are no existing inflation files available "
+ echo " and ${EXEROOT}/fill_inflation_restart is missing."
+ echo "EXITING"
+ exit 127
+ endif
+
+ else
+ echo "ERROR: Requested POSTERIOR inflation restart, "
+ echo ' but files *.dart.rh.${scomp}_output_postinf_* do not exist in the ${RUNDIR}.'
+ ${LIST} -l *inf*
+ echo "EXITING"
+ exit 128
+ endif
+ endif
+else
+ echo "Posterior Inflation not requested for this assimilation."
+endif
+
+# ==============================================================================
+# Block 7: Actually run the assimilation.
+#
+# DART namelist settings required:
+# &filter_nml
+# adv_ens_command = "no_CESM_advance_script",
+# obs_sequence_in_name = 'obs_seq.out'
+# obs_sequence_out_name = 'obs_seq.final'
+# single_file_in = .false.,
+# single_file_out = .false.,
+# stages_to_write = stages you want + ,'output'
+# input_state_file_list = 'cam_init_files'
+# output_state_file_list = 'cam_init_files',
+#
+# WARNING: the default mode of this script assumes that
+# input_state_file_list = output_state_file_list, so that
+# the CAM initial files used as input to filter will be overwritten.
+# The input model states can be preserved by requesting that stage
+# 'forecast' be output.
+#
+# ==============================================================================
+
+# In the default mode of CAM assimilations, filter gets the model state(s)
+# from CAM initial files. This section puts the names of those files into a text file.
+# The name of the text file is provided to filter in filter_nml:input_state_file_list.
+
+# NOTE:
+# If the files in input_state_file_list are CESM initial files (all vars and
+# all meta data), then they will end up with a different structure than
+# the non-'output', stage output written by filter ('preassim', 'postassim', etc.).
+# This can be prevented (at the cost of more disk space) by copying
+# the CESM format initial files into the names filter will use for preassim, etc.:
+# > cp $case.cam_0001.i.$date.nc preassim_member_0001.nc.
+# > ... for all members
+# Filter will replace the state variables in preassim_member* with updated versions,
+# but leave the other variables and all metadata unchanged.
+
+# If filter will create an ensemble from a single state,
+# filter_nml: perturb_from_single_instance = .true.
+# it's fine (and convenient) to put the whole list of files in input_state_file_list.
+# Filter will just use the first as the base to perturb.
+
+set line = `grep input_state_file_list input.nml | sed -e "s#[=,'\.]# #g"`
+set input_file_list_name = $line[2]
+
+# If the file names in $output_state_file_list = names in $input_state_file_list,
+# then the restart file contents will be overwritten with the states updated by DART.
+
+set line = `grep output_state_file_list input.nml | sed -e "s#[=,'\.]# #g"`
+set output_file_list_name = $line[2]
+
+if ($input_file_list_name != $output_file_list_name) then
+ echo "ERROR: assimilate.csh requires that input_file_list = output_file_list"
+ echo " You can probably find the data you want in stage 'forecast'."
+ echo " If you truly require separate copies of CAM's initial files"
+ echo " before and after the assimilation, see revision 12603, and note that"
+ echo " it requires changing the linking to cam_initial_####.nc, below."
+ exit 130
+endif
+
+${LIST} -1 ${CASE}.cam_[0-9][0-9][0-9][0-9].i.${ATM_DATE_EXT}.nc >! $input_file_list_name
+
+echo "`date` -- BEGIN FILTER"
+${LAUNCHCMD} ${EXEROOT}/filter || exit 140
+echo "`date` -- END FILTER"
+
+# ==============================================================================
+# Block 8: Rename the output using the CESM file-naming convention.
+# ==============================================================================
+
+# If output_state_file_list is filled with custom (CESM) filenames,
+# then 'output' ensemble members will not appear with filter's default,
+# hard-wired names. But file types output_{mean,sd} will appear and be
+# renamed here.
+#
+# We don't know the exact set of files which will be written,
+# so loop over all possibilities: use LIST in the foreach.
+# LIST will expand the variables and wildcards, only existing files will be
+# in the foreach loop. (If the input.nml has num_output_state_members = 0,
+# there will be no output_member_xxxx.nc even though the 'output' stage
+# may be requested - for the mean and sd)
+#
+# Handle files with instance numbers first.
+# split off the .nc
+# separate the pieces of the remainder
+# grab all but the trailing 'member' and #### parts.
+# and join them back together
+
+echo "`date` -- BEGIN FILE RENAMING"
+
+# The short-term archiver archives files depending on pieces of their names.
+# '_####.i.' files are CESM initial files.
+# '.dart.i.' files are ensemble statistics (mean, sd) of just the state variables
+# in the initial files.
+# '.e.' designates a file as something from the 'external system processing ESP', e.g. DART.
+
+foreach FILE (`${LIST} ${stages_all}_member_*.nc`)
+
+ set parts = `echo $FILE | sed -e "s#\.# #g"`
+ set list = `echo $parts[1] | sed -e "s#_# #g"`
+ @ last = $#list - 2
+ set dart_file = `echo $list[1-$last] | sed -e "s# #_#g"`
+
+ # DART 'output_member_****.nc' files are actually linked to cam input files
+
+ set type = "e"
+ echo $FILE | grep "put"
+ if ($status == 0) set type = "i"
+
+ ${MOVE} $FILE \
+ ${CASE}.${scomp}_$list[$#list].${type}.${dart_file}.${ATM_DATE_EXT}.nc || exit 150
+end
+
+# Files without instance numbers need to have the scomp part of their names = "dart".
+# This is because in st_archive, all files with scomp = "cam"
+# (= compname in env_archive.xml) will be st_archived using a pattern
+# which has the instance number added onto it. {mean,sd} files don't have
+# instance numbers, so they need to be archived by the "dart" section of env_archive.xml.
+# But they still need to be different for each component, so include $scomp in the
+# ".dart_file" part of the file name. Somewhat awkward and inconsistent, but effective.
+
+# Means and standard deviation files (except for inflation).
+foreach FILE (`${LIST} ${stages_all}_{mean,sd}*.nc`)
+
+ set parts = `echo $FILE | sed -e "s#\.# #g"`
+ set type = "e"
+ echo $FILE | grep "put"
+ if ($status == 0) set type = "i"
+
+ ${MOVE} $FILE ${CASE}.dart.${type}.${scomp}_$parts[1].${ATM_DATE_EXT}.nc || exit 160
+end
+
+# Rename the observation file and run-time output
+
+${MOVE} obs_seq.final ${CASE}.dart.e.${scomp}_obs_seq_final.${ATM_DATE_EXT} || exit 170
+${MOVE} dart_log.out ${scomp}_dart_log.${ATM_DATE_EXT}.out || exit 171
+
+# Rename the inflation files and designate them as 'rh' files - which get
+# reinstated in the run directory by the short-term archiver and are then
+# available for the next assimilation cycle.
+#
+# Accommodate any possible inflation files.
+# The .${scomp}_ part is needed by DART to distinguish
+# between inflation files from separate components in coupled assims.
+
+foreach FILE (`${LIST} ${stages_all}_{prior,post}inf_*`)
+
+ set parts = `echo $FILE | sed -e "s#\.# #g"`
+ ${MOVE} $FILE ${CASE}.dart.rh.${scomp}_$parts[1].${ATM_DATE_EXT}.nc || exit 180
+
+end
+
+# Handle localization_diagnostics_files
+set MYSTRING = `grep 'localization_diagnostics_file' input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+set MYSTRING = `echo $MYSTRING | sed -e 's#"# #g'`
+set loc_diag = $MYSTRING[2]
+if (-f $loc_diag) then
+ ${MOVE} $loc_diag ${scomp}_${loc_diag}.dart.e.${ATM_DATE_EXT} || exit 190
+endif
+
+# Handle regression diagnostics
+set MYSTRING = `grep 'reg_diagnostics_file' input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+set MYSTRING = `echo $MYSTRING | sed -e 's#"# #g'`
+set reg_diag = $MYSTRING[2]
+if (-f $reg_diag) then
+ ${MOVE} $reg_diag ${scomp}_${reg_diag}.dart.e.${ATM_DATE_EXT} || exit 200
+endif
+
+# Then this script will need to feed the files in output_restart_list_file
+# to the next model advance.
+# This gets the .i. or .r. piece from the CESM format file name.
+set line = `grep 0001 $output_file_list_name | sed -e "s#[\.]# #g"`
+set l = 1
+while ($l < $#line)
+ if ($line[$l] =~ ${scomp}_0001) then
+ @ l++
+ set file_type = $line[$l]
+ break
+ endif
+ @ l++
+end
+
+set member = 1
+while ( ${member} <= ${ensemble_size} )
+
+ set inst_string = `printf _%04d $member`
+ set ATM_INITIAL_FILENAME = ${CASE}.${scomp}${inst_string}.${file_type}.${ATM_DATE_EXT}.nc
+
+ ${REMOVE} ${scomp}_initial${inst_string}.nc
+ ${LINK} $ATM_INITIAL_FILENAME ${scomp}_initial${inst_string}.nc || exit 210
+
+ @ member++
+
+end
+
+echo "`date` -- END FILE RENAMING"
+
+if ($cycle == $DATA_ASSIMILATION_CYCLES) then
+ echo "`date` -- BEGIN (NON-RESTART) ARCHIVING LOGIC"
+
+ if ($#log_list >= 3) then
+
+ # During the last cycle, hide the previous restart set
+ # so that it's not archived, but is available.
+ # (Coupled assimilations may need to keep multiple atmospheric
+ # cycles for each ocean cycle.)
+
+ set FILE = $re_list[2]
+ set FILE = $FILE:r
+ if ($FILE:e == 'nc') set FILE = $FILE:r
+ set hide_date = $FILE:e
+ set HIDE_DATE_PARTS = `echo $hide_date | sed -e "s#-# #g"`
+ set day_o_month = $HIDE_DATE_PARTS[3]
+ set sec_o_day = $HIDE_DATE_PARTS[4]
+ set day_time = ${day_o_month}-${sec_o_day}
+
+ set hidedir = ../Hide_${day_time}
+ mkdir $hidedir
+
+ if ($save_all_inf =~ TRUE) then
+ # Put the previous and current inflation restarts in the archive directory.
+ # (to protect last from st_archive putting them in exp/hist)
+ ${MOVE} ${CASE}*${stages_except_output}*inf* ${archive}/esp/rest
+
+ # Don't need previous inf restarts now, but want them to be archived later.
+ # COPY instead of LINK because they'll be moved or used later.
+ ${COPY} ${CASE}*output*inf* ${archive}/esp/rest
+ else
+ # output*inf must be copied back because it needs to be in ${RUNDIR}
+ # when st_archive runs to save the results of the following assim
+ ${MOVE} ${CASE}*inf*${day_time}* $hidedir
+
+ # Don't need previous inf restarts now, but want them to be archived later.
+ ${COPY} $hidedir/${CASE}*output*inf*${day_time}* .
+ endif
+
+ # Hide the CAM 'restart' files from the previous cycle (day_time) from the archiver.
+ ${MOVE} ${CASE}*.{r,rs,rs1,rh0,h0,i}.*${day_time}* $hidedir
+
+ # Move log files: *YYMMDD-HHMMSS. [2] means the previous restart set is being moved.
+ set rm_log = `echo $log_list[2] | sed -e "s/\./ /g;"`
+ # -- (decrement by one) skips the gz at the end of the names.
+ set rm_slot = $#rm_log
+ if ($rm_log[$#rm_log] =~ gz) @ rm_slot--
+ ${MOVE} *$rm_log[$rm_slot]* $hidedir
+ endif
+
+ # Restore CESM's timing logic for the first cycle of the next job.
+ cd ${CASEROOT}
+ ./xmlchange CHECK_TIMING=${CHECK_TIMING}
+ cd ${RUNDIR}
+
+ # Create a netCDF file which contains the names of DART inflation restart files.
+ # This is needed in order to use the CESM st_archive mechanisms for keeping,
+ # in $RUNDIR, history files which are needed for restarts.
+ # These special files must be labeled with '.rh.'.
+ # St_archive looks in a .r. restart file for the names of these 'restart history' files.
+ # DART's inflation files fit the definition of restart history files, so we put .rh.
+ # in their names. Those file names must be found in a dart.r. file, which is created here.
+ # Inflation restart file names for all components will be in this one restart file,
+ # since the inflation restart files have the component names in them.
+
+ set inf_list = `ls *output_{prior,post}inf_*.${ATM_DATE_EXT}.nc`
+ set file_list = 'restart_hist = "./'$inf_list[1]\"
+ set i = 2
+ while ($i <= $#inf_list)
+ set file_list = (${file_list}\, \"./$inf_list[$i]\")
+ @ i++
+ end
+ cat << ___EndOfText >! inf_restart_list.cdl
+ netcdf template { // CDL file which ncgen will use to make a DART restart file
+ // containing just the names of the needed inflation restart files.
+ dimensions:
+ num_files = $#inf_list;
+ variables:
+ string restart_hist(num_files);
+ restart_hist:long_name = "DART restart history file names";
+ data:
+ $file_list;
+ }
+___EndOfText
+
+ ncgen -k netCDF-4 -o ${CASE}.dart.r.${scomp}.${ATM_DATE_EXT}.nc inf_restart_list.cdl
+ if ($status == 0) ${REMOVE} inf_restart_list.cdl
+
+ echo "`date` -- END ARCHIVING LOGIC"
+
+ # DEBUG st_archive by making a shadow copy of this directory.
+ module load nco
+
+ if (-d ../run_shadow) ${REMOVE} -f ../run_shadow
+ mkdir ../run_shadow
+
+ set comps = ('cam_' 'clm2_' 'mosart_' 'dart')
+ set vars = ('nhfil' 'locfnh' 'locfnh' 'restart_hist')
+
+ foreach f (`$LIST[1]`)
+ set gr_stat = 1
+ echo $f | grep '\.r\.'
+ if ($status == 0) then
+ set c = 1
+ while ($c <= $#comps)
+ echo $f | grep $comps[$c]
+ if ($status == 0) then
+ echo "c = $c for $f"
+# set echo verbose
+ set gr_stat = 0
+ ncks -O -v $vars[$c] $f ../run_shadow/$f
+ break
+ endif
+ @ c++
+ end
+ endif
+ if ($gr_stat == 1) then
+ ${LIST} -l $f >! ../run_shadow/$f
+ endif
+ end
+
+endif
+
+# ==============================================================================
+# Compress the large coupler history files and DART files.
+# ==============================================================================
+
+echo "STARTING: compressing coupler history files and DART files at `date`"
+
+${CASEROOT}/compress.csh $CASE $ATM_DATE_EXT $ensemble_size "hist dart" "$stages_all"
+if ($status != 0) then
+ echo "ERROR: Compression of coupler history files and DART files failed at `date`"
+ # Ensure the removal of unneeded restart sets and copy of obs_seq.final are finished.
+ wait
+ exit 250
+endif
+
+echo "FINISHED: compressing coupler history files and DART files at `date`"
+echo "`date` -- END CAM_ASSIMILATE"
+
+# Ensure the removal of unneeded restart sets and copy of obs_seq.final are finished.
+wait
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/shell_scripts/cesm2_1/compress.csh b/models/cam-fv/shell_scripts/cesm2_1/compress.csh
new file mode 100755
index 0000000000..035abdb0cb
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/compress.csh
@@ -0,0 +1,281 @@
+#!/bin/tcsh
+#
+# 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
+#
+# DART $Id$
+#
+#PBS -N compress.csh
+#PBS -A P86850054
+#PBS -q premium
+# For restarts:
+# #PBS -l select=9:ncpus=36:mpiprocs=36
+# For hist: 6 * 80 = 480
+# For dart: 1 + 2*(2 + 80) = 165
+# 645 / 36 = 18
+# For rest: 4 * 80 = 320 / 36 = 9
+#PBS -l select=18:ncpus=36:mpiprocs=36
+#PBS -l walltime=00:20:00
+#PBS -o compress.out
+#PBS -j oe
+
+# ------------------------------------------------------------------------------
+# Purpose:
+#
+# compresses or uncompresses sets of files from a forecast or assimilation.
+#
+# ------------------------------------------------------------------------------
+#
+# Method:
+#
+# When called from a script (normally assimilate.csh), it compresses the files.
+# When submitted as a batch job, it can also uncompress sets of files -
+# IF this script has been configured to use the right metadata to
+# construct the expected data directories.
+#
+# The strategy is to create a cmdfile that contains a separate task on each line
+# and dispatch that cmdfile to perform N simultaneous operations. That cmdfile
+# has a syntax ( &> ) to put stderr and stdout in a single file.
+# PBS requires 'setenv MPI_SHEPHERD true' for the cmdfile to work correctly.
+#
+# Compression method can depend on the file type, and in the future may include
+# lossy compression. This script is most often called by assimilate.csh, but can
+# be run as a batch job.
+#
+# Assimilate.csh runs this in 2 places:
+# 1) Every cycle:
+# + all the cpl history (forcing) files.
+# + DART output
+# > stages of state files
+# mean, sd (no instance number)
+# > obs_seq.final (no instance number)
+# > Note: inflation files are never compressed.
+# 2) Before archiving a restart set to archive/rest; all large restart files.
+# ------------------------------------------------------------------------------
+
+if ($#argv == 5) then
+ # Called from assimilate.csh (or other script).
+ set comp_cmd = 'gzip'
+ set case_name = $1
+ set ymds = $2
+ set ensemble_size = $3
+ set sets = ($4)
+ set stages = ($5)
+ set data_dir = '.'
+
+else if ($#argv == 0) then
+ # Edit these and run as a batch job.
+ # 'sets' performs better when ordered by decreasing size (clm2 cpl cam cice hist dart)
+ set comp_cmd = 'gunzip'
+ set case_name = CESM2_1_80_3node
+ set ymds = 2010-07-17-64800
+ set ensemble_size = 80
+ set sets = (hist dart)
+ # set sets = (clm2 cpl cam cice)
+ set stages = (preassim output)
+ # set data_dir = /glade/scratch/${USER}/${case_name}/archive/rest/${ymds}
+ set data_dir = /glade/scratch/${USER}/${case_name}/run
+
+else
+ echo "Usage: call with exactly 5 arguments or submit as a batch job with 0 arguments:"
+ echo ' ${scr_dir}/compress.csh case_name YYYY-MM-DD-SSSS ensemble_size "sets" "stages"'
+ echo ' where '
+ echo ' sets = 1 or more of {clm2 cpl cam cice hist dart} to compress, separated by spaces'
+ echo ' stages = 1 or more of stages {input, preassim, postassim, output} to compress.'
+ echo ' -OR-'
+ echo " edit compress.csh ; qsub compress.csh"
+ exit 17
+
+endif
+
+set cmd = `echo $comp_cmd | cut -d' ' -f1`
+if ($cmd == 'gzip') then
+ set ext = ''
+else if ($cmd == 'gunzip') then
+ set ext = '.gz'
+else
+ echo "ERROR: unrecognized command $cmd. Don't know which extension to use"
+ exit 27
+endif
+
+echo "In compress.csh:"
+echo " comp_cmd = $comp_cmd"
+echo " case_name = $case_name"
+echo " date = $ymds"
+echo " ensemble_size = $ensemble_size"
+echo " sets = $sets"
+echo " stages = $stages"
+echo " data dir = $data_dir"
+
+cd $data_dir
+
+# ------------------------------------------------------------------------------
+# Fail if there are leftover error logs from previous compression.csh executions.
+
+ls *.eo > /dev/null
+if ($status == 0) then
+ echo "ERROR; Existing compression log files: *.eo. Exiting"
+ exit 37
+endif
+
+# --------------------------
+# Environment and commands.
+
+
+setenv MPI_SHEPHERD true
+
+setenv date 'date --rfc-3339=ns'
+
+# ------------------------------------------------------------------------------
+# Create the command file where each line is a separate command, task, operation, ....
+
+\rm -f mycmdfile
+touch mycmdfile
+
+# 'task' is incremented continuously over all files; components, members, etc.
+# 'task' is a running counter of jobs in mycmdfile.
+set task = 0
+
+foreach comp ( $sets )
+echo "comp = $comp"
+switch ($comp)
+ # FIXME ... the coupler files may or may not have an instance number in them.
+ case {clm2,cpl,cam,cice}:
+ set i=1
+ while ( $i <= $ensemble_size)
+ # E.g. CAM6_80mem.cice_0001.r.2010-07-15-00000.nc
+ set file_name = `printf "%s.%s_%04d.r.%s.nc%s" $case_name $comp $i $ymds $ext`
+ # echo " $file_name"
+
+ # If the expected file exists, add the compression command
+ if (-f $file_name) then
+ @ task++
+ echo "$comp_cmd $file_name &> compress_${task}.eo " >> mycmdfile
+ # Kluge to get around situations where an earlier job compressed the file,
+ # but failed for some other reason, so it's being re-run.
+ else if (-f ${file_name}.gz) then
+ echo "$file_name already compressed"
+ else
+ echo 'ERROR: Could not find "'$file_name'" to compress.'
+ exit 47
+ endif
+
+ @ i++
+ end
+ breaksw
+
+ case hist:
+ # Coupler history (forcing) files, ordered by decreasing size
+ # ha is not a necessary forcing file. The others can do the job
+ # and are much smaller.
+ foreach type ( ha2x1d hr2x ha2x3h ha2x1h ha2x1hi )
+ # Loop over instance number
+ set i=1
+ while ( $i <= $ensemble_size)
+ # E.g. CAM6_80mem.cpl_0001.ha.2010-07-15-00000.nc
+ set file_name = `printf "%s.cpl_%04d.%s.%s.nc%s" $case_name $i $type $ymds $ext`
+
+ if (-f $file_name) then
+ @ task++
+ echo "$comp_cmd $file_name &> compress_${task}.eo" >> mycmdfile
+ else if (-f ${file_name}.gz) then
+ echo "$file_name already compressed"
+ else
+ echo 'ERROR: Could not find "'$file_name'" to compress.'
+ exit 57
+ endif
+
+ @ i++
+ end
+ end
+ breaksw
+
+ case dart:
+ # It is not worthwhile to compress inflation files ... small, not many files
+ # It is also not clear that binary observation sequence files compress effectively.
+
+ # obs_seq.final (no inst) 70% of 1 Gb (ascii) in 35 sec
+ # E.g. CAM6_80mem.dart.e.cam_obs_seq_final.2010-07-15-00000
+ set file_name = ${case_name}.dart.e.cam_obs_seq_final.${ymds}${ext}
+ if (-f $file_name) then
+ @ task++
+ echo "$comp_cmd $file_name &> compress_${task}.eo" >> mycmdfile
+ endif
+
+ foreach stage ($stages)
+ foreach stat ( 'mean' 'sd' )
+ # E.g. CAM6_80mem.e.cam_output_mean.2010-07-15-00000.nc
+ # E.g. CAM6_80mem.e.cam_output_sd.2010-07-15-00000.nc
+ set file_name = ${case_name}.dart.e.cam_${stage}_${stat}.${ymds}.nc${ext}
+ if (-f $file_name) then
+ @ task++
+ echo "$comp_cmd $file_name &> compress_${task}.eo" >> mycmdfile
+ endif
+ end
+
+ # Loop over instance number
+ set i=1
+ while ( $i <= $ensemble_size)
+ # E.g. CAM6_80mem.cam_0001.e.preassim.2010-07-15-00000.nc
+ set file_name = `printf "%s.cam_%04d.e.%s.%s.nc%s" $case_name $i $stage $ymds $ext`
+ if (-f $file_name) then
+ @ task++
+ echo "$comp_cmd $file_name &> compress_${task}.eo" >> mycmdfile
+ endif
+ @ i++
+ end
+ end
+ breaksw
+
+ default:
+ breaksw
+endsw
+end
+
+# ------------------------------------------------------------------------------
+
+echo "Before launching mycmdfile"
+
+$date
+
+# CHECKME ... make sure $task is <= the number of MPI tasks in this job.
+
+if ($task > 0) then
+ mpiexec_mpt -n $task launch_cf.sh ./mycmdfile
+
+ set mpt_status = $status
+ echo "mpt_status = $mpt_status"
+else
+ echo "No compression to do"
+ exit 0
+endif
+
+# Check the statuses?
+if ( -f compress_1.eo ) then
+ grep $cmd *.eo
+ # grep failure = compression success = "not 0"
+ set gr_stat = $status
+# echo "gr_stat when eo file exists = $gr_stat"
+else
+ # No eo files = failure of something besides g(un)zip.
+ set gr_stat = 0
+# echo "gr_stat when eo file does not exist = $gr_stat"
+endif
+
+if ($gr_stat == 0) then
+ echo "compression failed. See .eo files with non-0 sizes"
+ echo "Remove .eo files after failure is resolved."
+ exit 197
+else
+ # Compression worked; clean up the .eo files and mycmdfile
+ \rm -f *.eo mycmdfile
+endif
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/shell_scripts/cesm2_1/mv_to_campaign.csh b/models/cam-fv/shell_scripts/cesm2_1/mv_to_campaign.csh
new file mode 100755
index 0000000000..961c8f712c
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/mv_to_campaign.csh
@@ -0,0 +1,207 @@
+#!/bin/tcsh
+
+# 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
+#
+# DART $Id$
+
+
+# Script to package output from a CAM+DART assimilation,
+# especially the Reanalysis project (2019),
+# and send it to Campaign storage.
+# It's derived from ./mv_to_campaign.sample.csh.
+# Documentation of that script is in
+# https://www2.cisl.ucar.edu/sites/default/files/CISL_GlobusCLI_Nov2018.html
+
+# To get access to the python globus command it seems necessary
+# to do the following from the command line (not in python):
+
+# > module load gnu python (even though the python command is available without loading)
+# > ncar_pylib
+# > globus --help
+
+# This will show the commands that can be given to globus, like 'endpoint'
+# The subcommands of 'endpoint', like 'search' can be seen with
+
+# > globus list-commands
+
+# But that shows subcommands of all commands. Focus the search with
+
+# > globus [command [subcommand]] --help
+# For example
+# > globus endpoint activate --help
+
+# will show obscura such as --myproxy (below).
+
+# >> Add error checking on arguments
+# and a "Usage:" section
+
+# Case name
+set CASENAME = "$1"
+# or set these explicitly in here?
+# Depends whether it will be run from another script.
+
+# Set analysis time.
+# But we'll be archiving multiple times at once.
+# But maybe by month, so YYYY-MM would be useful.
+set TIMESTR="$2"
+
+# Need log file time stamp time?
+set STAMP = "$3"
+
+# Beware: the label cannot contain slashes. valid chars are only:
+# A-Z, a-z, 0-9, space, hyphen, underscore, and comma
+# No '.'?
+# Max length is 128 chars.
+set LABEL = "copy of $CASENAME dares project files for $TIMESTR"
+
+# Declare paths to use in script (EDIT THESE BEFORE RUNNING!)
+# set SRC_DIR=/glade/scratch/${USER}/${CASENAME}/archive
+set SRC_DIR=/glade/p/cisl/dares/Reanalyses/${CASENAME}/archive
+# Campaign Storage
+# Change a dir name to Reanalyses or ...sis?
+set CS_DIR=/gpfs/csfs1/cisl/dares/Reanalysis/CAM6_2017/
+
+# Done with input parameters.
+#=================================================================
+
+set AnY=`date -d $TIMESTR '+%Y'`
+set AnM=`date -d $TIMESTR '+%m'`
+# set AnD=`date -d $TIMESTR '+%d'`
+set AN_DATE = ${AnY}${AnM}
+set glog = globus_${AN_DATE}.log
+
+# start with an empty log
+cd $SRC_DIR:h
+rm -f $glog globus-batch-dirs.txt globus-batch-files.txt
+echo Copy $SRC_DIR to campaign storage $CS_DIR >>& $glog
+
+# Load Python to get the CLI
+module load gnu python
+# Activate the NCAR Python Library (NPL) virtual environment
+# for version given as argument.
+# This command activates the 'globus' command, used below.
+ncar_pylib 20190118
+
+# Retrieve endpoint IDs and store them as variables
+# Access to the globus command comes through the python module.
+# That module requires ncarenv/1.2 gnu/6.3.0 ncarcompilers/0.4.1
+# gnu replaces intel/#.#.# that I have already loaded.
+# OK because that load expires with the end of this script.
+# --filter-owner-id not documented.
+# --jq is A JMESPath expression to apply to json output.
+# Takes precedence over any specified '--format'
+# But this has a '--format UNIX' anyway.
+#
+# EP = endpoint
+set EP_SRC=`globus endpoint search 'NCAR GLADE' \
+ --filter-owner-id ncar@globusid.org \
+ --jq 'DATA[0].id' --format UNIX`
+set EP_CS=`globus endpoint search 'NCAR Campaign Storage' \
+ --filter-owner-id ncar@globusid.org \
+ --jq 'DATA[0].id' --format UNIX`
+
+# Nancy had to add this activation before being able to see
+# the EP_CS location using globus.
+# (E.g. > globus ls ${EP_CS}:/gpfs/csfs1/cisl/dares/Reanalysis/).
+# It seems to activate the endpoints without requiring a password.
+# (Or was she already logged into globus from previous commands?)
+foreach ep ($EP_SRC $EP_CS)
+ # Check if endpoint is activated
+ # (we don't care about output, only return code)
+ globus endpoint is-activated $ep >& /dev/null
+ if ( $status != 0 ) then
+ globus endpoint activate --myproxy --myproxy-lifetime 1 $ep
+ if ( $status != 0 ) then
+ echo "Fatal: NCAR endpoint $ep isn't activated." > $glog
+ echo "Aborting transfer..." >> $glog
+ echo "Failed: $AN_DATE to Campaign Storage!" > ~/GLOBUS-ERROR.$AN_DATE
+ exit 1
+ endif
+ endif
+end
+
+set EXPIRE=`globus endpoint is-activated \
+ --jq expire_time -F unix $EP_SRC`
+echo "NCAR endpoints active until $EXPIRE" > $glog
+
+# Check if destination directory exists; if not, create it
+globus ls ${EP_CS}:$CS_DIR >& /dev/null
+
+if ( $status != 0 ) then
+ globus mkdir ${EP_CS}:$CS_DIR >>& $glog
+else
+ echo $CS_DIR already exists on campaign store >>& $glog
+endif
+
+set DESTDIR=${CS_DIR}/$AN_DATE
+globus mkdir ${EP_CS}:${DESTDIR} >>& $glog
+
+# Create a list of files to archive.
+# This is mysterious, since I don't know how the original file names look.
+# set BATCHAnMT="${RUNDIR}/\1 ${DESTDIR}/\1"
+# ls -1 fcst*.nc | sed "s|\(.*\)|${BATCHAnMT}|" > globus-batch.txt
+# Hopefully the output to globus-batch.txt does not have special formatting.
+# It may:
+# "The batch file needs to have full source and destination paths
+# We use a sed command to format our ls output and store it as a bash variable SOUT"
+#
+# The list will depend on the packaging of files:
+# laptop:/Users/raeder/DAI/ATM_forcXX/CAM6_setup/campaign_storage
+
+# this finds directories as well as files. not sure what we need here.
+#ls -1R . | sed -e "s;.*;${SRC_DIR}/& ${CS_DIR}/&;" > globus-batch.txt
+# find . -type d | sed -e "s;.*;globus mkdir ${EP_CS}:${CS_DIR}/&;" >! globus-batch-dirs.txt
+
+# possibly this:
+
+# cd into the source dir
+cd $SRC_DIR
+
+# find all dirs, and get rid of the ./ at the start of each subdir name
+find . -type d | sed -e "s;..;;" >! ../globus-batch-dirs.txt
+
+# find all files, get rid of the ./ at the start of each filename, and
+# convert them to 2 full pathnames: the source and the destination
+find . -type f | sed -e "s;..\(.*\);${SRC_DIR}/\1 ${DESTDIR}/\1;" >! ../globus-batch-files.txt
+
+# do we need to check for their existance first? doing so to be safe.
+echo Creating needed subdirectories
+foreach SUBDIR ( `cat ../globus-batch-dirs.txt` )
+ set target = ${EP_CS}:${CS_DIR}/${SUBDIR}
+
+ # Check if destination directory already exists; if not, create it
+ globus ls $target >& /dev/null
+
+ if ( $status != 0 ) then
+ echo Making $target on campaign store >>& ../$glog
+ globus mkdir $target >>& ../$glog
+ else
+ echo Subdir $target already exists on campaign store >>& ../$glog
+ endif
+end
+
+echo files to be copied are in globus-batch-files.txt
+
+# Start copy of GLADE data holdings to CS
+# Finally, we use the variable contents as stdin to our globus batch transfer
+globus transfer $EP_SRC $EP_CS \
+ --label "$LABEL" \
+ --batch < ../globus-batch-files.txt >>& ../$glog
+
+echo ""
+echo Output of this script is in $SRC_PARENT/$glog.
+echo Transfer is asynchronous. If successfully started,
+echo you will receive email when it is complete
+
+echo ""
+echo Ending script to copy the contents of $SRC_DIR to campaign storage at `date`
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/shell_scripts/cesm2_1/no_assimilate.csh.template b/models/cam-fv/shell_scripts/cesm2_1/no_assimilate.csh.template
new file mode 100644
index 0000000000..d7359841e0
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/no_assimilate.csh.template
@@ -0,0 +1,75 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+# This block is an attempt to localize all the machine-specific
+# changes to this script such that the same script can be used
+# on multiple platforms. This will help us maintain the script.
+
+echo "`date` -- BEGIN CAM_NO_ASSIMILATE"
+
+# The FORCE options are required.
+# The VERBOSE options are useful for debugging though
+# some systems don't like the -v option to any of the following
+set LINK = 'ln -fs'
+
+# If your shell commands don't like the -v option and you want copies to be echoed,
+# set this to be TRUE. Otherwise, it should be FALSE.
+set LINKV = TRUE
+
+# This script is executed in in $CASEROOT, so xmlquery is available
+setenv RUNDIR `./xmlquery RUNDIR --value`
+setenv CASEROOT `./xmlquery CASEROOT --value`
+setenv CASE $CASEROOT:t
+
+setenv num_instances BOGUSNUMINST
+cd $RUNDIR
+
+#-------------------------------------------------------------------------
+# Determine time of model state ... from file name of first member
+# of the form "./${CASE}.cam_${ensemble_member}.i.YYYY-MM-DD-SSSSS.nc"
+#-------------------------------------------------------------------------
+
+if ( $num_instances == 1 ) then
+ set FILE = `head -n 1 rpointer.atm`
+else
+ set FILE = `head -n 1 rpointer.atm_0001`
+endif
+
+set FILE = $FILE:r
+set ATM_DATE_EXT = `echo $FILE:e`
+
+#=========================================================================
+# As implemented, the input filenames are static in the CESM namelists.
+# We must link the new uniquely-named files to static names.
+#=========================================================================
+
+if ( $num_instances == 1 ) then
+ set ATM_INITIAL_FILENAME = ${CASE}.cam.i.${ATM_DATE_EXT}.nc
+ if ($LINKV == FALSE) echo "Linking $ATM_INITIAL_FILENAME cam_initial.nc"
+ $LINK $ATM_INITIAL_FILENAME cam_initial.nc || exit 9
+else
+ set member = 1
+ while ( $member <= $num_instances )
+ set inst_string = `printf _%04d $member`
+ set ATM_INITIAL_FILENAME = ${CASE}.cam${inst_string}.i.${ATM_DATE_EXT}.nc
+ if ($LINKV == FALSE) \
+ echo "Linking $ATM_INITIAL_FILENAME cam_initial${inst_string}.nc"
+ $LINK $ATM_INITIAL_FILENAME cam_initial${inst_string}.nc || exit 10
+ @ member++
+ end
+endif
+
+echo "`date` -- END CAM_NO_ASSIMILATE"
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/shell_scripts/cesm2_1/setup_advanced b/models/cam-fv/shell_scripts/cesm2_1/setup_advanced
new file mode 100755
index 0000000000..35e384de73
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/setup_advanced
@@ -0,0 +1,1336 @@
+#!/bin/csh -f
+#
+# 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
+#
+# DART $Id$
+#
+# This script can be run interactively, but on some systems (e.g. cheyenne)
+# it takes longer than is allowed for an interactive job.
+# In that case, it can be run as a batch job using the directives below,
+# or using "qcmd -q share -l select=1 -- ".
+# The job name should be the name of this script(file),
+# or this file may not be archived in $caseroot causing DART_config to fail.
+#--------------------------------------------
+#BSUB -J setup_advanced
+#BSUB -n 1
+#BSUB -R "span[ptile=1]"
+#BSUB -q shared_node_queue_for_this_setup_script
+#BSUB -P your_account_there
+#BSUB -W 2:00
+#BSUB -u you@email.org
+#BSUB -N
+#BSUB -a poe
+#BSUB -o Test0.bld1
+#BSUB -e Test0.bld1
+#--------------------------------------------
+#PBS -N setup_advanced
+#PBS -A your_account_there
+#PBS -q shared_node_queue_for_this_setup_script
+#
+# Resources to specify:
+# select=#nodes
+# ncpus=#CPUs/node
+# mpiprocs=#MPI_tasks/node
+#PBS -l select=1:ncpus=4:mpiprocs=4
+#PBS -l walltime=01:00:00
+#PBS -m ae
+#PBS -M you@email.org
+# Send standard output and error to this file.
+# It's helpful to use the $casename here.
+#PBS -o Test_0.bld1
+#PBS -j oe
+#
+# ---------------------
+# Purpose
+# ---------------------
+#
+# This script is designed to set up, stage, and build a multi-instance,
+# multi-driver, CESM using an F compset, where CAM-FV, CLM and CICE are active.
+# In contrast to setup_hybrid, it also sets up the environment for doing
+# a CAM assimilation by setting up and running DART_config.
+# It is intended to be used after you have tested the basic set up
+# of CESM and DART for your case, using setup_hybrid and DART_config.
+# It also provides more mechanisms for optimizing the assimilation
+# for scientific studies.
+#
+# Because the atmosphere assimilations typically occur every 6 hours,
+# the methodology here reflects that. All of CESM stops every 6 hours
+# so that a CAM output file will be available for assimilation.
+#
+# ${caseroot}/DART_config is automatically run by this script and will
+# augment the CESM case with the required setup and configuration to use DART
+# to perform an assimilation.
+#
+# ---------------------
+# How to use this script.
+# ---------------------
+#
+# -- You will have to read and understand the script in its entirety.
+# You will have to modify things outside this script.
+# Instructions for what to change to use the CAM-Chem or WACCM are
+# outlined in the models/cam-fv/model_mod.html documentation.
+#
+# -- Examine the whole script to identify things to change for your experiments.
+#
+# -- Edit this script in the $DART/models/cam-fv/shell_scripts directory
+# or copy it and its dependent scripts to somewhere where it will be preserved.
+# It archives itself to the $caseroot directory during its execution.
+#
+# -- Locate or create the initial ensemble files that CESM will need.
+# The initial ensemble can come from a single- or multi-instance reference case.
+#
+# -- DOCN: The compsets required by this script use a single data ocean.
+# This script can use a daily, 1/4 degree resolution, ocean data set,
+# in place of the monthly, 1 or 2 degree set.
+#
+# -- Run this script. When it is executed, it will create:
+# 1) a CESM 'CASE' ($caseroot) directory, where the model will be built,
+# 2) a run directory, where each forecast + assimilation cycle will take place,
+# 3) a bld directory for the executables.
+# 4) CESM's short term archiver (st_archive) will use a fourth directory for
+# storage of model output until it can be moved to long term storage (HPSS)
+#
+# This script also executes ${caseroot}/DART_config which augments the case
+# with all the pieces necessary to run DART in the first job.
+# Read the instructions in that file too.
+#
+# -- Confirm the variable values in $caseroot/env_{build,run,batch,...}.xml.
+#
+# -- (if running DART) Edit the DART input.nml that appears in the ${caseroot}
+# directory to replace default values with your preferred values.
+#
+# -- Submit the job using ${caseroot}/case.submit -M begin,end
+#
+# ---------------------
+# Important features
+# ---------------------
+#
+# If you want to change something in your case other than the runtime settings,
+# it is safest to delete everything and create the case from scratch.
+# For the brave, read
+#
+# https://ncar.github.io/CAM/doc/build/html/users_guide/index.html
+# --> https://ncar.github.io/CAM/doc/build/html/users_guide/building-and-running-cam.html
+# --> http://esmci.github.io/cime/users_guide/building-a-case.html
+#
+#*******************************************************************************
+
+# ==============================================================================
+# case options:
+#
+# case The value of "case" will be used many ways; directory and file
+# names both locally and on HPSS, and script names; so consider
+# its length and information content.
+# compset Selects the CESM model components, vertical resolution, and physics packages.
+# Must be a CAM-FV "F" compset, either supported, or use the
+# --run-unsupported option.
+# Don't expect all CESM-supported compsets to work with DART.
+# For example, an active land ice model requires the NOLEAP calendar
+# (as of 2018-6), while DART requires GREGORIAN. But there's no need
+# for active land ice in atmospheric assimilations.
+# A compset defined specifically for CAM assimilations is
+# FHIST_DARTC6 = HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV
+# For a list of the pre-defined component sets:
+# > $CIMEROOT/scripts/create_newcase -list
+# To create a variant compset, see the CESM documentation
+# https://ncar.github.io/CAM/doc/build/html/users_guide/atmospheric-configurations.html
+# and carefully incorporate any needed changes into this script.
+# resolution Defines the horizontal resolution and dynamical core;
+# see http://esmci.github.io/cime/users_guide/grids.html.
+# f19_f19 ... FV core at ~ 2 degree (19 means 1.9 degrees of latitude).
+# f09_f09 ... FV core at ~ 1 degree (the 2nd f09 means CLM uses a .9 degree latitude grid)
+# To use the high resolution SST data ocean, use resolution "f09_d025" or "f19_d025"
+# and the user_grid variable.
+# > set user_grid = "${user_grid} --gridfile /glade/work/raeder/Models/CAM_init/SST"
+# > set user_grid = "${user_grid}/config_grids+fv1+2deg_oi0.25_gland20.xml"
+# cesmtag The version of the CESM source code to use when building the code.
+# The assimilate.csh in this directory will handle only cesm2_0 and later.
+# num_instances The number of ensemble members.
+#
+# ==============================================================================
+
+setenv case Test0
+setenv compset HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+setenv user_grid ''
+# alias: f09_f09_mg17 (only for compsets that are not _POP and no CISM)
+setenv resolution f09_d025
+setenv cesmtag cesm2_1
+setenv num_instances 80
+
+# If cemstag >= cesm2_0_alpha10f and compset = FHIST_DARTC6 (or another non-supported):
+# and resolution is non-standard (e.g. d025)
+setenv compset_args "--compset $compset"
+setenv compset_args "${compset_args} --run-unsupported"
+
+# ==============================================================================
+# machines and directories:
+#
+# mach Computer name
+# cesmdata Location of some supporting CESM data files.
+# cesmroot Location of the CESM code base. This version of the script
+# only supports version cesm2_0 or later, which is available from
+# https://github.com/ESCOMP/cesm.
+# sourcemods DART no longer requires a SourceMods directory in order to work with CESM.
+# If you have modifications to CESM, they should be provided in a
+# CESM-structured SourceMods directory, which this script expects to be in
+# $user/$cesmtag/SourceMods.
+# caseroot The CESM $CASEROOT directory, where the CESM+DART configuration files
+# will be stored and the build commands will be executed.
+# This should probably not be in scratch.
+# This script will delete an existing caseroot with the same name,
+# so this script and other things you want to preserve should be kept elsewhere.
+# dartroot Location of the root of _your_ DART installation.
+# cime_output $cime_root/$CASEROOT is the directory where CESM's build and run directories will be created.
+# Large amount of space needed, generally on a scratch partition.
+# CESM will define the following variables:
+# RUNDIR: The CESM run directory. Needs large amounts of disk.
+# Default; $CIME_OUTPUT_ROOT/$CASE/run
+# EXEROOT: The CESM executable directory.
+# Default; $CIME_OUTPUT_ROOT/$CASE/bld
+# DOUT_S_ROOT: The CESM short-term archive directory.
+# LARGE amount of disk.
+# Files remain here until you move them or they are purged.
+# Default; $CIME_OUTPUT_ROOT/archive/$CASE.
+# DART's preference is to define the archive directory to be;
+# $CIME_OUTPUT_ROOT/$CASE/archive
+# This change of DOUT_S_ROOT may interfere with the ability to clone your case.
+# archdir The CESM short-term archive directory.
+# Files will remain here until you move them to permanent storage
+# (or are purged).
+# baseobsdir Part of the directory name containing the obs_seq.out files to be used by the
+# assimilation. Assimilate.csh looks for a directory with the year and month:
+# $baseobsdir/YYYYMM_6H_CESM.
+# Will be inserted into DART_config and assimilate.csh.
+# ==============================================================================
+
+setenv mach cheyenne
+setenv cesmdata /glade/p/cesm/cseg/inputdata
+setenv cesmroot /glade/work/${USER}/Models/${cesmtag}
+setenv sourcemods ~/${cesmtag}/SourceMods
+setenv caseroot /glade/work/${USER}/Exp/${case}
+setenv dartroot /glade/u/home/${USER}/DART/rma_recam
+
+setenv cime_output /glade/scratch/${USER}
+setenv archdir ${cime_output}/${case}/archive
+
+setenv baseobsdir /glade/p/cisl/dares/Observations/NCEP+ACARS+GPS
+
+# ==============================================================================
+# Initial conditions files:
+#
+# refcase The name of the existing reference case that this run will
+# start from.
+#
+# refyear The specific date/time-of-day in the reference case that this
+# refmon run will start from. (Also see 'runtime settings' below for
+# refday start_year, start_mon, start_day and start_tod.)
+# reftod
+# NOTE: all the ref* variables must be treated like strings and have
+# the appropriate number of preceeding zeros
+#
+# stagedir The directory location of the reference case files.
+# ==============================================================================
+
+setenv refcase CESM2_1_Rean_init_ens
+# setenv refcase Rean_2010.1-6_sst.25
+setenv refyear 2016
+setenv refmon 12
+# setenv refmon 07
+setenv refday 10
+setenv reftod 00000
+
+# useful combinations of time that we use below
+setenv refdate $refyear-$refmon-$refday
+setenv reftimestamp $refyear-$refmon-$refday-$reftod
+
+# setenv stagedir /glade/p/cisl/dares/CESM_initial_ensemble/rest/${reftimestamp}
+# Alternative reference case for different dates, cases, etc. may be kept in places like:
+# setenv stagedir /glade/scratch/${USER}/${refcase}/run
+# setenv stagedir /glade/scratch/${USER}/${refcase}/archive/rest/${reftimestamp}
+setenv stagedir /glade/work/${USER}/Models/CAM_init/FV1deg_cesm2_1/${reftimestamp}
+# or on the HPSS:
+# /CCSM/dart/FV0.9x1.25x30_cesm1_1_1/{Mon}1 for 1-degree FV ensembles
+
+# ==============================================================================
+# runtime settings: This script will find usable files for years 19mumble-2010.
+# Years after that (or before) may require searching $cesmdata for more
+# up-to-date files and adding them to the user_nl_cam_#### in the code below.
+#
+# start_year generally this is the same as the reference case date, but it can
+# start_month be different if you want to start this run as if it was a different time.
+# start_day
+# start_tod
+# stop_option Units for determining the forecast length between assimilations
+# stop_n Number of time units in each forecast
+# short_term_archiver Copies the files from each job step to a 'rest' directory.
+# ==============================================================================
+
+setenv start_year 2016
+setenv start_month 12
+setenv start_day 10
+setenv start_tod 00000
+setenv stop_option nhours
+setenv stop_n 6
+setenv short_term_archiver off
+
+# ==============================================================================
+# configure settings:
+
+# Configure needs to know the location of the CIME directory.
+# An environment variable is easier to specify than the command line argument.
+setenv CIMEROOT $cesmroot/cime
+
+# The tasks/node and threads/task we will use,
+# to be used by --pecount arg to create_namelist.
+# In cases where there are few observations but a large memory requirement,
+# it may be more efficient for DART to use fewer MPI tasks/node
+# than the number of available processors/node.
+# But that would restrict CAM to using fewer MPI tasks per node.
+# That can be compensated by telling CAM to use >1 (OpenMP) threads per node.
+# E.g. change from 36 tasks x 1 thread to 12 tasks x 3 threads.
+
+set use_tasks_per_node = 36
+set nthreads = 1
+
+# The default CAM sea surface temperature file is climatological,
+# which is less than ideal for atmospheric assimilations.
+# The supported alternative is time interpolation of a monthly SST+CICE data set.
+# Examples are provided here.
+# "2 degree":
+# setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2016_c170525.nc
+# setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv1.9x2.5_gx1v7.170518.nc
+# "1 degree":
+# setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2016_c170525.nc
+# setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc
+# Specify the beginning and ending years of the data set.
+# setenv sst_year_start 1850
+# setenv sst_year_end 2016
+
+# "1/4 degree":
+# A better alternative is daily, 1/4-degree SSTs from Reynolds,...,Tomas
+
+set user_grid = "${user_grid} --gridfile /glade/work/raeder/Models/CAM_init/SST"
+set user_grid = "${user_grid}/config_grids+fv1+2deg_oi0.25_gland20.xml"
+setenv sst_dataset \
+ "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20160101_cat_20161231_gregorian_c181119.nc"
+ # "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20100101_cat_20101231_filled_c130829.nc"
+ # "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20130101_cat_20130731_filled_c170223.nc"
+
+set list = `ncdump -h $sst_dataset | grep calendar`
+if ($list[3] !~ '"gregorian"') then
+ echo "ERROR: $sst_dataset"
+ echo " must have the calendar attribute attached to the time variable."
+ echo " Use: ncatted -a calendar,time,c,c,gregorian $sst_dataset"
+ exit 5
+endif
+setenv sst_grid /glade/work/raeder/Models/CAM_init/SST/domain.ocn.d025.120821.nc
+setenv sst_year_start $start_year
+setenv sst_year_end $start_year
+
+# ==============================================================================
+# job settings:
+#
+# PROJECT CESM2 preferred name for account used to charge core hours.
+# Using setenv makes it available to utils/python/CIME/case.py/get_project
+# queue can be changed during a series by changing the case.run
+# timewall can be changed during a series by changing the case.run
+# ==============================================================================
+
+setenv PROJECT P86850054
+setenv queue premium
+setenv timewall 1:00
+
+# ==============================================================================
+# standard commands:
+#
+# Make sure that this script is using standard system commands
+# instead of aliases defined by the user.
+# If the standard commands are not in the location listed below,
+# change the 'set' commands to use them.
+# The 'force' (-f) options listed are added to commands where they are used.
+# The verbose (-v) argument has been separated from these command definitions
+# because these commands may not accept it on some systems. On those systems
+# set VERBOSE = ''
+# ==============================================================================
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+set VERBOSE = '-v'
+set MOVE = '/usr/bin/mv'
+set COPY = '/usr/bin/cp --preserve=timestamps'
+set LINK = '/usr/bin/ln -s'
+set LIST = '/usr/bin/ls'
+set REMOVE = '/usr/bin/rm'
+
+# ==============================================================================
+# ==============================================================================
+# by setting the values above you should be able to execute this script and
+# have it run. however, for running a real experiment there are still many
+# settings below this point - e.g. component namelists, history file options,
+# the processor layout, xml file options, etc - that you will almost certainly
+# want to change before doing a real science run.
+# ==============================================================================
+# ==============================================================================
+
+if ($?LS_SUBCWD) then
+ cd $LS_SUBCWD
+else if ($?PBS_O_WORKDIR) then
+ cd $PBS_O_WORKDIR
+endif
+
+# Store the location of these setup scripts for use in DART_config.
+set DART_CESM_scripts = `pwd`
+
+# ==============================================================================
+# Make sure the CESM directories exist.
+# VAR is the shell variable name, DIR is the value
+# ==============================================================================
+
+foreach VAR ( cesmroot dartroot stagedir )
+ set DIR = `eval echo \${$VAR}`
+ if ( ! -d $DIR ) then
+ echo "ERROR: directory '$DIR' not found"
+ echo " In the setup script check the setting of: $VAR "
+ exit 10
+ endif
+end
+
+# ==============================================================================
+# Create the case - this (re)creates the caseroot directory.
+# ==============================================================================
+
+# Fatal idea to make caseroot the same dir as where this setup script is
+# since the build process removes all files in the caseroot dir before
+# populating it. Try to prevent shooting yourself in the foot.
+
+if ( $caseroot == `pwd` ) then
+ echo "ERROR: the setup script should not be located in the caseroot"
+ echo "directory, because all files in the caseroot dir will be removed"
+ echo "before creating the new case. move the script to a safer place."
+ exit 11
+endif
+
+# Also don't recreate this case if you've archived any CAM output
+# in the existing case's archive directory.
+set old_files = ()
+if (-d $archdir/esp/hist) set old_files = `ls $archdir/esp/hist`
+if ($#old_files == 0) then
+ echo "removing old directory ${caseroot}"
+ echo "removing old directory ${cime_output}/${case}/bld"
+ echo "removing old directory ${cime_output}/${case}/run"
+ ${REMOVE} -fr ${caseroot}
+ ${REMOVE} -fr ${cime_output}/${case}/bld
+ ${REMOVE} -fr ${cime_output}/${case}/run
+else
+ echo "There are DART output files in $archdir/esp/hist."
+ echo "Either rename the case you are building, or delete the files and rebuild this case"
+ exit 12
+endif
+
+# This will override the value that may be set in your ~/.cime/config.
+setenv CIME_MODEL cesm
+
+# Record which CIME is being used.
+cd ${CIMEROOT}
+echo "\n Using the starred branch, below, of $CIMEROOT "
+git branch | grep '*'
+echo " "
+cd -
+
+# Record which CAM is being used.
+cd ${CIMEROOT}/../components/cam
+echo "n Using CAM version"
+head -n 5 doc/ChangeLog | tail -n 3
+echo "svn status -u:"
+svn status -u
+echo " "
+cd -
+
+# The ensemble CAM forecast is much more efficient for typical ensemble sizes (>40)
+# when the multi-driver capability is used. It may be less efficient for sizes < 10.
+setenv num_drivers $num_instances
+set multi_driver = ' '
+if ($num_drivers > 1) set multi_driver = ' --multi-driver '
+
+${CIMEROOT}/scripts/create_newcase \
+ --case $caseroot \
+ --machine $mach \
+ --res $resolution \
+ --project $PROJECT \
+ --queue $queue \
+ --walltime $timewall \
+ --pecount ${use_tasks_per_node}x${nthreads} \
+ --ninst $num_instances \
+ $compset_args \
+ $multi_driver \
+ $user_grid
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be created."
+ exit 15
+endif
+
+# Preserve a copy of this script as it was run.
+# If submitted interactively or with 'qcmd', this is easy.
+# If submitted as a batch job, the jobname and this script name
+# must be identical.
+
+if ($?LSB_JOBNAME) then
+ setenv setup_file_name $LSB_JOBNAME
+else if ($?PBS_JOBNAME) then
+ if ($PBS_JOBNAME == run/.qcmd) then
+ setenv setup_file_name $0:t
+ else
+ setenv setup_file_name $PBS_JOBNAME
+ endif
+else
+ setenv setup_file_name $0:t
+endif
+${COPY} -f ${VERBOSE} $setup_file_name ${caseroot}/${setup_file_name}.original
+
+# ==============================================================================
+# Configure the case.
+# ==============================================================================
+
+cd ${caseroot}
+
+# Save a copy of the original configuration for debug purposes
+
+foreach FILE ( *xml )
+ if ( ! -e ${FILE}.original ) then
+ ${COPY} -f ${VERBOSE} ${FILE} ${FILE}.original
+ endif
+end
+
+# Get a bunch of environment variables.
+# If any of these are changed by xmlchange calls in this program,
+# then they must be explicitly changed with setenv calls too.
+# $COMPSET is the long name which CESM uses, and is derived from $compset.
+# $compset is set by the user and may be an alias/short name.
+
+setenv COMPSET `./xmlquery COMPSET --value`
+setenv COMP_OCN `./xmlquery COMP_OCN --value`
+setenv COMP_GLC `./xmlquery COMP_GLC --value`
+setenv COMP_ROF `./xmlquery COMP_ROF --value`
+setenv CIMEROOT `./xmlquery CIMEROOT --value`
+setenv EXEROOT `./xmlquery EXEROOT --value`
+setenv RUNDIR `./xmlquery RUNDIR --value`
+setenv CAM_CONFIG_OPTS `./xmlquery CAM_CONFIG_OPTS --value`
+
+set max_tasks_per_node = `./xmlquery MAX_TASKS_PER_NODE --value`
+set max_mpitasks_per_node = `./xmlquery MAX_MPITASKS_PER_NODE --value`
+
+echo "From create_newcase, settings related to TASKS = ..."
+./xmlquery --partial TASK
+
+
+# Make sure the case is configured with a data ocean.
+
+if ( ${COMP_OCN} != docn ) then
+ echo " "
+ echo "ERROR: This setup script is not appropriate for active ocean compsets."
+ echo "ERROR: Please use the models/CESM/shell_scripts examples for that case."
+ echo " "
+ exit 40
+endif
+
+# Extract pieces of the COMPSET for choosing correct setup parameters.
+# E.g. "AMIP_CAM5_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM1%NOEVOLVE_SWAV"
+set comp_list = `echo $COMPSET | sed -e "s/_/ /g"`
+# Debug
+echo "compset parts are $comp_list"
+
+# Land ice, aka glacier, aka glc.
+
+if (${COMP_GLC} == sglc) then
+ set CISM_RESTART = FALSE
+else
+ echo "ERROR: glacier compset is ${COMP_GLC}, which is not supported by this script."
+ echo "ERROR: The only supported glacier compset is 'SGLC'"
+ exit 45
+ # In the future, if CISM can use the GREGORIAN calandar, and evolving land ice is
+ # deemed to be useful for atmospheric assimilations, this may still be required
+ # to make CISM write out restart files 4x/day.
+ ./xmlchange GLC_NCPL=4
+endif
+
+# The river transport model ON is useful only when using an active ocean or
+# land surface diagnostics. If you turn it ON, you will have to stage initial files etc.
+# There are 3 choices:
+# > a stub version (best for CAM+DART),
+# > the older River Transport Model (RTM),
+# > the new Model for Scale Adaptive River Transport (MOSART).
+# They are separate CESM components, and are/need to be specified in the compset.
+# It may be that RTM or MOSART can be turned off via namelists.
+# Specify the river runoff model: 'RTM', 'MOSART', or anything else.
+
+if (${COMP_ROF} == 'rtm') then
+ ./xmlchange ROF_GRID='r05'
+else if (${COMP_ROF} == 'mosart') then
+ # There seems to be no MOSART_MODE, but there are some MOSART_ xml variables.
+ # Use defaults for now
+ ./xmlchange ROF_GRID='r05'
+else if (${COMP_ROF} == 'drof') then
+ ./xmlchange ROF_GRID='null'
+else if (${COMP_ROF} == 'srof') then
+ ./xmlchange ROF_GRID='null'
+else
+ echo "river_runoff is ${COMP_ROF}, which is not supported"
+ exit 50
+endif
+
+# Need to know if we are using WACCM (aka WCCM or WXIE) for several reasons.
+# CESM2; maybe not needed anymore?
+# Mostly file management issues.
+# WARNING: Check your $COMPSET to see whether the grep pattern below will detect your WACCM ! !
+
+setenv waccm false
+set atm = `echo $comp_list[2] | sed -e "s#%# #"`
+if ($#atm > 1) then
+ echo $atm[2] | grep WC
+ if ($status == 0) setenv waccm true
+endif
+
+# NOTE: If you require bit-for-bit agreement between different runs,
+# in particular, between pmo (single instance) and assimilations (NINST > 1),
+# or if you need to change the number of nodes/member due to changing memory needs,
+# then env_run.xml:BFBFLAG must be set to TRUE, so that the coupler will
+# generate bit-for-bit identical results, regardless of the number of tasks
+# given to it. The time penalty appears to be ~ 0.5% in the forecast.
+# Alternatively, you can set NTASKS_CPL = same_number in both experiments
+
+# Task layout:
+# Set the nodes_per_instance below to the smallest number that will
+# let CAM run without memory problems. If you get 'out of memory'
+# errors OR failures without any messages, try increasing the nodes_per_instance.
+# Cheyenne has 46 Gb/node of usable memory. A 1 degree CAM6 works well with
+# 3 nodes/instance. A 2 degree works with 2 nodes/instance.
+# By computing task counts like we do below, we guarantee each instance uses
+# a whole number of nodes which is the recommended configuration.
+
+# There's no speed up by running non-active (data and stub) components concurrently,
+# after ATM has run, so just run all components sequentially.
+# BUT, do arrange it so that each member(instance) spans complete nodes:
+# modulo(total pe count / number of instances, use_tasks_per_node) == 0.
+# It seems odd to give so many processors to non-active components,
+# but that works best with the multi-driver option.
+
+# Multi-driver runs need to be told the number of tasks PER INSTANCE,
+# which will be multiplied up to give the total number tasks needed by the job.
+# If you choose to build a single driver case, multiply ntasks_active by
+# the $num_instances. CESM will then divide the tasks among the instances.
+# For large ensembles, this will double your computational cost.
+
+# Task layout:
+# Set the nodes_per_instance below to match your case.
+# By computing task counts like we do below, we guarantee each instance uses
+# a whole number of nodes which is the recommended configuration.
+#
+# CIME interprets a negative task count as representing the number of nodes.
+# On Cheyenne (at least) using multiple threads is not recommended.
+
+@ nodes_per_instance = 3
+@ ntasks_active = -1 * $nodes_per_instance
+@ ntasks_data = -1
+
+./xmlchange ROOTPE_ATM=0,NTHRDS_ATM=$nthreads,NTASKS_ATM=$ntasks_active
+./xmlchange ROOTPE_LND=0,NTHRDS_LND=$nthreads,NTASKS_LND=$ntasks_active
+./xmlchange ROOTPE_ICE=0,NTHRDS_ICE=$nthreads,NTASKS_ICE=$ntasks_active
+./xmlchange ROOTPE_ROF=0,NTHRDS_ROF=$nthreads,NTASKS_ROF=$ntasks_active
+./xmlchange ROOTPE_OCN=0,NTHRDS_OCN=$nthreads,NTASKS_OCN=$ntasks_active
+./xmlchange ROOTPE_GLC=0,NTHRDS_GLC=$nthreads,NTASKS_GLC=$ntasks_active
+./xmlchange ROOTPE_WAV=0,NTHRDS_WAV=$nthreads,NTASKS_WAV=$ntasks_active
+./xmlchange ROOTPE_CPL=0,NTHRDS_CPL=$nthreads,NTASKS_CPL=$ntasks_active
+./xmlchange ROOTPE_ESP=0,NTHRDS_ESP=$nthreads,NTASKS_ESP=$ntasks_data
+
+# A hybrid run is initialized like a startup but it allows users to bring together
+# combinations of initial/restart files from a previous case (specified by $RUN_REFCASE)
+# at a user-chosen, model output date (specified by $RUN_REFDATE).
+# The starting date of a hybrid run (specified by $RUN_STARTDATE) can be different
+# from $RUN_REFDATE.
+# There is a bit more complexity; DART only uses CAM _initial_ files, not _restart_ files,
+# so CAM will read initial files - even when CONTINUE_RUN = TRUE - # for cycles 2,... .
+# For more description of hybrid mode, see:
+# http://esmci.github.io/cime/users_guide/running-a-case.html?highlight=hybrid
+
+echo "After xmlchanges for ROOTPEs ..."
+
+./xmlquery --partial TASK
+./xmlquery --partial CIME_OUT
+./xmlquery --partial RUNDIR
+./xmlquery --partial EXEROOT
+./xmlquery --partial DOUT
+
+./xmlchange RUN_TYPE=hybrid
+./xmlchange RUN_STARTDATE=${start_year}-${start_month}-${start_day}
+./xmlchange START_TOD=$start_tod
+./xmlchange RUN_REFCASE=$refcase
+./xmlchange RUN_REFDATE=$refdate
+./xmlchange RUN_REFTOD=$reftod
+./xmlchange GET_REFCASE=FALSE
+
+./xmlchange CIME_OUTPUT_ROOT=${cime_output}
+
+./xmlchange SSTICE_DATA_FILENAME=$sst_dataset
+./xmlchange SSTICE_GRID_FILENAME=$sst_grid
+./xmlchange SSTICE_YEAR_ALIGN=$sst_year_start
+./xmlchange SSTICE_YEAR_START=$sst_year_start
+./xmlchange SSTICE_YEAR_END=$sst_year_end
+
+# Do not change the CALENDAR or the value of CONTINUE_RUN in this script.
+# Even if it's a branch from another run, where all restarts, etc. are available,
+# it still needs to change case/file names for this new case.
+
+./xmlchange CALENDAR=GREGORIAN
+./xmlchange CONTINUE_RUN=FALSE
+
+./xmlchange STOP_OPTION=$stop_option
+./xmlchange STOP_N=$stop_n
+
+# How many jobs (not cycles per job) to run after the first,
+# each of which will do DATA_ASSIMILATION_CYCLES cycles.
+# Set to 0 for the setup of the case, and the first cycle because
+# env_run.xml and input.nml will/may need to be changed between cycle 1 and 2
+# (and you really should confirm that the assimilation worked).
+
+./xmlchange RESUBMIT=0
+
+./xmlchange PIO_TYPENAME=pnetcdf
+
+# COUPLING discussion. F compsets are 'tight' coupling.
+# Only change the ATM_NCPL ... everything is based on this one value,
+# including CAM physics and dynamics timesteps.
+# Default values for coupling are preserved in env_run.xml.original
+
+./xmlchange NCPL_BASE_PERIOD=day
+./xmlchange ATM_NCPL=48
+
+# Sometimes we need to remove some bit of physics from a compset.
+# One example was that the CLM irrigation setting needed to be removed
+# from builds which are not CAM4. This was fixed in later CESMs,
+# but here's an example of how to do it.
+# echo $CAM_CONFIG_OPTS | grep 'cam4'
+# if ($status != 0) then
+# setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+# set clm_opts = `echo $CLM_BLDNML_OPTS | sed -e "s#-irrig=.true.##"`
+# ./xmlchange CLM_BLDNML_OPTS="$clm_opts"
+# # DEBUG/confirm
+# setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+# echo "CLM_BLDNML_OPTS has been changed to $CLM_BLDNML_OPTS"
+# endif
+
+# Or, if you know the description of the physics you need, just set it (then test it!)
+# setenv CAM_CONFIG_OPTS "-user_knows_better"
+# ./xmlchange CAM_CONFIG_OPTS=$CAM_CONFIG_OPTS
+
+if ($short_term_archiver == 'off') then
+ ./xmlchange DOUT_S=FALSE
+else
+ ./xmlchange DOUT_S=TRUE
+endif
+./xmlchange DOUT_S_ROOT=${archdir}
+
+# DEBUG = TRUE implies turning on run and compile time debugging.
+# INFO_DBUG level of debug output, 0=minimum, 1=normal, 2=more, 3=too much.
+./xmlchange DEBUG=FALSE
+./xmlchange INFO_DBUG=0
+
+# ==============================================================================
+# Update source files.
+# DART does not require any modifications to the model source.
+# ==============================================================================
+
+# Import your SourceMods, if you have any. DART doesn't have any of its own.
+if (-d ${sourcemods} ) then
+ echo ' '
+ ${COPY} -r ${VERBOSE} ${sourcemods}/* ${caseroot}/SourceMods/ || exit 62
+ echo ' '
+ echo ' '
+else
+ echo "No SourceMods for this case."
+endif
+
+# components/mosart/cime_config/buildnml:line 108:
+# $RUNDIR/${RUN_REFCASE}.{clm2,mosart}${inst_string}.r.${RUN_REFDATE}-${RUN_REFTOD}.nc
+# don't exist. That's because case.setup creates $RUNDIR and then calls the buildnml routines.
+# stage_cesm_files needs $RUNDIR to exist before it can make files there. Those files are
+# the ones buildnml checks. It's not fatal, just annoying warnings "WARNING:: mosart.buildnml . . .".
+# "Fix" by setting RUN_REFDIR to $stagedir.
+
+./xmlchange RUN_REFDIR=$stagedir
+
+# ==============================================================================
+# Set up the case.
+# This creates the EXEROOT and RUNDIR directories.
+# ==============================================================================
+
+echo 'Setting up the case ...'
+echo 'Ignore "WARNING:: mosart.buildnml . . .". Those files will be provided later'
+
+echo 'Before case.setup, modules are'
+source /etc/profile.d/modules.csh
+module list
+
+./case.setup
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be set up."
+ exit 70
+endif
+
+# ==============================================================================
+# Set up and run the DART_config script, which adapts the CAM case to do assimilation.
+# ==============================================================================
+
+# Define how often sets of restart files will be archived,
+# in order to conserve disk space during a multi-cycle job.
+setenv save_every_Mth_day_restart 3
+
+# Fill the DART_config script with information it needs and copy it to caseroot.
+# DART_config can be run at some later date if desired, but it must be run
+# from a caseroot directory.
+if ( -e ${DART_CESM_scripts}/DART_config.template ) then
+ sed -e "s#your_dart_path#${dartroot}#" \
+ -e "s#your_setup_script_dir#$DART_CESM_scripts:t#" \
+ -e "s#your_observation_path#${baseobsdir}#" \
+ -e "s#days_between_archiving_restarts#${save_every_Mth_day_restart}#" \
+ < ${DART_CESM_scripts}/DART_config.template \
+ >! DART_config || exit 20
+else
+ echo "ERROR: the script to configure for data assimilation is not available."
+ echo " DART_config.template MUST be in $DART_CESM_scripts "
+ exit 22
+endif
+chmod 755 DART_config
+
+./DART_config || exit 80
+
+# ==============================================================================
+# Edit scripts to reflect queue and wallclock
+# ==============================================================================
+
+# The new case.st_archive job script calls st_archive. It runs after the case.run job.
+# It submits the next case.run job, if RESUBMIT > 0.
+# Fix some pieces.
+# /X/ means search for lines with X in them.
+# 'c' means replace the line with the following.
+# 'a' means append after the current line.
+# In addition, env_batch.xml has a section we want to change, which xmlchange can't do.
+# Make st_archive run on 1 processor ( 'select' for pbs, 'ptile' for lsf).
+
+if ($?LSB_JOBNAME) then
+ sed -e "/BSUB[ ]*-o/c\#BSUB -o cesm_st_arch.stdout.%J" \
+ -e "/BSUB[ ]*-e/c\#BSUB -e cesm_st_arch.stderr.%J" \
+ -e "/BSUB[ ]*-J/c\#BSUB -J ${case}.st_arch" \
+ -e '/ptile/c/#BSUB -R "span[ptile=1]"' \
+ case.st_archive >! temp.$$ || exit 55
+ ${MOVE} temp.$$ case.st_archive
+ ./xmlchange --subgroup case.st_archive --id JOB_QUEUE --val share
+
+else if ($?PBS_JOBNAME) then
+ # It would be nice to put the $PBS_JOBID value into the job name and st err/out file names,
+ # but "environment variables are not resolved when they're in the #PBS directives",
+ # despite their use in the default job and st.err/out file names.
+ sed -e "/\-l select/c\#PBS -l select=1:ncpus=1:mpiprocs=1:ompthreads=1" \
+ -e "/\-N /c\#PBS -N ${case}.st_arch" \
+ -e "/\-N /a\#PBS -o ./${case}.st_arch.stdouterr" \
+ case.st_archive >! temp.$$ || exit 55
+ ${MOVE} temp.$$ case.st_archive
+ ./xmlchange --subgroup case.st_archive --id JOB_QUEUE --val share
+
+endif
+chmod 755 case.st_archive
+
+./xmlchange --subgroup case.st_archive --id JOB_WALLCLOCK_TIME --val 1:00
+
+# ==============================================================================
+# Modify namelist templates for each instance.
+#
+# In a hybrid run with CONTINUE_RUN = FALSE (i.e. just starting up):
+# CAM has been forced to read initial files - specified by namelist var:ncdata.
+# CICE reads from namelist variable 'ice_ic'.
+# CLM builds its own 'finidat' value from the REFCASE variables,
+# or the output from the interpolation is assigned to finidat in this namelist.
+#
+# When CONTINUE_RUN = TRUE, CICE and CLM get restart file names from pointer files.
+#
+# All of these must later on be staged with these same filenames.
+# ==============================================================================
+
+# Decide whether interpolation of the CLM restart file will be done.
+# If so, each CLM namelist needs it's own finidat_interp_dest.
+set do_clm_interp = "true"
+
+@ inst = 1
+while ($inst <= $num_instances)
+
+ # following the CESM strategy for 'inst_string'
+ set inst_string = `printf _%04d $inst`
+
+ # ===========================================================================
+ set fname = "user_nl_cam${inst_string}"
+ # ===========================================================================
+ # ATM Namelist
+
+ # DART/CAM requires surface geopotential (PHIS) for calculation of
+ # column pressures. It's convenient to write it to the .h0. every
+ # assimilation time. If you want to write it to a different .h?. file, you MUST
+ # modify the assimilate.csh script in several places. You will need to set
+ # 'empty_htapes = .false.' and change 'nhtfrq' and 'mfilt' to get a CAM
+ # default-looking .h0. file.
+ # If you want other fields written to history files, use h1,...,
+ # which are not purged by assimilate.csh.
+ #
+ # inithist 'ENDOFRUN' ensures that CAM writes the required initial file
+ # every time it stops.
+ # mfilt # of times/history file. Default values are 1,30,30,.....
+
+ echo " inithist = 'ENDOFRUN'" >> ${fname}
+ echo " ncdata = 'cam_initial${inst_string}.nc'" >> ${fname}
+ echo " empty_htapes = .true. " >> ${fname}
+ echo " fincl1 = 'PHIS:I' " >> ${fname}
+ echo " nhtfrq = -$stop_n " >> ${fname}
+ # echo " mfilt = 1 " >> ${fname}
+
+ echo $CAM_CONFIG_OPTS | grep 'cam4'
+ if ($status == 0) echo " fv_div24del2_flag = 4 " >> ${fname}
+
+ # Settings that differ between regular CAM and the WACCM version:
+
+
+ # CAM forcing files.
+ # Some of the files specified here are because the default files only
+ # contain data through 2005 or 2010 and we are interested in time frames after that.
+
+ # set chem_datapath = "${cesmdata}/atm/cam/chem/trop_mozart_aero"
+
+ if ($start_year > 2014) then
+
+ set cesm_data_dir = "/glade/p/cesmdata/cseg/inputdata/atm"
+ set cesm_chem_dir = "/gpfs/fs1/p/acom/acom-climate/cmip6inputs/emissions_ssp119"
+ set chem_root = "${cesm_chem_dir}/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp119-1-1"
+ set chem_dates = "175001-210012_0.9x1.25_c20181024"
+
+# Default: H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'," >> ${fname}
+# Try a file with enough years (but questionable content from
+# /glade/scratch/mmills/CH4/CCMI_1955_2099_RCP6_ave_CH4_CHML.nc):
+ echo " ext_frc_specifier = " >> ${fname}
+ echo " 'H2O -> ${cesm_data_dir}/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_1850-2100_CCMI_RCP8_5_c160219.nc'" >> ${fname}
+ echo " 'num_a1 -> ${chem_root}_num_so4_a1_anthro-ene_vertical_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'so4_a1 -> ${chem_root}_so4_a1_anthro-ene_vertical_mol_${chem_dates}.nc'" >> ${fname}
+
+ echo " srf_emis_specifier =" >> ${fname}
+ echo " 'bc_a4 -> ${chem_root}_bc_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'bc_a4 -> ${chem_root}_bc_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'DMS -> ${chem_root}_DMS_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'DMS -> ${cesm_chem_dir}/emissions-cmip6-SSP_DMS_other_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a1 -> ${chem_root}_num_so4_a1_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a1 -> ${chem_root}_num_so4_a1_anthro-ag-ship_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a2 -> ${chem_root}_num_so4_a2_anthro-res_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_bc_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_bc_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_pom_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_pom_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'pom_a4 -> ${chem_root}_pom_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'pom_a4 -> ${chem_root}_pom_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SO2 -> ${chem_root}_SO2_anthro-ag-ship-res_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SO2 -> ${chem_root}_SO2_anthro-ene_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SO2 -> ${chem_root}_SO2_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'so4_a1 -> ${chem_root}_so4_a1_anthro-ag-ship_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'so4_a2 -> ${chem_root}_so4_a2_anthro-res_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SOAG -> ${chem_root}_SOAGx1.5_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SOAG -> ${chem_root}_SOAGx1.5_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SOAG -> ${chem_root}_SOAGx1.5_biogenic_surface_mol_${chem_dates}.nc'" >> ${fname}
+# echo " 'SOAG -> ${chem_root}_SOAGx1.5_biogenic_surface_mol_201501-210012_0.9x1.25_c20181024.nc'" >> ${fname}
+ echo " 'so4_a1 -> ${chem_root}_so4_a1_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+
+# Queried Mike Mills 2018-12-3
+# He says; not available, and won't be
+# Try using the default file, but with cyclical trace gases, year 2014 (the last full).
+ echo " prescribed_ozone_type = 'CYCLICAL'" >> ${fname}
+ echo " prescribed_ozone_cycle_yr = 2014" >> ${fname}
+ echo " prescribed_strataero_type = 'CYCLICAL'" >> ${fname}
+ echo " prescribed_strataero_cycle_yr = 2014" >> ${fname}
+
+# Defaults:
+# tracer_cnst_datapath = '${cesm_data_dir}/cam/tracer_cnst'"
+# tracer_cnst_file = 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'
+# 2014 is not available in this default halons file.
+# And the 2015 is an average of 2012-2014 output.
+# This file that has yearly through 2014, not averaged.
+ echo " tracer_cnst_file = 'tracer_cnst_halons_WACCM6_3Dmonthly_L70_1975-2014_c180216.nc'" >> ${fname}
+ echo " tracer_cnst_type = 'CYCLICAL'" >> ${fname}
+ echo " tracer_cnst_cycle_yr = 2014" >> ${fname}
+
+# Mike Mills:
+# the way that CAM deals with these greenhouse gases:
+# the code actually calculates a global average value
+# before passing this on to the radiation code.
+# So it was considered undesirable to use the WACCM file,
+# which would create a strange globally averaged seasonal cycle in CO2,
+# one dominated by the cycle in the Northern Hemisphere.
+# Because this file only has one value each year, CYCLICAL is not an option when using it.
+# To maintain 2014 values, you should use FIXED.
+# The default file has yearly data, which CAM can't handle with CYCLICAL.
+# (see DiscussCESM "Cycling dates in chem_surfvals_nl fails when data is yearly")
+# This fails because a year can't be specified with 'FIXED' (!)
+# I've asked Mike about this.
+# echo " flbc_file = '${cesm_data_dir}/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc' " >> ${fname}
+# echo " flbc_type = 'FIXED'" >> ${fname}
+# This file is monthly, but see Mills' comments, above.
+ echo " flbc_file = '${cesm_data_dir}/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc' " >> ${fname}
+ echo " flbc_type = 'CYCLICAL'" >> ${fname}
+ echo " flbc_cycle_yr = 2014" >> ${fname}
+
+ else
+ if ($inst == 1) then
+ echo 'WARNING; using default ozone and tracer_cnst forcing files'
+ echo 'WARNING; using default srf_emis_* and ext_frc_*'
+ echo "WARNING; using default bndtvghg"
+ echo "WARNING; using default volcaero"
+ endif
+ endif
+
+ # if ($start_year > 2008) then
+ # The default as of April 2015 is
+ # /glade/p/cesmdata/cseg/inputdata/atm/cam/solar/SOLAR_SPECTRAL_Lean_1610-2008_annual_c090324.nc
+ # For later dates there are files which repeat the solar cycles from 1960-2008
+ # in order to create a time series out to 2140:
+ # .../spectral_irradiance_Lean_1610-2140_ann_c100408.nc
+ # This does not look like an exact extension of the default,
+ # but does look like the previous default. So try it.
+
+ # echo " solar_data_file = '${cesmdata}/atm/cam/solar/spectral_irradiance_Lean_1610-2140_ann_c100408.nc'" >> ${fname}
+ # endif
+
+ # ===========================================================================
+ set fname = "user_nl_clm${inst_string}"
+ # ===========================================================================
+ # LAND Namelist
+ # With a RUN_TYPE=hybrid the finidat is automatically specified
+ # using the REFCASE, REFDATE, and REFTOD information. i.e.
+ # finidat = ${stagedir}/${refcase}.clm2${inst_string}.r.${reftimestamp}.nc
+ #
+ # Making a (compact) .h0. file is a good idea, since the clm restart files
+ # do not have all the metadata required to reconstruct a gridded field.
+ # 'TSA' is 2m surface air temperature. This also prevents
+ # having truly empty history files, resulting in ntapes = 0,
+ # which prevents the hybrid-mode model from restarting.
+ # CESM2_0 and, or, CLM5: is that still true?
+ #
+ echo "hist_empty_htapes = .true." >> ${fname}
+ echo "hist_fincl1 = 'TSA'" >> ${fname}
+ echo "hist_nhtfrq = -$stop_n" >> ${fname}
+ echo "hist_mfilt = 1" >> ${fname}
+ echo "hist_avgflag_pertape = 'I'" >> ${fname}
+
+ # This was needed to allow the interpolation of the default CLM restart file.
+ # It is needed in runs that start from a somewhat spun up ensemble.
+
+ if ($do_clm_interp == "true") then
+ echo "use_init_interp = .true. " >> ${fname}
+ echo "init_interp_fill_missing_with_natveg = .true." >> ${fname}
+ endif
+
+ # but we don't particularly want or need methane
+ echo "use_lch4 = .false." >> ${fname}
+
+# echo "check_finidat_year_consistency = .false." >> ${fname}
+# echo "urban_hac = 'OFF'" >> ${fname}
+# echo "building_temp_method = 0 " >> ${fname}
+
+ # ===========================================================================
+ set fname = "user_nl_cice${inst_string}"
+ # ===========================================================================
+ # CICE Namelist
+
+ echo $CAM_CONFIG_OPTS | grep 'cam4'
+ if ($status == 0) then
+ # CAM4:
+ echo "ice_ic = 'default'" >> ${fname}
+ else
+ # CAM5, 6, ...:
+ echo "ice_ic = '${refcase}.cice${inst_string}.r.${reftimestamp}.nc'" >> ${fname}
+ endif
+
+ @ inst ++
+
+end
+
+# ===========================================================================
+# set fname = "user_nl_cpl"
+# ===========================================================================
+# DRV or CPL Namelist
+# For some reason, a single user_nl_cpl works even when --multi-driver is used.
+
+./preview_namelists || exit 75
+
+# ==============================================================================
+# Stage the restarts now that the run directory exists.
+# Create a script to do this since it may be needed to recover or restart.
+# Create the script and then run it here.
+# ==============================================================================
+
+set init_time = ${reftimestamp}
+
+cat << EndOfText >! stage_cesm_files
+#!/bin/csh -f
+# This script can be used to help restart an experiment from any previous step.
+# The appropriate files are copied to the RUN directory.
+#
+# Before running this script:
+# 1) be sure CONTINUE_RUN is set correctly in the env_run.xml file in
+# your caseroot directory.
+# CONTINUE_RUN=FALSE => you are starting over at the initial time.
+# CONTINUE_RUN=TRUE => you are starting from a previous step but not
+# the very first one.
+# 2) be sure 'restart_time' is set to the day and time from which you want to
+# restart, if not the initial time.
+
+set restart_time = $init_time
+
+# ---------------------------------------------------------
+# Get the settings for this case from the CESM environment
+# ---------------------------------------------------------
+cd ${caseroot}
+setenv RUNDIR \`./xmlquery RUNDIR --value\`
+setenv CONTINUE_RUN \`./xmlquery CONTINUE_RUN --value\`
+
+ls \$RUNDIR/*.i.\${restart_time}.nc
+if (\$status == 0) then
+ # The restart set exists in the RUNDIR, regardless of the short term archiver.
+ setenv DOUT_S FALSE
+else
+ set hide_loc = \`ls \$RUNDIR:h/Hide*/*_0001.i.\${restart_time}.nc\`
+ if (\$status == 0) then
+ # The restart set exists in a Hide directory, regardless of the short term archiver.
+ setenv DOUT_S FALSE
+ mv \$hide_loc:h/* \${RUNDIR}
+ else
+ setenv DOUT_S \`./xmlquery DOUT_S --value\`
+ setenv DOUT_S_ROOT \`./xmlquery DOUT_S_ROOT --value\`
+ endif
+endif
+
+# ---------------------------------------------------------
+
+cd \${RUNDIR}
+
+echo 'Copying the required CESM files to the run directory to rerun a previous step. '
+echo 'CONTINUE_RUN from env_run.xml is' \${CONTINUE_RUN}
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+ echo 'so files for some later step than the initial one will be restaged.'
+ echo "Date to reset files to is: \${restart_time}"
+else
+ echo 'so files for the initial step of this experiment will be restaged.'
+ echo "Date to reset files to is: ${init_time}"
+endif
+echo ''
+
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+
+ #----------------------------------------------------------------------
+ # This block copies over a set of restart files from any previous step of
+ # the experiment that is NOT the initial step.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+ echo "Staging restart files for run date/time: " \${restart_time}
+
+ if ( \${DOUT_S} =~ TRUE ) then
+
+ # The restarts should be in the short term archive 'rest' restart directories.
+
+ set RESTARTDIR = \${DOUT_S_ROOT}/rest/\${restart_time}
+
+ if ( ! -d \${RESTARTDIR} ) then
+
+ echo "restart file directory not found: "
+ echo " \${RESTARTDIR}"
+ exit 100
+
+ endif
+
+ ${COPY} \${RESTARTDIR}/* . || exit 101
+
+ else
+
+ # The short term archiver is off, which leaves all the restart files
+ # in the run directory. The rpointer files must still be updated to
+ # point to the files with the right day/time.
+
+ @ inst=1
+ while (\$inst <= $num_instances)
+
+ set inst_string = \`printf _%04d \$inst\`
+
+ echo "${case}.clm2\${inst_string}.r.\${restart_time}.nc" >! rpointer.lnd\${inst_string}
+ echo "${case}.cice\${inst_string}.r.\${restart_time}.nc" >! rpointer.ice\${inst_string}
+ echo "${case}.cam\${inst_string}.r.\${restart_time}.nc" >! rpointer.atm\${inst_string}
+ if (${COMP_ROF} == 'rtm') then
+ echo "${case}.rtm\${inst_string}.r.\${restart_time}.nc" >! rpointer.rof\${inst_string}
+ else if (${COMP_ROF} == 'mosart') then
+ echo "${case}.mosart\${inst_string}.r.\${restart_time}.nc" >! rpointer.rof\${inst_string}
+ endif
+ if ($num_drivers > 1) then
+ echo "${case}.cpl\${inst_string}.r.\${restart_time}.nc" >! rpointer.drv\${inst_string}
+ echo "${case}.docn\${inst_string}.r.\${restart_time}.nc" >! rpointer.ocn\${inst_string}
+ echo "${case}.docn\${inst_string}.rs1.\${restart_time}.bin" >> rpointer.ocn\${inst_string}
+ endif
+
+ @ inst ++
+ end
+
+ # There are no instance numbers in these filenames.
+ if ($num_drivers == 1) then
+ echo "${case}.cpl.r.\${restart_time}.nc" >! rpointer.drv
+ echo "${case}.docn.r.\${restart_time}.nc" >! rpointer.ocn
+ echo "${case}.docn.rs1.\${restart_time}.bin" >> rpointer.ocn
+ endif
+
+ endif
+
+ # Relink the CAM initial files back to the hardwired names set in the namelist
+
+ @ inst=1
+ while (\$inst <= $num_instances)
+ set inst_string = \`printf _%04d \$inst\`
+ ${LINK} -f ${case}.cam\${inst_string}.i.\${restart_time}.nc cam_initial\${inst_string}.nc
+ @ inst ++
+ end
+
+ echo "All files reset to rerun experiment step using (ref)time " \$restart_time
+
+else # CONTINUE_RUN == FALSE
+
+ #----------------------------------------------------------------------
+ # This block links the right files to rerun the initial (very first)
+ # step of an experiment. The names and locations are set during the
+ # building of the case; to change them rebuild the case.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+ echo ' '
+
+ @ inst=1
+ while (\$inst <= $num_instances)
+
+ set inst_string = \`printf _%04d \$inst\`
+
+ echo "Staging initial files for instance \$inst of $num_instances"
+
+ ${LINK} -f ${stagedir}/${refcase}.clm2\${inst_string}.r.${init_time}.nc .
+ ${LINK} -f ${stagedir}/${refcase}.cice\${inst_string}.r.${init_time}.nc .
+ ${LINK} -f ${stagedir}/${refcase}.cam\${inst_string}.i.${init_time}.nc cam_initial\${inst_string}.nc
+ if (${COMP_ROF} == 'rtm') then
+ ${LINK} -f ${stagedir}/${refcase}.rtm\${inst_string}.r.${init_time}.nc .
+ else if (${COMP_ROF} == 'mosart') then
+ ${LINK} -f ${stagedir}/${refcase}.mosart\${inst_string}.r.${init_time}.nc .
+ endif
+
+ @ inst ++
+ end
+
+ echo "All files set to run the FIRST experiment step using (ref)time" $init_time
+
+endif
+exit 0
+
+EndOfText
+chmod 0755 stage_cesm_files
+
+./stage_cesm_files
+
+# ==============================================================================
+# Build the case
+# ==============================================================================
+
+echo ''
+echo 'Building the case'
+echo " --skip-provenance-check is used. See note in $0"
+echo ''
+
+# --skip-provenance-check because of svn or git timing out during build
+# of CLM. It wanted authentication(?) to access a private repository.
+# A better solution would be to find out why(whether) it thinks CLM is
+# a private repository.
+
+./case.build --skip-provenance-check
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be built."
+ exit 120
+endif
+
+# ==============================================================================
+# Check some XML settings which should have been set by this script.
+# ==============================================================================
+
+echo ' '
+echo 'CESM settings which are of special interest:'
+echo ' '
+foreach var ( CONTINUE_RUN RESUBMIT RUN_REF RUN_STARTDATE STOP_OPTION \
+ STOP_N SSTICE DOUT RUNDIR MPI_RUN_COMMAND AVGHIST ASSIM)
+ ./xmlquery --partial $var | grep -v 'Results in' | grep -v '^$'
+end
+echo ' '
+
+# ==============================================================================
+# What to do next
+# ==============================================================================
+
+cat << EndOfText >! CESM_instructions.txt
+
+-------------------------------------------------------------------------
+Time to check the case.
+
+1) Scan the output from this setup script for errors and warnings:
+ ERROR, WARNING, 'No such file' (except for MOSART)
+ 'File status unknown' can be ignored.
+ 'ERROR: cice.buildlib failed' can be ignored, unless you've changed the CICE code
+
+2) cd ${RUNDIR}
+ Check the files that were staged; follow the links to confirm the data sources.
+ Check the compatibility between them and the namelists and pointer files.
+
+3) cd ${caseroot}
+ Verify the CESM XML settings, especially in env_batch.xml and env_run.xml.
+ ./xmlquery --partial
+ is particularly useful.
+
+4) The default initial configuration is to assimilate.
+ Verify the ${caseroot}/input.nml contents.
+ Assimilation can be turned off by
+ ./xmlchange DATA_ASSIMILATION_SCRIPT=${caseroot}/no_assimilate.csh
+ DART can be turned off by
+ ./xmlchange DATA_ASSIMILATION=FALSE
+
+5) Submit the job (and get mail when it starts and stops):
+ ./case.submit -M begin,end
+
+6) After the job has run, check to make sure it worked.
+
+7) If the first cycle generated an ensemble by perturbing a single state,
+ change input.nml as described in the instructions in it,
+ to make cycles 2,...,N use the latest ensemble, unperturbed.
+
+8) To extend the run in $stop_n '$stop_option' steps, use xmlchange to
+ change the CESM runtime variables:
+
+ ./xmlchange DATA_ASSIMILATION_CYCLES= the value you want.
+ ./xmlchange CONTINUE_RUN=TRUE
+ ./xmlchange RESUBMIT= the number of JOBS to run (each JOB performs DATA_ASSIMILATION_CYCLES cycles)
+
+EndOfText
+
+cat CESM_instructions.txt
+cat DART_instructions.txt
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/models/cam-fv/shell_scripts/cesm2_1/setup_advanced_Rean_2017 b/models/cam-fv/shell_scripts/cesm2_1/setup_advanced_Rean_2017
new file mode 100755
index 0000000000..0335971d24
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/setup_advanced_Rean_2017
@@ -0,0 +1,1519 @@
+#!/bin/csh -f
+#
+# 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
+#
+# DART $Id$
+#
+# This script can be run interactively, but on some systems (e.g. cheyenne)
+# it takes longer than is allowed for an interactive job.
+# In that case, it can be run as a batch job using the directives below,
+# or using "qcmd -q share -l select=1 -- ".
+# The job name should be the name of this script(file),
+# or this file may not be archived in $caseroot causing DART_config to fail.
+#--------------------------------------------
+#BSUB -J setup_advanced_test
+#BSUB -n 1
+#BSUB -R "span[ptile=1]"
+#BSUB -q shared_node_queue_for_this_setup_script
+#BSUB -P your_account_there
+#BSUB -W 2:00
+#BSUB -u you@email.org
+#BSUB -N
+#BSUB -a poe
+#BSUB -o Test0.bld1
+#BSUB -e Test0.bld1
+#--------------------------------------------
+#PBS -N setup_advanced_test
+#PBS -A P86850054
+#PBS -q share
+#
+# Resources to specify:
+# select=#nodes
+# ncpus=#CPUs/node
+# mpiprocs=#MPI_tasks/node
+#PBS -l select=1:ncpus=4:mpiprocs=4
+#PBS -l walltime=01:00:00
+#PBS -m ae
+#PBS -M raeder@ucar.edu
+# Send standard output and error to this file.
+# It's helpful to use the $casename here.
+# #PBS -o Test_merged1.bld1
+#PBS -o f.e21.FHIST_BGC.f09_025.CAM6assim.001.bld1
+#PBS -j oe
+#--------------------------------------------
+
+#
+# CESM2_1_80mem
+# Continue from CAM6_80mem,
+# x Make sure that inflation files are transferred.
+# x Slightly higher obs, to level 5,
+# x No ramping, which appears to be redundant with choice of obs rejection height.
+#
+# CESM2_1_Dec_spinup
+# Merged Tim's setup_advanced as of 2019-1-14
+# cesm2_1_relsd_m5.6:
+# the released CESM and the modified CIME branch which KDR developed for the reanalysis.
+# x Confirm the CIME branch is right; cime_reanalysis_2019
+# Confirm
+# x gw fix from Vitt,
+# x cam/cime_config/buildnml; the NTASKS -> npr_yz fix.
+# x clm buildnml(?) addition of d.25x.25 grid option
+# components/clm/bld/namelist_files/namelist_definition_clm4_5.xml
+# x New SourceMods for that cesm
+# remove debugging versions from SourceMods
+# x src.drv from cesm2_1_maint-5.6 are in the cime, not needed in SourceMods.
+# x src.lnd mods are needed; negative long wave fluxes and d.25x.25 grid.
+# x Make sure compression is implemented.
+# assimilate.csh; Lot's of small changes
+# x What's up with prep for fill_inflation_restart?
+# x Tim's renames files created by fill_inflation_restart, where my fill_ names "right".
+# x block numbers OK?
+# x remove "just checking", other TJH
+# ? He took out module juggling around the ncgen; OK?
+# 2016-12-10-00000;
+# x CAM; default initial file
+# x CLM; spun up ensemble from Tim.
+# x CICE; single member from a 1 day forecast.
+# Get OK from Moha, Nancy, about input.nml
+# x perts to make initial ensemble
+# x distributed_state is .true.
+# x infl_flavor = 5 and min = 0.
+# x output_obs_members = 0
+# x binary_obs_sequence = .true.
+# x no ramping
+# x use obs up to ~ level 5(?), or what Jeff recommended.
+# Reset filter to optimized, no debugging output. Nancy;
+# x recam, intel compiler, -O2 optimization turned on, -assume buffered_io flag.
+# x CLM interpolation.
+# H6;
+# x binary obs_seq file,
+# x premium queue
+# Check all cpl hist files; time slots, field values, file names, ...?
+# check compression;
+# cpl hist files every cycle
+# restart sets whenever they're saved.
+# check saving of restarts;
+# every 3nd day during run,
+# purge some after job.
+# H12;
+# > Rebuild CAM without "seq_hist_writeaux stop_" messages.
+# cycles?
+# queue?
+# st_archive
+# check the .h[ar] files
+# check what's left behind; add cleanup to assimilate.csh?
+# Get NSC # proposal numbers.
+# size of diagnostics to keep
+# obs_seq.final; 2 Gb ascii, < 1 Gb binary
+# *cpl_####.h[ar]*; y.y Gb * 80 = yyy Gb/set
+# inflation restarts; 85 Mb each x 2
+# preassim (how many?; change in assimilate.csh); 85 Mb each x 82 (mean & sd)
+# None? don't even do this stage during production?
+# postassim? or save those instead of all .i. files? 85 Mb each x 82 (mean & sd)
+# All; 162 * 85 Mb = 14 Gb
+# 150 Gb/set total (max) * #cycles
+# Saving restarts daily and all DART diagnostics =
+# 1.6 Tb/day =
+# 11.2 Tb/week
+# ? > Some of the NCEP+ACARS+GPS are missing; whole months in 2017, and days in 201612_6H_CESM.
+# ? > Add in AIRS after a week of assim?
+# > Not created for 2016-17 yet (2018-12-8)
+#
+# 2019-12-19-43200
+# I thought that the forecast died (cesm.log.3955623.chadmin1.190115-065642):
+# 4968:newchild: child "a:PIO:pio_write_darray" can't be a parent of itself
+# but that seems to be the end of all(?) the cesm.log files.
+# The job was still running, but I neglected to check that.
+# I submitted an assim-only job, which started.
+# It may have generated da.log.3957183.chadmin1.190115-072104
+# and probably screwed up the original job. I:
+# > removed all of the 2018-12-19-{43200,64800} results to run/../Mistaken_assim,
+# > staged the (thankfully) existing 19-21600 files,
+# > fixed the spurious cpl hist file print statements,
+# > put a conditional around the run_shadow creation, which probably contributed to
+# each cycle taking 30 seconds more than the previous throughout the job.
+# > rebuilt CAM, and submitted the rest of the 2 week job.
+# See timing analysis, discovery of CESM's timing script time sink in
+# laptop:~/DAI/ATM_forcXX/CAM6_setup/resources 2019-1-31
+#
+# State_all
+# We need to figure out which of the # 3D variables in the CAM6 initial files is state.
+# I put them all into the state vector in ../../work/input.nml.
+# I used QTY_3D_PARAMETER as the QTY for each of them, since they are not observed
+# in this experiment, but will be adjusted by the assimilation.
+# Start from the spun-up CESM2_1_Dec_spinup.
+# 80 members; want to know which are actually correlated with the reanalysis obs.
+# I integrated CESM2_1_Dec_spinup/assimilate.csh into ./assimilate.csh.template.
+
+# State_old
+# Same as State_all, but remove new vars from state vector.
+
+# St_archive
+# 3 members, to test new run_shadow at end, archiving (and useful .r.->.rh. files).
+
+# St_archive2
+# 3 members, to test new archiving (with compression and saving initial files to rest).
+# I made changes in $cesm, not SourceMods.
+# Fix new run_shadow (.r. -> \.r.\)
+
+# State_fxd_wet-dry
+# State_all, but with Eaton's fixes for the initial file, wet-dry bug.
+
+# Test_merged0
+# Merged Tim's reviewed assimilate.csh, compress.csh, and DART_config.template with mine.
+# This is a 3 member test of that,
+# plus
+# the final configuration we settled on for the 2017 assimilation.
+# State = {PS,T,Q,CLDLIQ,CLDICE,US,VS}
+# Inflation flavor 5
+# Start from the 2017-01-01-00000 of CESM2_1_Dec_spinup
+# Assim the usual obs (no AIRS or Q): NCEP_NCAR reanalysis + GPS.
+# No obs above level 5, no ramping.
+# > Sampling Error Correction (turned off for this test)
+# No members written to obs_seq files.
+# No posteriors written to obs_seq files.
+# Got changes from Nancy and built new filter.
+# Put new variable, compute_posterior = .false., in input.nml.
+# Initial file, wet-dry constituent fixes in Sourcemods.
+# Compression of output
+# CAM external (extra) forcings from CYCLICAL use of 2014 data
+# Remove use of my mpiexec_mpt
+# Check env_mach_specific.xml before running.
+# Fix the sleeps in compression; use default launch?
+#
+# Had to turn off SEC because it can't handle 3 members; 5 is min.
+# Had to fix assimilate.csh to look for inflation file names MY fill_inflation_restart creates.
+# Had to fix compress.csh: ./launch_cf.sh > launch_cf.sh
+# Resubmitted whole cycle 1. (by removing rpointer files, otherwise it fails)
+
+# Test_merged1
+# Test_merged0 is too much of a mess to see whether the file motion is correct.
+# Use corrected assimilate.csh in a new case.
+
+# f.e21.FHIST_BGC.f09_025.CAM6assim.001
+# > 80 members
+# > Sampling Error Correction
+# > purge, archive CESM2_1_Dec_spinup to $project
+# > Archiving to $project and/or campaign storage.
+#
+# ---------------------
+# Purpose
+# ---------------------
+#
+# This script is designed to set up, stage, and build a multi-instance,
+# multi-driver, CESM using an F compset, where CAM-FV, CLM and CICE are active.
+# In contrast to setup_hybrid, it also sets up the environment for doing
+# a CAM assimilation by setting up and running DART_config.
+# It is intended to be used after you have tested the basic set up
+# of CESM and DART for your case, using setup_hybrid and DART_config.
+# It also provides more mechanisms for optimizing the assimilation
+# for scientific studies.
+#
+# Because the atmosphere assimilations typically occur every 6 hours,
+# the methodology here reflects that. All of CESM stops every 6 hours
+# so that a CAM output file will be available for assimilation.
+#
+# ${caseroot}/DART_config is automatically run by this script and will
+# augment the CESM case with the required setup and configuration to use DART
+# to perform an assimilation.
+#
+# ---------------------
+# How to use this script.
+# ---------------------
+#
+# -- You will have to read and understand the script in its entirety.
+# You will have to modify things outside this script.
+# Instructions for what to change to use the CAM-Chem or WACCM are
+# outlined in the models/cam-fv/model_mod.html documentation.
+#
+# -- Examine the whole script to identify things to change for your experiments.
+#
+# -- Edit this script in the $DART/models/cam-fv/shell_scripts directory
+# or copy it and its dependent scripts to somewhere where it will be preserved.
+# It archives itself to the $caseroot directory during its execution.
+#
+# -- Locate or create the initial ensemble files that CESM will need.
+# The initial ensemble can come from a single- or multi-instance reference case.
+#
+# -- DOCN: The compsets required by this script use a single data ocean.
+# This script can use a daily, 1/4 degree resolution, ocean data set,
+# in place of the monthly, 1 or 2 degree set.
+#
+# -- Run this script. When it is executed, it will create:
+# 1) a CESM 'CASE' ($caseroot) directory, where the model will be built,
+# 2) a run directory, where each forecast + assimilation cycle will take place,
+# 3) a bld directory for the executables.
+# 4) CESM's short term archiver (st_archive) will use a fourth directory for
+# storage of model output until it can be moved to long term storage (HPSS)
+#
+# This script also executes ${caseroot}/DART_config which augments the case
+# with all the pieces necessary to run DART in the first job.
+# Read the instructions in that file too.
+#
+# -- Confirm the variable values in $caseroot/env_{build,run,batch,...}.xml.
+#
+# -- (if running DART) Edit the DART input.nml that appears in the ${caseroot}
+# directory to replace default values with your preferred values.
+#
+# -- Submit the job using ${caseroot}/case.submit -M begin,end
+#
+# ---------------------
+# Important features
+# ---------------------
+#
+# If you want to change something in your case other than the runtime settings,
+# it is safest to delete everything and create the case from scratch.
+# For the brave, read
+#
+# https://ncar.github.io/CAM/doc/build/html/users_guide/index.html
+# --> https://ncar.github.io/CAM/doc/build/html/users_guide/building-and-running-cam.html
+# --> http://esmci.github.io/cime/users_guide/building-a-case.html
+#
+#*******************************************************************************
+
+# ==============================================================================
+# case options:
+#
+# case The value of "case" will be used many ways; directory and file
+# names both locally and on HPSS, and script names; so consider
+# its length and information content.
+# compset Selects the CESM model components, vertical resolution, and physics packages.
+# Must be a CAM-FV "F" compset, either supported, or use the
+# --run-unsupported option.
+# Don't expect all CESM-supported compsets to work with DART.
+# For example, an active land ice model requires the NOLEAP calendar
+# (as of 2018-6), while DART requires GREGORIAN. But there's no need
+# for active land ice in atmospheric assimilations.
+# A compset defined specifically for CAM assimilations is
+# FHIST_DARTC6 = HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV
+# For a list of the pre-defined component sets:
+# > $CIMEROOT/scripts/create_newcase -list
+# To create a variant compset, see the CESM documentation
+# https://ncar.github.io/CAM/doc/build/html/users_guide/atmospheric-configurations.html
+# and carefully incorporate any needed changes into this script.
+# resolution Defines the horizontal resolution and dynamical core;
+# see http://esmci.github.io/cime/users_guide/grids.html.
+# f19_f19 ... FV core at ~ 2 degree (19 means 1.9 degrees of latitude).
+# f09_f09 ... FV core at ~ 1 degree (the 2nd f09 means CLM uses a .9 degree latitude grid)
+# To use the high resolution SST data ocean, use resolution "f09_d025" or "f19_d025"
+# and the user_grid variable.
+# > set user_grid = "${user_grid} --gridfile /glade/work/raeder/Models/CAM_init/SST"
+# > set user_grid = "${user_grid}/config_grids+fv1+2deg_oi0.25_gland20.xml"
+# cesmtag The version of the CESM source code to use when building the code.
+# The assimilate.csh in this directory will handle only cesm2_0 and later.
+# num_instances The number of ensemble members.
+#
+# ==============================================================================
+
+# The year of forcing
+setenv case f.e21.FHIST_BGC.f09_025.CAM6assim.001
+setenv compset HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+setenv user_grid ''
+# alias: f09_f09_mg17 (only for compsets that are not _POP and no CISM)
+setenv resolution f09_d025
+setenv cesmtag cesm2_1_relsd_m5.6
+setenv num_instances 80
+
+# If cemstag >= cesm2_0_alpha10f and compset = FHIST_DARTC6 (or another non-supported):
+# and resolution is non-standard (e.g. d025)
+setenv compset_args "--compset $compset"
+setenv compset_args "${compset_args} --run-unsupported"
+
+# ==============================================================================
+# machines and directories:
+#
+# mach Computer name
+# cesmdata Location of some supporting CESM data files.
+# cesmroot Location of the CESM code base. This version of the script
+# only supports version cesm2_0 or later, which is available from
+# https://github.com/ESCOMP/cesm.
+# sourcemods DART no longer requires a SourceMods directory in order to work with CESM.
+# If you have modifications to CESM, they should be provided in a
+# CESM-structured SourceMods directory, which this script expects to be in
+# $user/$cesmtag/SourceMods.
+# caseroot The CESM $CASEROOT directory, where the CESM+DART configuration files
+# will be stored and the build commands will be executed.
+# This should probably not be in scratch.
+# This script will delete an existing caseroot with the same name,
+# so this script and other things you want to preserve should be kept elsewhere.
+# dartroot Location of the root of _your_ DART installation.
+# cime_output $cime_root/$CASEROOT is the directory where CESM's build and run directories will be created.
+# Large amount of space needed, generally on a scratch partition.
+# CESM will define the following variables:
+# RUNDIR: The CESM run directory. Needs large amounts of disk.
+# Default; $CIME_OUTPUT_ROOT/$CASE/run
+# EXEROOT: The CESM executable directory.
+# Default; $CIME_OUTPUT_ROOT/$CASE/bld
+# DOUT_S_ROOT: The CESM short-term archive directory.
+# LARGE amount of disk.
+# Files remain here until you move them or they are purged.
+# Default; $CIME_OUTPUT_ROOT/archive/$CASE.
+# DART's preference is to define the archive directory to be;
+# $CIME_OUTPUT_ROOT/$CASE/archive
+# This change of DOUT_S_ROOT may interfere with the ability to clone your case.
+# archdir The CESM short-term archive directory.
+# Files will remain here until you move them to permanent storage
+# (or are purged).
+# baseobsdir Part of the directory name containing the obs_seq.out files to be used by the
+# assimilation. Assimilate.csh looks for a directory with the year and month:
+# $baseobsdir/YYYYMM_6H_CESM.
+# Will be inserted into DART_config and assimilate.csh.
+# ==============================================================================
+
+setenv mach cheyenne
+setenv cesmdata /glade/p/cesm/cseg/inputdata
+setenv cesmroot /glade/work/${USER}/Models/${cesmtag}
+setenv sourcemods ~/${cesmtag}/SourceMods
+setenv caseroot /glade/work/${USER}/Exp/${case}
+setenv dartroot /glade/u/home/${USER}/DART/rma_recam
+
+setenv cime_output /glade/scratch/${USER}
+setenv archdir ${cime_output}/${case}/archive
+
+setenv baseobsdir /glade/p/cisl/dares/Observations/NCEP+ACARS+GPS
+
+# ==============================================================================
+# Initial conditions files:
+#
+# refcase The name of the existing reference case that this run will
+# start from.
+#
+# refyear The specific date/time-of-day in the reference case that this
+# refmon run will start from. (Also see 'runtime settings' below for
+# refday start_year, start_mon, start_day and start_tod.)
+# reftod
+# NOTE: all the ref* variables must be treated like strings and have
+# the appropriate number of preceeding zeros
+#
+# stagedir The directory location of the reference case files.
+# ==============================================================================
+
+setenv refcase CESM2_1_Dec_spinup
+# setenv refcase CESM2_1_Rean_init_ens
+# setenv refcase Rean_2010.1-6_sst.25
+setenv refyear 2017
+# setenv refyear 2016
+setenv refmon 01
+# setenv refmon 12
+# setenv refmon 07
+# setenv refday 10
+setenv refday 01
+setenv reftod 00000
+
+# useful combinations of time that we use below
+setenv refdate $refyear-$refmon-$refday
+setenv reftimestamp $refyear-$refmon-$refday-$reftod
+
+# setenv stagedir /gpfs/fs1/p/cisl/dares/Reanalyses/CESM2_1_Dec_spinup/archive/rest/${reftimestamp}
+setenv stagedir /glade/p/cisl/dares/Reanalyses/CESM2_1_Dec_spinup/run
+# Alternative reference case for different dates, cases, etc. may be kept in places like:
+# setenv stagedir /glade/scratch/${USER}/${refcase}/run
+# setenv stagedir /glade/scratch/${USER}/${refcase}/archive/rest/${reftimestamp}
+# setenv stagedir /glade/work/${USER}/Models/CAM_init/FV1deg_cesm2_1/${reftimestamp}
+# or on the HPSS:
+# /CCSM/dart/FV0.9x1.25x30_cesm1_1_1/{Mon}1 for 1-degree FV ensembles
+
+# ==============================================================================
+# runtime settings: This script will find usable files for years 19mumble-2010.
+# Years after that (or before) may require searching $cesmdata for more
+# up-to-date files and adding them to the user_nl_cam_#### in the code below.
+#
+# start_year generally this is the same as the reference case date, but it can
+# start_month be different if you want to start this run as if it was a different time.
+# start_day
+# start_tod
+# stop_option Units for determining the forecast length between assimilations
+# stop_n Number of time units in each forecast
+# short_term_archiver Copies the files from each job step to a 'rest' directory.
+# ==============================================================================
+
+# setenv start_year 2016
+# setenv start_month 12
+# setenv start_day 10
+setenv start_year 2017
+setenv start_month 01
+setenv start_day 01
+setenv start_tod 00000
+setenv stop_option nhours
+setenv stop_n 6
+setenv short_term_archiver off
+
+# ==============================================================================
+# configure settings:
+
+# Configure needs to know the location of the CIME directory.
+# An environment variable is easier to specify than the command line argument.
+setenv CIMEROOT $cesmroot/cime
+
+# The tasks/node and threads/task we will use,
+# to be used by --pecount arg to create_namelist.
+# In cases where there are few observations but a large memory requirement,
+# it may be more efficient for DART to use fewer MPI tasks/node
+# than the number of available processors/node.
+# But that would restrict CAM to using fewer MPI tasks per node.
+# That can be compensated by telling CAM to use >1 (OpenMP) threads per node.
+# E.g. change from 36 tasks x 1 thread to 12 tasks x 3 threads.
+
+set use_tasks_per_node = 36
+set nthreads = 1
+
+# The default CAM sea surface temperature file is climatological,
+# which is less than ideal for atmospheric assimilations.
+# The supported alternative is time interpolation of a monthly SST+CICE data set.
+# Examples are provided here.
+# "2 degree":
+# setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2016_c170525.nc
+# setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv1.9x2.5_gx1v7.170518.nc
+# "1 degree":
+# setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2016_c170525.nc
+# setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc
+# Specify the beginning and ending years of the data set.
+# setenv sst_year_start 1850
+# setenv sst_year_end 2016
+
+# "1/4 degree":
+# A better alternative is daily, 1/4-degree SSTs from Reynolds,...,Tomas
+
+set user_grid = "${user_grid} --gridfile /glade/work/raeder/Models/CAM_init/SST"
+set user_grid = "${user_grid}/config_grids+fv1+2deg_oi0.25_gland20.xml"
+setenv sst_dataset \
+ "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20170101_cat_20171231_gregorian_c181119.nc"
+ # "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20160101_cat_20161231_gregorian_c181119.nc"
+ # "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20100101_cat_20101231_filled_c130829.nc"
+ # "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20130101_cat_20130731_filled_c170223.nc"
+
+set list = `ncdump -h $sst_dataset | grep calendar`
+if ($list[3] !~ '"gregorian"') then
+ echo "ERROR: $sst_dataset"
+ echo " must have the calendar attribute attached to the time variable."
+ echo " Use: ncatted -a calendar,time,c,c,gregorian $sst_dataset"
+ exit 5
+endif
+setenv sst_grid /glade/work/raeder/Models/CAM_init/SST/domain.ocn.d025.120821.nc
+setenv sst_year_start $start_year
+setenv sst_year_end $start_year
+
+# ==============================================================================
+# job settings:
+#
+# PROJECT CESM2 preferred name for account used to charge core hours.
+# Using setenv makes it available to utils/python/CIME/case.py/get_project
+# queue can be changed during a series by changing the case.run
+# timewall can be changed during a series by changing the case.run
+# ==============================================================================
+
+setenv PROJECT P86850054
+setenv queue premium
+setenv timewall 1:00
+
+# ==============================================================================
+# standard commands:
+#
+# Make sure that this script is using standard system commands
+# instead of aliases defined by the user.
+# If the standard commands are not in the location listed below,
+# change the 'set' commands to use them.
+# The 'force' (-f) options listed are added to commands where they are used.
+# The verbose (-v) argument has been separated from these command definitions
+# because these commands may not accept it on some systems. On those systems
+# set VERBOSE = ''
+# ==============================================================================
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+set VERBOSE = '-v'
+set MOVE = '/usr/bin/mv'
+set COPY = '/usr/bin/cp --preserve=timestamps'
+set LINK = '/usr/bin/ln -s'
+set LIST = '/usr/bin/ls'
+set REMOVE = '/usr/bin/rm'
+
+# ==============================================================================
+# ==============================================================================
+# by setting the values above you should be able to execute this script and
+# have it run. however, for running a real experiment there are still many
+# settings below this point - e.g. component namelists, history file options,
+# the processor layout, xml file options, etc - that you will almost certainly
+# want to change before doing a real science run.
+# ==============================================================================
+# ==============================================================================
+
+if ($?LS_SUBCWD) then
+ cd $LS_SUBCWD
+else if ($?PBS_O_WORKDIR) then
+ cd $PBS_O_WORKDIR
+endif
+
+# Store the location of these setup scripts for use in DART_config.
+set DART_CESM_scripts = `pwd`
+
+# ==============================================================================
+# Make sure the CESM directories exist.
+# VAR is the shell variable name, DIR is the value
+# ==============================================================================
+
+foreach VAR ( cesmroot dartroot stagedir )
+ set DIR = `eval echo \${$VAR}`
+ if ( ! -d $DIR ) then
+ echo "ERROR: directory '$DIR' not found"
+ echo " In the setup script check the setting of: $VAR "
+ exit 10
+ endif
+end
+
+# ==============================================================================
+# Create the case - this (re)creates the caseroot directory.
+# ==============================================================================
+
+# Fatal idea to make caseroot the same dir as where this setup script is
+# since the build process removes all files in the caseroot dir before
+# populating it. Try to prevent shooting yourself in the foot.
+
+if ( $caseroot == `pwd` ) then
+ echo "ERROR: the setup script should not be located in the caseroot"
+ echo "directory, because all files in the caseroot dir will be removed"
+ echo "before creating the new case. move the script to a safer place."
+ exit 11
+endif
+
+# Also don't recreate this case if you've archived any CAM output
+# in the existing case's archive directory.
+set old_files = ()
+if (-d $archdir/esp/hist) set old_files = `ls $archdir/esp/hist`
+if ($#old_files == 0) then
+ echo "removing old directory ${caseroot}"
+ echo "removing old directory ${cime_output}/${case}/bld"
+ echo "removing old directory ${cime_output}/${case}/run"
+ ${REMOVE} -fr ${caseroot}
+ ${REMOVE} -fr ${cime_output}/${case}/bld
+ ${REMOVE} -fr ${cime_output}/${case}/run
+else
+ echo "There are DART output files in $archdir/esp/hist."
+ echo "Either rename the case you are building, or delete the files and rebuild this case"
+ exit 12
+endif
+
+# This will override the value that may be set in your ~/.cime/config.
+setenv CIME_MODEL cesm
+
+# Record which CIME is being used.
+cd ${CIMEROOT}
+echo "\n Using the starred branch, below, of $CIMEROOT "
+git branch | grep '*'
+echo " "
+cd -
+
+# Record which CAM is being used.
+cd ${CIMEROOT}/../components/cam
+echo "n Using CAM version"
+head -n 5 doc/ChangeLog | tail -n 3
+echo "svn status -u:"
+svn status -u
+echo " "
+cd -
+
+# The ensemble CAM forecast is much more efficient for typical ensemble sizes (>40)
+# when the multi-driver capability is used. It may be less efficient for sizes < 10.
+setenv num_drivers $num_instances
+set multi_driver = ' '
+if ($num_drivers > 1) set multi_driver = ' --multi-driver '
+
+${CIMEROOT}/scripts/create_newcase \
+ --case $caseroot \
+ --machine $mach \
+ --res $resolution \
+ --project $PROJECT \
+ --queue $queue \
+ --walltime $timewall \
+ --pecount ${use_tasks_per_node}x${nthreads} \
+ --ninst $num_instances \
+ $compset_args \
+ $multi_driver \
+ $user_grid
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be created."
+ exit 15
+endif
+
+# Preserve a copy of this script as it was run.
+# If submitted interactively or with 'qcmd', this is easy.
+# If submitted as a batch job, the jobname and this script name
+# must be identical.
+
+if ($?LSB_JOBNAME) then
+ setenv setup_file_name $LSB_JOBNAME
+else if ($?PBS_JOBNAME) then
+ if ($PBS_JOBNAME == run/.qcmd) then
+ setenv setup_file_name $0:t
+ else
+ setenv setup_file_name $PBS_JOBNAME
+ endif
+else
+ setenv setup_file_name $0:t
+endif
+${COPY} -f ${VERBOSE} $setup_file_name ${caseroot}/${setup_file_name}.original
+
+# ==============================================================================
+# Configure the case.
+# ==============================================================================
+
+cd ${caseroot}
+
+# Save a copy of the original configuration for debug purposes
+
+foreach FILE ( *xml )
+ if ( ! -e ${FILE}.original ) then
+ ${COPY} -f ${VERBOSE} ${FILE} ${FILE}.original
+ endif
+end
+
+# Get a bunch of environment variables.
+# If any of these are changed by xmlchange calls in this program,
+# then they must be explicitly changed with setenv calls too.
+# $COMPSET is the long name which CESM uses, and is derived from $compset.
+# $compset is set by the user and may be an alias/short name.
+
+setenv COMPSET `./xmlquery COMPSET --value`
+setenv COMP_OCN `./xmlquery COMP_OCN --value`
+setenv COMP_GLC `./xmlquery COMP_GLC --value`
+setenv COMP_ROF `./xmlquery COMP_ROF --value`
+setenv CIMEROOT `./xmlquery CIMEROOT --value`
+setenv EXEROOT `./xmlquery EXEROOT --value`
+setenv RUNDIR `./xmlquery RUNDIR --value`
+setenv CAM_CONFIG_OPTS `./xmlquery CAM_CONFIG_OPTS --value`
+
+set max_tasks_per_node = `./xmlquery MAX_TASKS_PER_NODE --value`
+set max_mpitasks_per_node = `./xmlquery MAX_MPITASKS_PER_NODE --value`
+
+echo "From create_newcase, settings related to TASKS = ..."
+./xmlquery --partial TASK
+
+
+# Make sure the case is configured with a data ocean.
+
+if ( ${COMP_OCN} != docn ) then
+ echo " "
+ echo "ERROR: This setup script is not appropriate for active ocean compsets."
+ echo "ERROR: Please use the models/CESM/shell_scripts examples for that case."
+ echo " "
+ exit 40
+endif
+
+# Extract pieces of the COMPSET for choosing correct setup parameters.
+# E.g. "AMIP_CAM5_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM1%NOEVOLVE_SWAV"
+set comp_list = `echo $COMPSET | sed -e "s/_/ /g"`
+# Debug
+echo "compset parts are $comp_list"
+
+# Land ice, aka glacier, aka glc.
+
+if (${COMP_GLC} == sglc) then
+ set CISM_RESTART = FALSE
+else
+ echo "ERROR: glacier compset is ${COMP_GLC}, which is not supported by this script."
+ echo "ERROR: The only supported glacier compset is 'SGLC'"
+ exit 45
+ # In the future, if CISM can use the GREGORIAN calandar, and evolving land ice is
+ # deemed to be useful for atmospheric assimilations, this may still be required
+ # to make CISM write out restart files 4x/day.
+ ./xmlchange GLC_NCPL=4
+endif
+
+# The river transport model ON is useful only when using an active ocean or
+# land surface diagnostics. If you turn it ON, you will have to stage initial files etc.
+# There are 3 choices:
+# > a stub version (best for CAM+DART),
+# > the older River Transport Model (RTM),
+# > the new Model for Scale Adaptive River Transport (MOSART).
+# They are separate CESM components, and are/need to be specified in the compset.
+# It may be that RTM or MOSART can be turned off via namelists.
+# Specify the river runoff model: 'RTM', 'MOSART', or anything else.
+
+if (${COMP_ROF} == 'rtm') then
+ ./xmlchange ROF_GRID='r05'
+else if (${COMP_ROF} == 'mosart') then
+ # There seems to be no MOSART_MODE, but there are some MOSART_ xml variables.
+ # Use defaults for now
+ ./xmlchange ROF_GRID='r05'
+else if (${COMP_ROF} == 'drof') then
+ ./xmlchange ROF_GRID='null'
+else if (${COMP_ROF} == 'srof') then
+ ./xmlchange ROF_GRID='null'
+else
+ echo "river_runoff is ${COMP_ROF}, which is not supported"
+ exit 50
+endif
+
+# Need to know if we are using WACCM (aka WCCM or WXIE) for several reasons.
+# CESM2; maybe not needed anymore?
+# Mostly file management issues.
+# WARNING: Check your $COMPSET to see whether the grep pattern below will detect your WACCM ! !
+
+setenv waccm false
+set atm = `echo $comp_list[2] | sed -e "s#%# #"`
+if ($#atm > 1) then
+ echo $atm[2] | grep WC
+ if ($status == 0) setenv waccm true
+endif
+
+# NOTE: If you require bit-for-bit agreement between different runs,
+# in particular, between pmo (single instance) and assimilations (NINST > 1),
+# or if you need to change the number of nodes/member due to changing memory needs,
+# then env_run.xml:BFBFLAG must be set to TRUE, so that the coupler will
+# generate bit-for-bit identical results, regardless of the number of tasks
+# given to it. The time penalty appears to be ~ 0.5% in the forecast.
+# Alternatively, you can set NTASKS_CPL = same_number in both experiments
+
+# Task layout:
+# Set the nodes_per_instance below to the smallest number that will
+# let CAM run without memory problems. If you get 'out of memory'
+# errors OR failures without any messages, try increasing the nodes_per_instance.
+# Cheyenne has 46 Gb/node of usable memory. A 1 degree CAM6 works well with
+# 3 nodes/instance. A 2 degree works with 2 nodes/instance.
+# By computing task counts like we do below, we guarantee each instance uses
+# a whole number of nodes which is the recommended configuration.
+
+# There's no speed up by running non-active (data and stub) components concurrently,
+# after ATM has run, so just run all components sequentially.
+# BUT, do arrange it so that each member(instance) spans complete nodes:
+# modulo(total pe count / number of instances, use_tasks_per_node) == 0.
+# It seems odd to give so many processors to non-active components,
+# but that works best with the multi-driver option.
+
+# Multi-driver runs need to be told the number of tasks PER INSTANCE,
+# which will be multiplied up to give the total number tasks needed by the job.
+# If you choose to build a single driver case, multiply ntasks_active by
+# the $num_instances. CESM will then divide the tasks among the instances.
+# For large ensembles, this will double your computational cost.
+
+# Task layout:
+# Set the nodes_per_instance below to match your case.
+# By computing task counts like we do below, we guarantee each instance uses
+# a whole number of nodes which is the recommended configuration.
+#
+# CIME interprets a negative task count as representing the number of nodes.
+# On Cheyenne (at least) using multiple threads is not recommended.
+
+@ nodes_per_instance = 3
+@ ntasks_active = -1 * $nodes_per_instance
+@ ntasks_data = -1
+
+./xmlchange ROOTPE_ATM=0,NTHRDS_ATM=$nthreads,NTASKS_ATM=$ntasks_active
+./xmlchange ROOTPE_LND=0,NTHRDS_LND=$nthreads,NTASKS_LND=$ntasks_active
+./xmlchange ROOTPE_ICE=0,NTHRDS_ICE=$nthreads,NTASKS_ICE=$ntasks_active
+./xmlchange ROOTPE_ROF=0,NTHRDS_ROF=$nthreads,NTASKS_ROF=$ntasks_active
+./xmlchange ROOTPE_OCN=0,NTHRDS_OCN=$nthreads,NTASKS_OCN=$ntasks_active
+./xmlchange ROOTPE_GLC=0,NTHRDS_GLC=$nthreads,NTASKS_GLC=$ntasks_active
+./xmlchange ROOTPE_WAV=0,NTHRDS_WAV=$nthreads,NTASKS_WAV=$ntasks_active
+./xmlchange ROOTPE_CPL=0,NTHRDS_CPL=$nthreads,NTASKS_CPL=$ntasks_active
+./xmlchange ROOTPE_ESP=0,NTHRDS_ESP=$nthreads,NTASKS_ESP=$ntasks_data
+
+# A hybrid run is initialized like a startup but it allows users to bring together
+# combinations of initial/restart files from a previous case (specified by $RUN_REFCASE)
+# at a user-chosen, model output date (specified by $RUN_REFDATE).
+# The starting date of a hybrid run (specified by $RUN_STARTDATE) can be different
+# from $RUN_REFDATE.
+# There is a bit more complexity; DART only uses CAM _initial_ files, not _restart_ files,
+# so CAM will read initial files - even when CONTINUE_RUN = TRUE - # for cycles 2,... .
+# For more description of hybrid mode, see:
+# http://esmci.github.io/cime/users_guide/running-a-case.html?highlight=hybrid
+
+echo "After xmlchanges for ROOTPEs ..."
+
+./xmlquery --partial TASK
+./xmlquery --partial CIME_OUT
+./xmlquery --partial RUNDIR
+./xmlquery --partial EXEROOT
+./xmlquery --partial DOUT
+
+./xmlchange RUN_TYPE=hybrid
+./xmlchange RUN_STARTDATE=${start_year}-${start_month}-${start_day}
+./xmlchange START_TOD=$start_tod
+./xmlchange RUN_REFCASE=$refcase
+./xmlchange RUN_REFDATE=$refdate
+./xmlchange RUN_REFTOD=$reftod
+./xmlchange GET_REFCASE=FALSE
+
+./xmlchange CIME_OUTPUT_ROOT=${cime_output}
+
+./xmlchange SSTICE_DATA_FILENAME=$sst_dataset
+./xmlchange SSTICE_GRID_FILENAME=$sst_grid
+./xmlchange SSTICE_YEAR_ALIGN=$sst_year_start
+./xmlchange SSTICE_YEAR_START=$sst_year_start
+./xmlchange SSTICE_YEAR_END=$sst_year_end
+
+# Do not change the CALENDAR or the value of CONTINUE_RUN in this script.
+# Even if it's a branch from another run, where all restarts, etc. are available,
+# it still needs to change case/file names for this new case.
+
+./xmlchange CALENDAR=GREGORIAN
+./xmlchange CONTINUE_RUN=FALSE
+
+./xmlchange STOP_OPTION=$stop_option
+./xmlchange STOP_N=$stop_n
+
+# How many jobs (not cycles per job) to run after the first,
+# each of which will do DATA_ASSIMILATION_CYCLES cycles.
+# Set to 0 for the setup of the case, and the first cycle because
+# env_run.xml and input.nml will/may need to be changed between cycle 1 and 2
+# (and you really should confirm that the assimilation worked).
+
+./xmlchange RESUBMIT=0
+
+./xmlchange PIO_TYPENAME=pnetcdf
+
+# COUPLING discussion. F compsets are 'tight' coupling.
+# Only change the ATM_NCPL ... everything is based on this one value,
+# including CAM physics and dynamics timesteps.
+# Default values for coupling are preserved in env_run.xml.original
+
+./xmlchange NCPL_BASE_PERIOD=day
+./xmlchange ATM_NCPL=48
+
+# Sometimes we need to remove some bit of physics from a compset.
+# One example was that the CLM irrigation setting needed to be removed
+# from builds which are not CAM4. This was fixed in later CESMs,
+# but here's an example of how to do it.
+# echo $CAM_CONFIG_OPTS | grep 'cam4'
+# if ($status != 0) then
+# setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+# set clm_opts = `echo $CLM_BLDNML_OPTS | sed -e "s#-irrig=.true.##"`
+# ./xmlchange CLM_BLDNML_OPTS="$clm_opts"
+# # DEBUG/confirm
+# setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+# echo "CLM_BLDNML_OPTS has been changed to $CLM_BLDNML_OPTS"
+# endif
+
+# Or, if you know the description of the physics you need, just set it (then test it!)
+# setenv CAM_CONFIG_OPTS "-user_knows_better"
+# ./xmlchange CAM_CONFIG_OPTS=$CAM_CONFIG_OPTS
+
+if ($short_term_archiver == 'off') then
+ ./xmlchange DOUT_S=FALSE
+else
+ ./xmlchange DOUT_S=TRUE
+endif
+./xmlchange DOUT_S_ROOT=${archdir}
+
+# DEBUG = TRUE implies turning on run and compile time debugging.
+# INFO_DBUG level of debug output, 0=minimum, 1=normal, 2=more, 3=too much.
+./xmlchange DEBUG=FALSE
+./xmlchange INFO_DBUG=0
+
+# ==============================================================================
+# Update source files.
+# DART does not require any modifications to the model source.
+# ==============================================================================
+
+# Import your SourceMods, if you have any. DART doesn't have any of its own.
+if (-d ${sourcemods} ) then
+ echo ' '
+ ${COPY} -r ${VERBOSE} ${sourcemods}/* ${caseroot}/SourceMods/ || exit 62
+ echo ' '
+ echo ' '
+else
+ echo "No SourceMods for this case."
+endif
+
+# components/mosart/cime_config/buildnml:line 108:
+# $RUNDIR/${RUN_REFCASE}.{clm2,mosart}${inst_string}.r.${RUN_REFDATE}-${RUN_REFTOD}.nc
+# don't exist. That's because case.setup creates $RUNDIR and then calls the buildnml routines.
+# stage_cesm_files needs $RUNDIR to exist before it can make files there. Those files are
+# the ones buildnml checks. It's not fatal, just annoying warnings "WARNING:: mosart.buildnml . . .".
+# "Fix" by setting RUN_REFDIR to $stagedir.
+
+./xmlchange RUN_REFDIR=$stagedir
+
+# ==============================================================================
+# Set up the case.
+# This creates the EXEROOT and RUNDIR directories.
+# ==============================================================================
+
+echo 'Setting up the case ...'
+echo 'Ignore "WARNING:: mosart.buildnml . . .". Those files will be provided later'
+
+echo 'Before case.setup, modules are'
+source /etc/profile.d/modules.csh
+module list
+
+./case.setup
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be set up."
+ exit 70
+endif
+
+# ==============================================================================
+# Set up and run the DART_config script, which adapts the CAM case to do assimilation.
+# ==============================================================================
+
+# Define how often sets of restart files will be archived,
+# in order to conserve disk space during a multi-cycle job.
+setenv save_every_Mth_day_restart 3
+
+# Fill the DART_config script with information it needs and copy it to caseroot.
+# DART_config can be run at some later date if desired, but it must be run
+# from a caseroot directory.
+if ( -e ${DART_CESM_scripts}/DART_config.template ) then
+ sed -e "s#your_dart_path#${dartroot}#" \
+ -e "s#your_setup_script_dir#$DART_CESM_scripts:t#" \
+ -e "s#your_observation_path#${baseobsdir}#" \
+ -e "s#days_between_archiving_restarts#${save_every_Mth_day_restart}#" \
+ < ${DART_CESM_scripts}/DART_config.template \
+ >! DART_config || exit 20
+else
+ echo "ERROR: the script to configure for data assimilation is not available."
+ echo " DART_config.template MUST be in $DART_CESM_scripts "
+ exit 22
+endif
+chmod 755 DART_config
+
+./DART_config || exit 80
+
+# ==============================================================================
+# Edit scripts to reflect queue and wallclock
+# ==============================================================================
+
+# The new case.st_archive job script calls st_archive. It runs after the case.run job.
+# It submits the next case.run job, if RESUBMIT > 0.
+# Fix some pieces.
+# /X/ means search for lines with X in them.
+# 'c' means replace the line with the following.
+# 'a' means append after the current line.
+# In addition, env_batch.xml has a section we want to change, which xmlchange can't do.
+# Make st_archive run on 1 processor ( 'select' for pbs, 'ptile' for lsf).
+
+if ($?LSB_JOBNAME) then
+ sed -e "/BSUB[ ]*-o/c\#BSUB -o cesm_st_arch.stdout.%J" \
+ -e "/BSUB[ ]*-e/c\#BSUB -e cesm_st_arch.stderr.%J" \
+ -e "/BSUB[ ]*-J/c\#BSUB -J ${case}.st_arch" \
+ -e '/ptile/c/#BSUB -R "span[ptile=1]"' \
+ case.st_archive >! temp.$$ || exit 55
+ ${MOVE} temp.$$ case.st_archive
+ ./xmlchange --subgroup case.st_archive --id JOB_QUEUE --val share
+
+else if ($?PBS_JOBNAME) then
+ # It would be nice to put the $PBS_JOBID value into the job name and st err/out file names,
+ # but "environment variables are not resolved when they're in the #PBS directives",
+ # despite their use in the default job and st.err/out file names.
+ sed -e "/\-l select/c\#PBS -l select=1:ncpus=1:mpiprocs=1:ompthreads=1" \
+ -e "/\-N /c\#PBS -N ${case}.st_arch" \
+ -e "/\-N /a\#PBS -o ./${case}.st_arch.stdouterr" \
+ case.st_archive >! temp.$$ || exit 55
+ ${MOVE} temp.$$ case.st_archive
+ ./xmlchange --subgroup case.st_archive --id JOB_QUEUE --val share
+
+endif
+chmod 755 case.st_archive
+
+./xmlchange --subgroup case.st_archive --id JOB_WALLCLOCK_TIME --val 1:00
+
+# ==============================================================================
+# Modify namelist templates for each instance.
+#
+# In a hybrid run with CONTINUE_RUN = FALSE (i.e. just starting up):
+# CAM has been forced to read initial files - specified by namelist var:ncdata.
+# CICE reads from namelist variable 'ice_ic'.
+# CLM builds its own 'finidat' value from the REFCASE variables,
+# or the output from the interpolation is assigned to finidat in this namelist.
+#
+# When CONTINUE_RUN = TRUE, CICE and CLM get restart file names from pointer files.
+#
+# All of these must later on be staged with these same filenames.
+# ==============================================================================
+
+# Decide whether interpolation of the CLM restart file will be done.
+# If so, each CLM namelist needs it's own finidat_interp_dest.
+set do_clm_interp = "false"
+
+@ inst = 1
+while ($inst <= $num_instances)
+
+ # following the CESM strategy for 'inst_string'
+ set inst_string = `printf _%04d $inst`
+
+ # ===========================================================================
+ set fname = "user_nl_cam${inst_string}"
+ # ===========================================================================
+ # ATM Namelist
+
+ # DART/CAM requires surface geopotential (PHIS) for calculation of
+ # column pressures. It's convenient to write it to the .h0. every
+ # assimilation time. If you want to write it to a different .h?. file, you MUST
+ # modify the assimilate.csh script in several places. You will need to set
+ # 'empty_htapes = .false.' and change 'nhtfrq' and 'mfilt' to get a CAM
+ # default-looking .h0. file.
+ # If you want other fields written to history files, use h1,...,
+ # which are not purged by assimilate.csh.
+ #
+ # inithist 'ENDOFRUN' ensures that CAM writes the required initial file
+ # every time it stops.
+ # mfilt # of times/history file. Default values are 1,30,30,.....
+
+ echo " inithist = 'ENDOFRUN'" >> ${fname}
+ echo " ncdata = 'cam_initial${inst_string}.nc'" >> ${fname}
+ echo " empty_htapes = .true. " >> ${fname}
+ echo " fincl1 = 'PHIS:I' " >> ${fname}
+ echo " nhtfrq = -$stop_n " >> ${fname}
+ # echo " mfilt = 1 " >> ${fname}
+
+ echo $CAM_CONFIG_OPTS | grep 'cam4'
+ if ($status == 0) echo " fv_div24del2_flag = 4 " >> ${fname}
+
+ # Settings that differ between regular CAM and the WACCM version:
+
+
+ # CAM forcing files.
+ # Some of the files specified here are because the default files only
+ # contain data through 2005 or 2010 and we are interested in time frames after that.
+
+ # set chem_datapath = "${cesmdata}/atm/cam/chem/trop_mozart_aero"
+
+ if ($start_year > 2014) then
+
+ set cesm_data_dir = "/glade/p/cesmdata/cseg/inputdata/atm"
+ set cesm_chem_dir = "/gpfs/fs1/p/acom/acom-climate/cmip6inputs/emissions_ssp119"
+ set chem_root = "${cesm_chem_dir}/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp119-1-1"
+ set chem_dates = "175001-210012_0.9x1.25_c20181024"
+
+# Default: H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'," >> ${fname}
+# Try a file with enough years (but questionable content from
+# /glade/scratch/mmills/CH4/CCMI_1955_2099_RCP6_ave_CH4_CHML.nc):
+ echo " ext_frc_specifier = " >> ${fname}
+ echo " 'H2O -> ${cesm_data_dir}/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_1850-2100_CCMI_RCP8_5_c160219.nc'" >> ${fname}
+ echo " 'num_a1 -> ${chem_root}_num_so4_a1_anthro-ene_vertical_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'so4_a1 -> ${chem_root}_so4_a1_anthro-ene_vertical_mol_${chem_dates}.nc'" >> ${fname}
+
+ echo " srf_emis_specifier =" >> ${fname}
+ echo " 'bc_a4 -> ${chem_root}_bc_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'bc_a4 -> ${chem_root}_bc_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'DMS -> ${chem_root}_DMS_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'DMS -> ${cesm_chem_dir}/emissions-cmip6-SSP_DMS_other_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a1 -> ${chem_root}_num_so4_a1_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a1 -> ${chem_root}_num_so4_a1_anthro-ag-ship_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a2 -> ${chem_root}_num_so4_a2_anthro-res_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_bc_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_bc_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_pom_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_pom_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'pom_a4 -> ${chem_root}_pom_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'pom_a4 -> ${chem_root}_pom_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SO2 -> ${chem_root}_SO2_anthro-ag-ship-res_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SO2 -> ${chem_root}_SO2_anthro-ene_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SO2 -> ${chem_root}_SO2_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'so4_a1 -> ${chem_root}_so4_a1_anthro-ag-ship_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'so4_a2 -> ${chem_root}_so4_a2_anthro-res_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SOAG -> ${chem_root}_SOAGx1.5_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SOAG -> ${chem_root}_SOAGx1.5_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SOAG -> ${chem_root}_SOAGx1.5_biogenic_surface_mol_${chem_dates}.nc'" >> ${fname}
+# echo " 'SOAG -> ${chem_root}_SOAGx1.5_biogenic_surface_mol_201501-210012_0.9x1.25_c20181024.nc'" >> ${fname}
+ echo " 'so4_a1 -> ${chem_root}_so4_a1_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+
+# Queried Mike Mills 2018-12-3
+# He says; not available, and won't be
+# Try using the default file, but with cyclical trace gases, year 2014 (the last full).
+ echo " prescribed_ozone_type = 'CYCLICAL'" >> ${fname}
+ echo " prescribed_ozone_cycle_yr = 2014" >> ${fname}
+ echo " prescribed_strataero_type = 'CYCLICAL'" >> ${fname}
+ echo " prescribed_strataero_cycle_yr = 2014" >> ${fname}
+
+# Defaults:
+# tracer_cnst_datapath = '${cesm_data_dir}/cam/tracer_cnst'"
+# tracer_cnst_file = 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'
+# 2014 is not available in this default halons file.
+# And the 2015 is an average of 2012-2014 output.
+# This file that has yearly through 2014, not averaged.
+ echo " tracer_cnst_file = 'tracer_cnst_halons_WACCM6_3Dmonthly_L70_1975-2014_c180216.nc'" >> ${fname}
+ echo " tracer_cnst_type = 'CYCLICAL'" >> ${fname}
+ echo " tracer_cnst_cycle_yr = 2014" >> ${fname}
+
+# Mike Mills:
+# the way that CAM deals with these greenhouse gases:
+# the code actually calculates a global average value
+# before passing this on to the radiation code.
+# So it was considered undesirable to use the WACCM file,
+# which would create a strange globally averaged seasonal cycle in CO2,
+# one dominated by the cycle in the Northern Hemisphere.
+# Because this file only has one value each year, CYCLICAL is not an option when using it.
+# To maintain 2014 values, you should use FIXED.
+# The default file has yearly data, which CAM can't handle with CYCLICAL.
+# (see DiscussCESM "Cycling dates in chem_surfvals_nl fails when data is yearly")
+# This fails because a year can't be specified with 'FIXED' (!)
+# I've asked Mike about this.
+# echo " flbc_file = '${cesm_data_dir}/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc' " >> ${fname}
+# echo " flbc_type = 'FIXED'" >> ${fname}
+# This file is monthly, but see Mills' comments, above.
+ echo " flbc_file = '${cesm_data_dir}/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc' " >> ${fname}
+ echo " flbc_type = 'CYCLICAL'" >> ${fname}
+ echo " flbc_cycle_yr = 2014" >> ${fname}
+
+ else
+ if ($inst == 1) then
+ echo 'WARNING; using default ozone and tracer_cnst forcing files'
+ echo 'WARNING; using default srf_emis_* and ext_frc_*'
+ echo "WARNING; using default bndtvghg"
+ echo "WARNING; using default volcaero"
+ endif
+ endif
+
+ # if ($start_year > 2008) then
+ # The default as of April 2015 is
+ # /glade/p/cesmdata/cseg/inputdata/atm/cam/solar/SOLAR_SPECTRAL_Lean_1610-2008_annual_c090324.nc
+ # For later dates there are files which repeat the solar cycles from 1960-2008
+ # in order to create a time series out to 2140:
+ # .../spectral_irradiance_Lean_1610-2140_ann_c100408.nc
+ # This does not look like an exact extension of the default,
+ # but does look like the previous default. So try it.
+
+ # echo " solar_data_file = '${cesmdata}/atm/cam/solar/spectral_irradiance_Lean_1610-2140_ann_c100408.nc'" >> ${fname}
+ # endif
+
+ # ===========================================================================
+ set fname = "user_nl_clm${inst_string}"
+ # ===========================================================================
+ # LAND Namelist
+ # With a RUN_TYPE=hybrid the finidat is automatically specified
+ # using the REFCASE, REFDATE, and REFTOD information. i.e.
+ # finidat = ${stagedir}/${refcase}.clm2${inst_string}.r.${reftimestamp}.nc
+ #
+ # Making a (compact) .h0. file is a good idea, since the clm restart files
+ # do not have all the metadata required to reconstruct a gridded field.
+ # 'TSA' is 2m surface air temperature. This also prevents
+ # having truly empty history files, resulting in ntapes = 0,
+ # which prevents the hybrid-mode model from restarting.
+ # CESM2_0 and, or, CLM5: is that still true?
+ #
+ echo "hist_empty_htapes = .true." >> ${fname}
+ echo "hist_fincl1 = 'TSA'" >> ${fname}
+ echo "hist_nhtfrq = -$stop_n" >> ${fname}
+ echo "hist_mfilt = 1" >> ${fname}
+ echo "hist_avgflag_pertape = 'I'" >> ${fname}
+
+ # This was needed to allow the interpolation of the default CLM restart file.
+ # It is needed in runs that start from a somewhat spun up ensemble.
+
+ if ($do_clm_interp == "true") then
+ echo "use_init_interp = .true. " >> ${fname}
+ echo "init_interp_fill_missing_with_natveg = .true." >> ${fname}
+ endif
+
+ # but we don't particularly want or need methane
+ echo "use_lch4 = .false." >> ${fname}
+
+# echo "check_finidat_year_consistency = .false." >> ${fname}
+# echo "urban_hac = 'OFF'" >> ${fname}
+# echo "building_temp_method = 0 " >> ${fname}
+
+ # ===========================================================================
+ set fname = "user_nl_cice${inst_string}"
+ # ===========================================================================
+ # CICE Namelist
+
+ echo $CAM_CONFIG_OPTS | grep 'cam4'
+ if ($status == 0) then
+ # CAM4:
+ echo "ice_ic = 'default'" >> ${fname}
+ else
+ # CAM5, 6, ...:
+ echo "ice_ic = '${refcase}.cice${inst_string}.r.${reftimestamp}.nc'" >> ${fname}
+ endif
+
+ @ inst ++
+
+end
+
+# ===========================================================================
+set fname = "user_nl_cpl"
+# ===========================================================================
+# DRV or CPL Namelist
+# For some reason, a single user_nl_cpl works even when --multi-driver is used.
+
+# compset J1850G (all active except atm, from lofverstrom) + river (Lindsay)
+# needed this set of forcing.
+echo " histaux_a2x3hr = .true." >> ${fname}
+echo " histaux_a2x24hr = .true." >> ${fname}
+echo " histaux_a2x1hri = .true." >> ${fname}
+echo " histaux_a2x1hr = .true." >> ${fname}
+echo " histaux_r2x = .true." >> ${fname}
+# These cause cpl.ha. to be written.
+# The Reanalysis project doesn't need those large files for forcing other components
+# So use defaults (off).
+# ./xmlchange AVGHIST_OPTION=$stop_option
+# ./xmlchange AVGHIST_N=$stop_n
+
+# No histaux_a2x3hrp (precip)?
+# No histaux_l2x ?
+
+./preview_namelists || exit 75
+
+# ==============================================================================
+# Stage the restarts now that the run directory exists.
+# Create a script to do this since it may be needed to recover or restart.
+# Create the script and then run it here.
+# ==============================================================================
+
+set init_time = ${reftimestamp}
+
+cat << EndOfText >! stage_cesm_files
+#!/bin/csh -f
+# This script can be used to help restart an experiment from any previous step.
+# The appropriate files are copied to the RUN directory.
+#
+# Before running this script:
+# 1) be sure CONTINUE_RUN is set correctly in the env_run.xml file in
+# your caseroot directory.
+# CONTINUE_RUN=FALSE => you are starting over at the initial time.
+# CONTINUE_RUN=TRUE => you are starting from a previous step but not
+# the very first one.
+# 2) be sure 'restart_time' is set to the day and time from which you want to
+# restart, if not the initial time.
+
+set restart_time = $init_time
+
+# ---------------------------------------------------------
+# Get the settings for this case from the CESM environment
+# ---------------------------------------------------------
+cd ${caseroot}
+setenv RUNDIR \`./xmlquery RUNDIR --value\`
+setenv CONTINUE_RUN \`./xmlquery CONTINUE_RUN --value\`
+
+ls \$RUNDIR/*.i.\${restart_time}.nc
+if (\$status == 0) then
+ # The restart set exists in the RUNDIR, regardless of the short term archiver.
+ setenv DOUT_S FALSE
+else
+ set hide_loc = \`ls \$RUNDIR:h/Hide*/*_0001.i.\${restart_time}.nc\`
+ if (\$status == 0) then
+ # The restart set exists in a Hide directory, regardless of the short term archiver.
+ setenv DOUT_S FALSE
+ mv \$hide_loc:h/* \${RUNDIR}
+ else
+ setenv DOUT_S \`./xmlquery DOUT_S --value\`
+ setenv DOUT_S_ROOT \`./xmlquery DOUT_S_ROOT --value\`
+ endif
+endif
+
+# ---------------------------------------------------------
+
+cd \${RUNDIR}
+
+echo 'Copying the required CESM files to the run directory to rerun a previous step. '
+echo 'CONTINUE_RUN from env_run.xml is' \${CONTINUE_RUN}
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+ echo 'so files for some later step than the initial one will be restaged.'
+ echo "Date to reset files to is: \${restart_time}"
+else
+ echo 'so files for the initial step of this experiment will be restaged.'
+ echo "Date to reset files to is: ${init_time}"
+endif
+echo ''
+
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+
+ #----------------------------------------------------------------------
+ # This block copies over a set of restart files from any previous step of
+ # the experiment that is NOT the initial step.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+ echo "Staging restart files for run date/time: " \${restart_time}
+
+ if ( \${DOUT_S} =~ TRUE ) then
+
+ # The restarts should be in the short term archive 'rest' restart directories.
+
+ set RESTARTDIR = \${DOUT_S_ROOT}/rest/\${restart_time}
+
+ if ( ! -d \${RESTARTDIR} ) then
+
+ echo "restart file directory not found: "
+ echo " \${RESTARTDIR}"
+ exit 100
+
+ endif
+
+ ${COPY} \${RESTARTDIR}/* . || exit 101
+
+ else
+
+ # The short term archiver is off, which leaves all the restart files
+ # in the run directory. The rpointer files must still be updated to
+ # point to the files with the right day/time.
+
+ @ inst=1
+ while (\$inst <= $num_instances)
+
+ set inst_string = \`printf _%04d \$inst\`
+
+ echo "${case}.clm2\${inst_string}.r.\${restart_time}.nc" >! rpointer.lnd\${inst_string}
+ echo "${case}.cice\${inst_string}.r.\${restart_time}.nc" >! rpointer.ice\${inst_string}
+ echo "${case}.cam\${inst_string}.r.\${restart_time}.nc" >! rpointer.atm\${inst_string}
+ if (${COMP_ROF} == 'rtm') then
+ echo "${case}.rtm\${inst_string}.r.\${restart_time}.nc" >! rpointer.rof\${inst_string}
+ else if (${COMP_ROF} == 'mosart') then
+ echo "${case}.mosart\${inst_string}.r.\${restart_time}.nc" >! rpointer.rof\${inst_string}
+ endif
+ if ($num_drivers > 1) then
+ echo "${case}.cpl\${inst_string}.r.\${restart_time}.nc" >! rpointer.drv\${inst_string}
+ echo "${case}.docn\${inst_string}.r.\${restart_time}.nc" >! rpointer.ocn\${inst_string}
+ echo "${case}.docn\${inst_string}.rs1.\${restart_time}.bin" >> rpointer.ocn\${inst_string}
+ endif
+
+ @ inst ++
+ end
+
+ # There are no instance numbers in these filenames.
+ if ($num_drivers == 1) then
+ echo "${case}.cpl.r.\${restart_time}.nc" >! rpointer.drv
+ echo "${case}.docn.r.\${restart_time}.nc" >! rpointer.ocn
+ echo "${case}.docn.rs1.\${restart_time}.bin" >> rpointer.ocn
+ endif
+
+ endif
+
+ # Relink the CAM initial files back to the hardwired names set in the namelist
+
+ @ inst=1
+ while (\$inst <= $num_instances)
+ set inst_string = \`printf _%04d \$inst\`
+ ${LINK} -f ${case}.cam\${inst_string}.i.\${restart_time}.nc cam_initial\${inst_string}.nc
+ @ inst ++
+ end
+
+ echo "All files reset to rerun experiment step using (ref)time " \$restart_time
+
+else # CONTINUE_RUN == FALSE
+
+ #----------------------------------------------------------------------
+ # This block links the right files to rerun the initial (very first)
+ # step of an experiment. The names and locations are set during the
+ # building of the case; to change them rebuild the case.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+ echo ' '
+
+ @ inst=1
+ while (\$inst <= $num_instances)
+
+ set inst_string = \`printf _%04d \$inst\`
+
+ echo "Staging initial files for instance \$inst of $num_instances"
+
+ ${LINK} -f ${stagedir}/${refcase}.clm2\${inst_string}.r.${init_time}.nc .
+ ${LINK} -f ${stagedir}/${refcase}.cice\${inst_string}.r.${init_time}.nc .
+ ${LINK} -f ${stagedir}/${refcase}.cam\${inst_string}.i.${init_time}.nc cam_initial\${inst_string}.nc
+ if (${COMP_ROF} == 'rtm') then
+ ${LINK} -f ${stagedir}/${refcase}.rtm\${inst_string}.r.${init_time}.nc .
+ else if (${COMP_ROF} == 'mosart') then
+ ${LINK} -f ${stagedir}/${refcase}.mosart\${inst_string}.r.${init_time}.nc .
+ endif
+
+ @ inst ++
+ end
+
+ echo "All files set to run the FIRST experiment step using (ref)time" $init_time
+
+endif
+exit 0
+
+EndOfText
+chmod 0755 stage_cesm_files
+
+./stage_cesm_files
+
+# ==============================================================================
+# Build the case
+# ==============================================================================
+
+echo ''
+echo 'Building the case'
+echo " --skip-provenance-check is used. See note in $0"
+echo ''
+
+# --skip-provenance-check because of svn or git timing out during build
+# of CLM. It wanted authentication(?) to access a private repository.
+# A better solution would be to find out why(whether) it thinks CLM is
+# a private repository.
+
+./case.build --skip-provenance-check
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be built."
+ exit 120
+endif
+
+# ==============================================================================
+# Check some XML settings which should have been set by this script.
+# ==============================================================================
+
+echo ' '
+echo 'CESM settings which are of special interest:'
+echo ' '
+foreach var ( CONTINUE_RUN RESUBMIT RUN_REF RUN_STARTDATE STOP_OPTION \
+ STOP_N SSTICE DOUT RUNDIR MPI_RUN_COMMAND AVGHIST ASSIM)
+ ./xmlquery --partial $var | grep -v 'Results in' | grep -v '^$'
+end
+echo ' '
+
+# ==============================================================================
+# What to do next
+# ==============================================================================
+
+cat << EndOfText >! CESM_instructions.txt
+
+-------------------------------------------------------------------------
+Time to check the case.
+
+1) Scan the output from this setup script for errors and warnings:
+ ERROR, WARNING, 'No such file' (except for MOSART)
+ 'File status unknown' can be ignored.
+ 'ERROR: cice.buildlib failed' can be ignored, unless you've changed the CICE code
+
+2) cd ${RUNDIR}
+ Check the files that were staged; follow the links to confirm the data sources.
+ Check the compatibility between them and the namelists and pointer files.
+
+3) cd ${caseroot}
+ Verify the CESM XML settings, especially in env_batch.xml and env_run.xml.
+ ./xmlquery --partial
+ is particularly useful.
+
+4) The default initial configuration is to assimilate.
+ Verify the ${caseroot}/input.nml contents.
+ Assimilation can be turned off by
+ ./xmlchange DATA_ASSIMILATION_SCRIPT=${caseroot}/no_assimilate.csh
+ DART can be turned off by
+ ./xmlchange DATA_ASSIMILATION=FALSE
+
+5) Submit the job (and get mail when it starts and stops):
+ ./case.submit -M begin,end
+
+6) After the job has run, check to make sure it worked.
+
+7) If the first cycle generated an ensemble by perturbing a single state,
+ change input.nml as described in the instructions in it,
+ to make cycles 2,...,N use the latest ensemble, unperturbed.
+
+8) To extend the run in $stop_n '$stop_option' steps, use xmlchange to
+ change the CESM runtime variables:
+
+ ./xmlchange DATA_ASSIMILATION_CYCLES= the value you want.
+ ./xmlchange CONTINUE_RUN=TRUE
+ ./xmlchange RESUBMIT= the number of JOBS to run (each JOB performs DATA_ASSIMILATION_CYCLES cycles)
+
+EndOfText
+
+cat CESM_instructions.txt
+cat DART_instructions.txt
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/shell_scripts/cesm2_1/setup_hybrid b/models/cam-fv/shell_scripts/cesm2_1/setup_hybrid
new file mode 100755
index 0000000000..62fd5200b6
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/setup_hybrid
@@ -0,0 +1,1228 @@
+#!/bin/csh -f
+#
+# 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
+#
+# DART $Id$
+#
+# This script can be run interactively, but on some systems (e.g. cheyenne)
+# it takes longer than is allowed for an interactive job.
+# In that case, it can be run as a batch job using the directives below,
+# or using "qcmd -q share -l select=1 -- ".
+# The job name should be the name of this script(file),
+# or this file may not be archived in $caseroot causing DART_config to fail.
+#--------------------------------------------
+#BSUB -J setup_hybrid
+#BSUB -n 1
+#BSUB -R "span[ptile=1]"
+#BSUB -q shared_node_queue_for_this_setup_script
+#BSUB -P your_account_there
+#BSUB -W 2:00
+#BSUB -u you@email.org
+#BSUB -N
+#BSUB -a poe
+#BSUB -o Test0.bld1
+#BSUB -e Test0.bld1
+#--------------------------------------------
+#PBS -N setup_hybrid
+#PBS -A your_account_there
+#PBS -q shared_node_queue_for_this_setup_script
+#
+# Resources I want:
+# select=#nodes
+# ncpus=#CPUs/node
+# mpiprocs=#MPI_tasks/node
+#PBS -l select=1:ncpus=4:mpiprocs=4
+#PBS -l walltime=01:00:00
+#PBS -m ae
+#PBS -M you@email.org
+# Send standard output and error to this file.
+# It's helpful to use the $casename here.
+#PBS -o Test_0.bld1
+#PBS -j oe
+#
+# ---------------------
+# Purpose
+# ---------------------
+#
+# This script is designed to set up, stage, and build a multi-instance,
+# multi-driver, CESM using an F compset, where CAM-FV, CLM and CICE are active.
+# It sets up the environment for doing a CAM assimilation, but does not tell
+# CESM to setup or run the assimilation. That is done by DART_config.
+# You are STRONGLY encouraged to run the multi-instance CESM a few times and
+# experiment with different settings BEFORE you try to assimilate observations.
+# The data volume is quite large and you should become comfortable using
+# CESM's restart capability to re-stage files in your RUN directory.
+#
+# Because the atmosphere assimilations typically occur every 6 hours,
+# the methodology here reflects that. All of CESM stops every 6 hours
+# so that a CAM output file will be available for assimilation.
+#
+# ${caseroot}/DART_config must be run as a step that's separate from this script.
+# It will augment the CESM case with the required setup and configuration
+# to use DART to perform an assimilation.
+#
+# ---------------------
+# How to use this script.
+# ---------------------
+#
+# -- You will have to read and understand the script in its entirety.
+# You will have to modify things outside this script.
+# Instructions for what to change to use the CAM-Chem or WACCM are
+# outlined in the models/cam-fv/model_mod.html documentation.
+#
+# -- Examine the whole script to identify things to change for your experiments.
+#
+# -- Edit this script in the $DART/models/cam-fv/shell_scripts directory
+# or copy it and its dependent scripts to somewhere where it will be preserved.
+# It archives itself to the $caseroot directory during its execution.
+#
+# -- Locate or create the initial ensemble files that CESM will need.
+# The initial ensemble can come from a single- or multi-instance reference case.
+#
+# -- DOCN: The compsets required by this script use a single data ocean.
+#
+# -- Run this script. When it is executed, it will create:
+# 1) a CESM 'CASE' ($caseroot) directory, where the model will be built,
+# 2) a run directory, where each forecast + assimilation cycle will take place,
+# 3) a bld directory for the executables.
+# 4) CESM's short term archiver (st_archive) will use a fourth directory for
+# storage of model output until it can be moved to long term storage (HPSS)
+#
+# -- Confirm the variable values in $caseroot/env_{build,run,batch,...}.xml.
+#
+# -- (if running filter) Edit the DART input.nml that appears in the ${caseroot}
+# directory to replace default values with your preferred values.
+#
+# -- Submit the job using ${caseroot}/case.submit -M begin,end
+#
+# ---------------------
+# Important features
+# ---------------------
+#
+# If you want to change something in your case other than the runtime settings,
+# it is safest to delete everything and create the case from scratch.
+# For the brave, read
+#
+# https://ncar.github.io/CAM/doc/build/html/users_guide/index.html
+# --> https://ncar.github.io/CAM/doc/build/html/users_guide/building-and-running-cam.html
+# --> http://esmci.github.io/cime/users_guide/building-a-case.html
+#
+#*******************************************************************************
+
+# ==============================================================================
+# case options:
+#
+# case The value of "case" will be used many ways; directory and file
+# names both locally and on HPSS, and script names; so consider
+# its length and information content.
+# compset Selects the CESM model components, vertical resolution, and physics packages.
+# Must be a CAM-FV "F" compset, either supported, or use the
+# --run-unsupported option.
+# Don't expect all CESM-supported compsets to work with DART.
+# For example, an active land ice model requires the NOLEAP calendar
+# (as of 2018-6), while DART requires GREGORIAN. But there's no need
+# for active land ice in atmospheric assimilations.
+# A compset defined specifically for CAM assimilations is
+# FHIST_DARTC6 = HIST_CAM60_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV
+# For a list of the pre-defined component sets:
+# > $CIMEROOT/scripts/create_newcase -list
+# To create a variant compset, see the CESM documentation
+# https://ncar.github.io/CAM/doc/build/html/users_guide/atmospheric-configurations.html
+# and carefully incorporate any needed changes into this script.
+# resolution Defines the horizontal resolution and dynamical core;
+# see http://esmci.github.io/cime/users_guide/grids.html.
+# f19_f19 ... FV core at ~ 2 degree (19 means 1.9 degrees of latitude).
+# f09_f09 ... FV core at ~ 1 degree (the 2nd f09 means CLM uses a .9 degree latitude grid)
+# cesmtag The version of the CESM source code to use when building the model.
+# The assimilate.csh in this directory will handle only cesm2_0 and later.
+# num_instances The number of ensemble members.
+#
+# ==============================================================================
+
+setenv case Test0
+setenv compset HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+# setenv compset FHIST_DARTC6
+setenv resolution f19_f19
+setenv cesmtag cesm2_0
+setenv num_instances 3
+
+# If cemstag >= cesm2_0_alpha10f and compset = FHIST_DARTC6 (or another non-supported):
+setenv compset_args "--compset $compset"
+setenv compset_args "${compset_args} --run-unsupported"
+
+# ==============================================================================
+# machines and directories:
+#
+# mach Computer name
+# cesmdata Location of some supporting CESM data files.
+# cesmroot Location of the CESM code base. This version of the script
+# only supports version cesm2_0 or later, which is available from
+# https://github.com/ESCOMP/cesm.
+# sourcemods DART no longer requires a SourceMods directory in order to work with CESM.
+# If you have modifications to CESM, they should be provided in a
+# CESM-structured SourceMods directory, which this script expects to be in
+# $user/$cesmtag/SourceMods.
+# caseroot The CESM $CASEROOT directory, where the CESM+DART configuration files
+# will be stored and the build commands will be executed.
+# This should probably not be in scratch.
+# This script will delete an existing caseroot with the same name,
+# so this script and other things you want to preserve should be kept elsewhere.
+# dartroot Location of the root of _your_ DART installation.
+# cime_output $cime_root/$CASEROOT is the directory where CESM's build and run directories will be created.
+# Large amount of space needed, generally on a scratch partition.
+# CESM will define the following variables:
+# RUNDIR: The CESM run directory. Needs large amounts of disk.
+# Default; $CIME_OUTPUT_ROOT/$CASE/run
+# EXEROOT: The CESM executable directory.
+# Default; $CIME_OUTPUT_ROOT/$CASE/bld
+# DOUT_S_ROOT: The CESM short-term archive directory.
+# LARGE amount of disk.
+# Files remain here until you move them or they are purged.
+# Default; $CIME_OUTPUT_ROOT/archive/$CASE.
+# DART's preference is to define the archive directory to be;
+# $CIME_OUTPUT_ROOT/$CASE/archive
+# This change of DOUT_S_ROOT may interfere with the ability to clone your case.
+#
+# archdir The CESM short-term archive directory.
+# Files will remain here until you move them to permanent storage
+# (or are purged).
+# baseobsdir Part of the directory name containing the obs_seq.out files to be used by the
+# assimilation. Assimilate.csh looks for a directory with the year and month:
+# $baseobsdir/YYYYMM_6H_CESM.
+# Will be inserted into DART_config and assimilate.csh.
+# ==============================================================================
+
+setenv mach cheyenne
+setenv cesmdata /glade/p/cesm/cseg/inputdata
+setenv cesmroot /glade/work/${USER}/Models/${cesmtag}
+setenv sourcemods ~/${cesmtag}/SourceMods
+setenv caseroot /glade/work/${USER}/Exp/${case}
+setenv dartroot /glade/u/home/${USER}/DART/rma_recam
+
+setenv cime_output /glade/scratch/${USER}
+setenv archdir ${cime_output}/${case}/archive
+
+setenv baseobsdir /glade/p/cisl/dares/Observations/NCEP+ACARS+GPS
+
+# ==============================================================================
+# Initial conditions files:
+#
+# refcase The name of the existing reference case that this run will
+# start from.
+#
+# refyear The specific date/time-of-day in the reference case that this
+# refmon run will start from. (Also see 'runtime settings' below for
+# refday start_year, start_mon, start_day and start_tod.)
+# reftod
+# NOTE: all the ref* variables must be treated like strings and have
+# the appropriate number of preceeding zeros
+#
+# stagedir The directory location of the reference case files.
+# ==============================================================================
+
+setenv refcase A_case_having_CAM_initial+all_restart_files
+setenv refyear 2013
+setenv refmon 08
+setenv refday 01
+setenv reftod 00000
+
+# useful combinations of time that we use below
+setenv refdate $refyear-$refmon-$refday
+setenv reftimestamp $refyear-$refmon-$refday-$reftod
+
+# setenv stagedir /glade/p/cisl/dares/CESM_initial_ensemble/rest/${reftimestamp}
+# Alternative reference case for different dates, cases, etc. may be kept in places like:
+# setenv stagedir /glade/scratch/${USER}/${refcase}/run
+# setenv stagedir /glade/scratch/${USER}/${refcase}/archive/rest/${reftimestamp}
+setenv stagedir /glade/work/${USER}/Models/CAM_init/FV1deg_cesm2_1/${reftimestamp}
+# or on the HPSS:
+# /CCSM/dart/FV0.9x1.25x30_cesm1_1_1/{Mon}1 for 1-degree FV ensembles
+
+# ==============================================================================
+# runtime settings:
+# This script will find usable CAM external forcing files for years 19mumble-2015.
+# Years after that (or before) may require searching $cesmdata for more
+# up-to-date files and adding them to the user_nl_cam_#### in the code below.
+# You might find them in setup_advanced.
+# If you use them, change the year in the user_nl_cam section.
+#
+# start_year generally this is the same as the reference case date, but it can
+# start_month be different if you want to start this run as if it was a different time.
+# start_day
+# start_tod
+# stop_option Units for determining the forecast length between assimilations
+# stop_n Number of time units in each forecast
+# short_term_archiver Copies the files from each job step to a 'rest' directory.
+# ==============================================================================
+
+setenv start_year 2009
+setenv start_month 08
+setenv start_day 02
+setenv start_tod 00000
+setenv stop_option nhours
+setenv stop_n 6
+setenv short_term_archiver off
+
+# ==============================================================================
+# configure settings:
+
+# Configure needs to know the location of the CIME directory.
+# An environment variable is easier to specify than the command line argument.
+setenv CIMEROOT $cesmroot/cime
+
+# The tasks/node and threads/task we will use,
+# to be used by --pecount arg to create_namelist.
+# In cases where there are few observations but a large memory requirement,
+# it may be more efficient for DART to use fewer MPI tasks/node
+# than the number of available processors/node.
+# But that would restrict CAM to using fewer MPI tasks per node.
+# That can be compensated by telling CAM to use >1 (OpenMP) threads per node.
+# E.g. change from 36 tasks x 1 thread to 12 tasks x 3 threads.
+
+set use_tasks_per_node = 36
+set nthreads = 1
+
+# The default CAM sea surface temperature file is climatological,
+# which is less than ideal for atmospheric assimilations.
+# The supported alternative is time interpolation of a monthly SST+CICE data set.
+# Examples are provided here.
+# "2 degree":
+setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2016_c170525.nc
+setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv1.9x2.5_gx1v7.170518.nc
+# "1 degree":
+# setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2016_c170525.nc
+# setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc
+# Specify the beginning and ending years of the data set.
+setenv sst_year_start 1850
+setenv sst_year_end 2016
+
+
+# ==============================================================================
+# job settings:
+#
+# PROJECT CESM2 preferred name for account used to charge core hours.
+# Using setenv makes it available to utils/python/CIME/case.py/get_project
+# queue can be changed during a series by changing the case.run
+# timewall can be changed during a series by changing the case.run
+# ==============================================================================
+
+setenv PROJECT your_account_there
+setenv queue queue_for_assimilation_jobs
+setenv timewall 1:00
+
+# ==============================================================================
+# standard commands:
+#
+# Make sure that this script is using standard system commands
+# instead of aliases defined by the user.
+# If the standard commands are not in the location listed below,
+# change the 'set' commands to use them.
+# The verbose (-v) argument has been separated from these command definitions
+# because these commands may not accept it on some systems. On those systems
+# set VERBOSE = ''
+# ==============================================================================
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+set VERBOSE = '-v'
+set MOVE = '/usr/bin/mv'
+set COPY = '/usr/bin/cp --preserve=timestamps'
+set LINK = '/usr/bin/ln -s'
+set LIST = '/usr/bin/ls'
+set REMOVE = '/usr/bin/rm'
+
+# ==============================================================================
+# ==============================================================================
+# by setting the values above you should be able to execute this script and
+# have it run. however, for running a real experiment there are still many
+# settings below this point - e.g. component namelists, history file options,
+# the processor layout, xml file options, etc - that you will almost certainly
+# want to change before doing a real science run.
+# ==============================================================================
+# ==============================================================================
+
+if ($?LS_SUBCWD) then
+ cd $LS_SUBCWD
+else if ($?PBS_O_WORKDIR) then
+ cd $PBS_O_WORKDIR
+endif
+
+# Store the location of these setup scripts for use in DART_config.
+set DART_CESM_scripts = `pwd`
+
+# ==============================================================================
+# Make sure the CESM directories exist.
+# VAR is the shell variable name, DIR is the value
+# ==============================================================================
+
+foreach VAR ( cesmroot dartroot stagedir )
+ set DIR = `eval echo \${$VAR}`
+ if ( ! -d $DIR ) then
+ echo "ERROR: directory '$DIR' not found"
+ echo " In the setup script check the setting of: $VAR "
+ exit 10
+ endif
+end
+
+# ==============================================================================
+# Create the case - this (re)creates the caseroot directory.
+# ==============================================================================
+
+# Fatal idea to make caseroot the same dir as where this setup script is
+# since the build process removes all files in the caseroot dir before
+# populating it. Try to prevent shooting yourself in the foot.
+
+if ( $caseroot == `pwd` ) then
+ echo "ERROR: the setup script should not be located in the caseroot"
+ echo "directory, because all files in the caseroot dir will be removed"
+ echo "before creating the new case. move the script to a safer place."
+ exit 11
+endif
+
+# Also don't recreate this case if you've archived any CAM output
+# in the existing case's archive directory.
+set old_files = ()
+if (-d $archdir/esp/hist) set old_files = `ls $archdir/esp/hist`
+if ($#old_files == 0) then
+ echo "removing old directory ${caseroot}"
+ echo "removing old directory ${cime_output}/${case}/bld"
+ echo "removing old directory ${cime_output}/${case}/run"
+ ${REMOVE} -fr ${caseroot}
+ ${REMOVE} -fr ${cime_output}/${case}/bld
+ ${REMOVE} -fr ${cime_output}/${case}/run
+else
+ echo "There are DART output files in $archdir/esp/hist."
+ echo "Either rename the case you are building, or delete the files and rebuild this case"
+ exit 12
+endif
+
+# This will override the value that may be set in your ~/.cime/config.
+setenv CIME_MODEL cesm
+
+# Record which CIME is being used.
+cd ${CIMEROOT}
+echo "\n Using the starred branch, below, of $CIMEROOT "
+git branch | grep '*'
+echo " "
+cd -
+
+# Record which CAM is being used.
+cd ${CIMEROOT}/../components/cam
+echo "n Using CAM version"
+head -n 5 doc/ChangeLog | tail -n 3
+echo "svn status -u:"
+svn status -u
+echo " "
+cd -
+
+# The ensemble CAM forecast is much more efficient for typical ensemble sizes (>40)
+# when the multi-driver capability is used. It may be less efficient for sizes < 10.
+setenv num_drivers $num_instances
+set multi_driver = ' '
+if ($num_drivers > 1) set multi_driver = ' --multi-driver '
+
+${CIMEROOT}/scripts/create_newcase \
+ --case $caseroot \
+ --machine $mach \
+ --res $resolution \
+ --project $PROJECT \
+ --queue $queue \
+ --walltime $timewall \
+ --pecount ${use_tasks_per_node}x${nthreads} \
+ --ninst $num_instances \
+ $compset_args \
+ $multi_driver
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be created."
+ exit 15
+endif
+
+# Preserve a copy of this script as it was run.
+# If submitted interactively or with 'qcmd', this is easy.
+# If submitted as a batch job, the jobname and this script name
+# must be identical.
+
+if ($?LSB_JOBNAME) then
+ setenv setup_file_name $LSB_JOBNAME
+else if ($?PBS_JOBNAME) then
+ if ($PBS_JOBNAME == run/.qcmd) then
+ setenv setup_file_name $0:t
+ else
+ setenv setup_file_name $PBS_JOBNAME
+ endif
+else
+ setenv setup_file_name $0:t
+endif
+${COPY} -f ${VERBOSE} $setup_file_name ${caseroot}/${setup_file_name}.original || exit 30
+
+# ==============================================================================
+# Configure the case.
+# ==============================================================================
+
+cd ${caseroot}
+
+# Save a copy of the original configuration for debug purposes
+
+foreach FILE ( *xml )
+ if ( ! -e ${FILE}.original ) then
+ ${COPY} -f ${FILE} ${FILE}.original || exit 35
+ endif
+end
+
+# Get a bunch of environment variables.
+# If any of these are changed by xmlchange calls in this program,
+# then they must be explicitly changed with setenv calls too.
+# $COMPSET is the long name which CESM uses, and is derived from $compset.
+# $compset is set by the user and may be an alias/short name.
+
+setenv COMPSET `./xmlquery COMPSET --value`
+setenv COMP_OCN `./xmlquery COMP_OCN --value`
+setenv COMP_GLC `./xmlquery COMP_GLC --value`
+setenv COMP_ROF `./xmlquery COMP_ROF --value`
+setenv CIMEROOT `./xmlquery CIMEROOT --value`
+setenv EXEROOT `./xmlquery EXEROOT --value`
+setenv RUNDIR `./xmlquery RUNDIR --value`
+setenv CAM_CONFIG_OPTS `./xmlquery CAM_CONFIG_OPTS --value`
+
+set max_tasks_per_node = `./xmlquery MAX_TASKS_PER_NODE --value`
+set max_mpitasks_per_node = `./xmlquery MAX_MPITASKS_PER_NODE --value`
+
+echo "From create_newcase, settings related to TASKS = ..."
+./xmlquery --partial TASK
+
+
+# Make sure the case is configured with a data ocean.
+
+if ( ${COMP_OCN} != docn ) then
+ echo " "
+ echo "ERROR: This setup script is not appropriate for active ocean compsets."
+ echo "ERROR: Please use the models/CESM/shell_scripts examples for that case."
+ echo " "
+ exit 40
+endif
+
+# Extract pieces of the COMPSET for choosing correct setup parameters.
+# E.g. "AMIP_CAM5_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM1%NOEVOLVE_SWAV"
+set comp_list = `echo $COMPSET | sed -e "s/_/ /g"`
+# Debug
+echo "compset parts are $comp_list"
+
+# Land ice, aka glacier, aka glc.
+
+if (${COMP_GLC} == sglc) then
+ set CISM_RESTART = FALSE
+else
+ echo "ERROR: glacier compset is ${COMP_GLC}, which is not supported by this script."
+ echo "ERROR: The only supported glacier compset is 'SGLC'"
+ exit 45
+ # In the future, if CISM can use the GREGORIAN calandar, and evolving land ice is
+ # deemed to be useful for atmospheric assimilations, this may still be required
+ # to make CISM write out restart files 4x/day.
+ ./xmlchange GLC_NCPL=4
+endif
+
+# The river transport model ON is useful only when using an active ocean or
+# land surface diagnostics. If you turn it ON, you will have to stage initial files etc.
+# There are 3 choices:
+# > a stub version (best for CAM+DART),
+# > the older River Transport Model (RTM),
+# > the new Model for Scale Adaptive River Transport (MOSART).
+# They are separate CESM components, and are/need to be specified in the compset.
+# It may be that RTM or MOSART can be turned off via namelists.
+# Specify the river runoff model: 'RTM', 'MOSART', or anything else.
+
+if (${COMP_ROF} == 'rtm') then
+ ./xmlchange ROF_GRID='r05'
+else if (${COMP_ROF} == 'mosart') then
+ # There seems to be no MOSART_MODE, but there are some MOSART_ xml variables.
+ # Use defaults for now
+ ./xmlchange ROF_GRID='r05'
+else if (${COMP_ROF} == 'drof') then
+ ./xmlchange ROF_GRID='null'
+else if (${COMP_ROF} == 'srof') then
+ ./xmlchange ROF_GRID='null'
+else
+ echo "river_runoff is ${COMP_ROF}, which is not supported"
+ exit 50
+endif
+
+# Need to know if we are using WACCM (aka WCCM or WXIE) for several reasons.
+# CESM2; maybe not needed anymore?
+# Mostly file management issues.
+# WARNING: Check your $COMPSET to see whether the grep pattern below will detect your WACCM ! !
+
+setenv waccm false
+set atm = `echo $comp_list[2] | sed -e "s#%# #"`
+if ($#atm > 1) then
+ echo $atm[2] | grep WC
+ if ($status == 0) setenv waccm true
+endif
+
+# NOTE: If you require bit-for-bit agreement between different runs,
+# in particular, between pmo (single instance) and assimilations (NINST > 1),
+# or if you need to change the number of nodes/member due to changing memory needs,
+# then env_run.xml:BFBFLAG must be set to TRUE, so that the coupler will
+# generate bit-for-bit identical results, regardless of the number of tasks
+# given to it. The time penalty appears to be ~ 0.5% in the forecast.
+# Alternatively, you can set NTASKS_CPL = same_number in both experiments
+
+# Task layout:
+# Set the nodes_per_instance below to the smallest number that will
+# let CAM run without memory problems. If you get 'out of memory'
+# errors OR failures without any messages, try increasing the nodes_per_instance.
+# Cheyenne has 46 Gb/node of usable memory. A 1 degree CAM6 works well with
+# 3 nodes/instance. A 2 degree works with 2 nodes/instance.
+# By computing task counts like we do below, we guarantee each instance uses
+# a whole number of nodes which is the recommended configuration.
+
+# There's no speed up by running non-active (data and stub) components concurrently,
+# after ATM has run, so just run all components sequentially.
+# BUT, do arrange it so that each member(instance) spans complete nodes:
+# modulo(total pe count / number of instances, use_tasks_per_node) == 0.
+# It seems odd to give so many processors to non-active components,
+# but that works best with the multi-driver option.
+
+# Multi-driver runs need to be told the number of tasks PER INSTANCE,
+# which will be multiplied up to give the total number tasks needed by the job.
+# If you choose to build a single driver case, multiply ntasks_active by
+# the $num_instances. CESM will then divide the tasks among the instances.
+# For large ensembles, this will double your computational cost.
+
+# Task layout:
+# Set the nodes_per_instance below to match your case.
+# By computing task counts like we do below, we guarantee each instance uses
+# a whole number of nodes which is the recommended configuration.
+#
+# CIME interprets a negative task count as representing the number of nodes.
+# On Cheyenne (at least) using multiple threads is not recommended.
+
+@ nodes_per_instance = 3
+@ ntasks_active = -1 * $nodes_per_instance
+@ ntasks_data = -1
+
+./xmlchange ROOTPE_ATM=0,NTHRDS_ATM=$nthreads,NTASKS_ATM=$ntasks_active
+./xmlchange ROOTPE_LND=0,NTHRDS_LND=$nthreads,NTASKS_LND=$ntasks_active
+./xmlchange ROOTPE_ICE=0,NTHRDS_ICE=$nthreads,NTASKS_ICE=$ntasks_active
+./xmlchange ROOTPE_ROF=0,NTHRDS_ROF=$nthreads,NTASKS_ROF=$ntasks_active
+./xmlchange ROOTPE_OCN=0,NTHRDS_OCN=$nthreads,NTASKS_OCN=$ntasks_active
+./xmlchange ROOTPE_GLC=0,NTHRDS_GLC=$nthreads,NTASKS_GLC=$ntasks_active
+./xmlchange ROOTPE_WAV=0,NTHRDS_WAV=$nthreads,NTASKS_WAV=$ntasks_active
+./xmlchange ROOTPE_CPL=0,NTHRDS_CPL=$nthreads,NTASKS_CPL=$ntasks_active
+./xmlchange ROOTPE_ESP=0,NTHRDS_ESP=$nthreads,NTASKS_ESP=$ntasks_data
+
+# A hybrid run is initialized like a startup but it allows users to bring together
+# combinations of initial/restart files from a previous case (specified by $RUN_REFCASE)
+# at a user-chosen, model output date (specified by $RUN_REFDATE).
+# The starting date of a hybrid run (specified by $RUN_STARTDATE) can be different
+# from $RUN_REFDATE.
+# There is a bit more complexity; DART only uses CAM _initial_ files, not _restart_ files,
+# so CAM will read initial files - even when CONTINUE_RUN = TRUE - # for cycles 2,... .
+# For more description of hybrid mode, see:
+# http://esmci.github.io/cime/users_guide/running-a-case.html?highlight=hybrid
+
+echo "After xmlchanges for ROOTPEs ..."
+
+./xmlquery --partial TASK
+./xmlquery --partial CIME_OUT
+./xmlquery --partial RUNDIR
+./xmlquery --partial EXEROOT
+./xmlquery --partial DOUT
+
+./xmlchange RUN_TYPE=hybrid
+./xmlchange RUN_STARTDATE=${start_year}-${start_month}-${start_day}
+./xmlchange START_TOD=$start_tod
+./xmlchange RUN_REFCASE=$refcase
+./xmlchange RUN_REFDATE=$refdate
+./xmlchange RUN_REFTOD=$reftod
+./xmlchange GET_REFCASE=FALSE
+
+./xmlchange CIME_OUTPUT_ROOT=${cime_output}
+
+./xmlchange SSTICE_DATA_FILENAME=$sst_dataset
+./xmlchange SSTICE_GRID_FILENAME=$sst_grid
+./xmlchange SSTICE_YEAR_ALIGN=$sst_year_start
+./xmlchange SSTICE_YEAR_START=$sst_year_start
+./xmlchange SSTICE_YEAR_END=$sst_year_end
+
+# Do not change the CALENDAR or the value of CONTINUE_RUN in this script.
+# Even if it's a branch from another run, where all restarts, etc. are available,
+# it still needs to change case/file names for this new case.
+
+./xmlchange CALENDAR=GREGORIAN
+./xmlchange CONTINUE_RUN=FALSE
+
+./xmlchange STOP_OPTION=$stop_option
+./xmlchange STOP_N=$stop_n
+
+# How many jobs (not cycles per job) to run after the first,
+# each of which will do DATA_ASSIMILATION_CYCLES cycles.
+# Set to 0 for the setup of the case, and the first cycle because
+# env_run.xml and input.nml will/may need to be changed between cycle 1 and 2
+# (and you really should confirm that the assimilation worked).
+
+./xmlchange RESUBMIT=0
+
+./xmlchange PIO_TYPENAME=pnetcdf
+
+# COUPLING discussion. F compsets are 'tight' coupling.
+# Only change the ATM_NCPL ... everything is based on this one value,
+# including CAM physics and dynamics timesteps.
+# Default values for coupling are preserved in env_run.xml.original
+
+./xmlchange NCPL_BASE_PERIOD=day
+./xmlchange ATM_NCPL=48
+
+# Sometimes we need to remove some bit of physics from a compset.
+# One example was that the CLM irrigation setting needed to be removed
+# from builds which are not CAM4. This was fixed in later CESMs,
+# but here's an example of how to do it.
+# echo $CAM_CONFIG_OPTS | grep 'cam4'
+# if ($status != 0) then
+# setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+# set clm_opts = `echo $CLM_BLDNML_OPTS | sed -e "s#-irrig=.true.##"`
+# ./xmlchange CLM_BLDNML_OPTS="$clm_opts"
+# # DEBUG/confirm
+# setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+# echo "CLM_BLDNML_OPTS has been changed to $CLM_BLDNML_OPTS"
+# endif
+
+# Or, if you know the description of the physics you need, just set it (then test it!)
+# setenv CAM_CONFIG_OPTS "-user_knows_better"
+# ./xmlchange CAM_CONFIG_OPTS=$CAM_CONFIG_OPTS
+
+if ($short_term_archiver == 'off') then
+ ./xmlchange DOUT_S=FALSE
+else
+ ./xmlchange DOUT_S=TRUE
+endif
+./xmlchange DOUT_S_ROOT=${archdir}
+
+# DEBUG = TRUE implies turning on run and compile time debugging.
+# INFO_DBUG level of debug output, 0=minimum, 1=normal, 2=more, 3=too much.
+./xmlchange DEBUG=FALSE
+./xmlchange INFO_DBUG=0
+
+# ==============================================================================
+# Update source files.
+# DART does not require any modifications to the model source.
+# ==============================================================================
+
+# Import your SourceMods, if you have any. DART doesn't have any of its own.
+if (-d ${sourcemods} ) then
+ echo ' '
+ ${COPY} -r ${VERBOSE} ${sourcemods}/* ${caseroot}/SourceMods/ || exit 62
+ echo ' '
+ echo ' '
+else
+ echo "No SourceMods for this case."
+endif
+
+# components/mosart/cime_config/buildnml:line 108:
+# $RUNDIR/${RUN_REFCASE}.{clm2,mosart}${inst_string}.r.${RUN_REFDATE}-${RUN_REFTOD}.nc
+# don't exist. That's because case.setup creates $RUNDIR and then calls the buildnml routines.
+# stage_cesm_files needs $RUNDIR to exist before it can make files there. Those files are
+# the ones buildnml checks. It's not fatal, just annoying warnings "WARNING:: mosart.buildnml . . .".
+# "Fix" by setting RUN_REFDIR to $stagedir.
+
+./xmlchange RUN_REFDIR=$stagedir
+
+# ==============================================================================
+# Set up the case.
+# This creates the EXEROOT and RUNDIR directories.
+# ==============================================================================
+
+echo 'Setting up the case ...'
+echo 'Ignore "WARNING:: mosart.buildnml . . .". Those files will be provided later'
+
+echo 'Before case.setup, modules are'
+source /etc/profile.d/modules.csh
+module list
+
+./case.setup
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be set up."
+ exit 70
+endif
+
+# ==============================================================================
+# ==============================================================================
+
+# Define how often sets of restart files will be archived,
+# in order to conserve disk space during a multi-cycle job.
+setenv save_every_Mth_day_restart 3
+
+# Fill the DART_config script with information it needs and copy it to caseroot.
+# DART_config can be run at some later date if desired, but it must be run
+# from a caseroot directory.
+if ( -e ${DART_CESM_scripts}/DART_config.template ) then
+ sed -e "s#your_dart_path#${dartroot}#" \
+ -e "s#your_setup_script_dir#$DART_CESM_scripts:t#" \
+ -e "s#your_observation_path#${baseobsdir}#" \
+ -e "s#days_between_archiving_restarts#${save_every_Mth_day_restart}#" \
+ < ${DART_CESM_scripts}/DART_config.template \
+ >! DART_config || exit 20
+else
+ echo "ERROR: the script to configure for data assimilation is not available."
+ echo " DART_config.template MUST be in $DART_CESM_scripts "
+ exit 22
+endif
+
+
+# ==============================================================================
+# Edit scripts to reflect queue and wallclock
+# ==============================================================================
+
+# The new case.st_archive job script calls st_archive. It runs after the case.run job.
+# It submits the next case.run job, if RESUBMIT > 0.
+# Fix some pieces.
+# /X/ means search for lines with X in them.
+# 'c' means replace the line with the following.
+# 'a' means append after the current line.
+# In addition, env_batch.xml has a section we want to change, which xmlchange can't do.
+# Make st_archive run on 1 processor ( 'select' for pbs, 'ptile' for lsf).
+
+if ($?LSB_JOBNAME) then
+ sed -e "/BSUB[ ]*-o/c\#BSUB -o cesm_st_arch.stdout.%J" \
+ -e "/BSUB[ ]*-e/c\#BSUB -e cesm_st_arch.stderr.%J" \
+ -e "/BSUB[ ]*-J/c\#BSUB -J ${case}.st_arch" \
+ -e '/ptile/c/#BSUB -R "span[ptile=1]"' \
+ case.st_archive >! temp.$$ || exit 55
+ ${MOVE} temp.$$ case.st_archive
+ ./xmlchange --subgroup case.st_archive --id JOB_QUEUE --val share
+
+else if ($?PBS_JOBNAME) then
+ # It would be nice to put the $PBS_JOBID value into the job name and st err/out file names,
+ # but "environment variables are not resolved when they're in the #PBS directives",
+ # despite their use in the default job and st.err/out file names.
+ sed -e "/\-l select/c\#PBS -l select=1:ncpus=1:mpiprocs=1:ompthreads=1" \
+ -e "/\-N /c\#PBS -N ${case}.st_arch" \
+ -e "/\-N /a\#PBS -o ./${case}.st_arch.stdouterr" \
+ case.st_archive >! temp.$$ || exit 55
+ ${MOVE} temp.$$ case.st_archive
+ ./xmlchange --subgroup case.st_archive --id JOB_QUEUE --val share
+
+endif
+chmod 755 case.st_archive
+
+./xmlchange --subgroup case.st_archive --id JOB_WALLCLOCK_TIME --val 1:00
+
+# ==============================================================================
+# Modify namelist templates for each instance.
+#
+# In a hybrid run with CONTINUE_RUN = FALSE (i.e. just starting up):
+# CAM has been forced to read initial files - specified by namelist var:ncdata.
+# CICE reads from namelist variable 'ice_ic'.
+# CLM builds its own 'finidat' value from the REFCASE variables,
+# or the output from the interpolation is assigned to finidat in this namelist.
+#
+# When CONTINUE_RUN = TRUE, CICE and CLM get restart file names from pointer files.
+#
+# All of these must later on be staged with these same filenames.
+# ==============================================================================
+
+# Decide whether interpolation of the CLM restart file will be done.
+# If so, each CLM namelist needs it's own finidat_interp_dest.
+set do_clm_interp = "true"
+
+@ inst = 1
+while ($inst <= $num_instances)
+
+ # following the CESM strategy for 'inst_string'
+ set inst_string = `printf _%04d $inst`
+
+ # ===========================================================================
+ set fname = "user_nl_cam${inst_string}"
+ # ===========================================================================
+ # ATM Namelist
+
+ # DART/CAM requires surface geopotential (PHIS) for calculation of
+ # column pressures. It's convenient to write it to the .h0. every
+ # assimilation time. If you want to write it to a different .h?. file, you MUST
+ # modify the assimilate.csh script in several places. You will need to set
+ # 'empty_htapes = .false.' and change 'nhtfrq' and 'mfilt' to get a CAM
+ # default-looking .h0. file.
+ # If you want other fields written to history files, use h1,...,
+ # which are not purged by assimilate.csh.
+ #
+ # inithist 'ENDOFRUN' ensures that CAM writes the required initial file
+ # every time it stops.
+ # mfilt # of times/history file. Default values are 1,30,30,.....
+
+ echo " inithist = 'ENDOFRUN'" >> ${fname}
+ echo " ncdata = 'cam_initial${inst_string}.nc'" >> ${fname}
+ echo " empty_htapes = .true. " >> ${fname}
+ echo " fincl1 = 'PHIS:I' " >> ${fname}
+ echo " nhtfrq = -$stop_n " >> ${fname}
+ # echo " mfilt = 1 " >> ${fname}
+
+ echo $CAM_CONFIG_OPTS | grep 'cam4'
+ if ($status == 0) echo " fv_div24del2_flag = 4 " >> ${fname}
+
+ # Settings that differ between regular CAM and the WACCM version:
+
+
+ # CAM forcing files.
+ # Some of the files specified here are because the default files only
+ # contain data through 2005 or 2010 and we are interested in time frames after that.
+
+ # set chem_datapath = "${cesmdata}/atm/cam/chem/trop_mozart_aero"
+
+ if ($inst == 1) then
+ if ($start_year > 2015) then
+ echo "ERROR; the default external forcing files end with year 2015."
+ echo " Use an earlier year, "
+ echo " or locate non-default forcing files for your year (in setup_advanced?)."
+ exit 65
+ else
+ echo 'WARNING; using default ozone and tracer_cnst forcing files'
+ echo 'WARNING; using default srf_emis_* and ext_frc_*'
+ echo "WARNING; using default bndtvghg"
+ echo "WARNING; using default volcaero"
+ endif
+ endif
+
+ if ($start_year > 2008) then
+ # The default as of April 2015 is
+ # /glade/p/cesmdata/cseg/inputdata/atm/cam/solar/SOLAR_SPECTRAL_Lean_1610-2008_annual_c090324.nc
+ # For later dates there are files which repeat the solar cycles from 1960-2008
+ # in order to create a time series out to 2140:
+ # .../spectral_irradiance_Lean_1610-2140_ann_c100408.nc
+ # This does not look like an exact extension of the default,
+ # but does look like the previous default. So try it.
+
+ echo " solar_data_file = '${cesmdata}/atm/cam/solar/spectral_irradiance_Lean_1610-2140_ann_c100408.nc'" >> ${fname}
+ endif
+
+ # ===========================================================================
+ set fname = "user_nl_clm${inst_string}"
+ # ===========================================================================
+ # LAND Namelist
+ # With a RUN_TYPE=hybrid the finidat is automatically specified
+ # using the REFCASE, REFDATE, and REFTOD information. i.e.
+ # finidat = ${stagedir}/${refcase}.clm2${inst_string}.r.${reftimestamp}.nc
+ #
+ # Making a (compact) .h0. file is a good idea, since the clm restart files
+ # do not have all the metadata required to reconstruct a gridded field.
+ # 'TSA' is 2m surface air temperature. This also prevents
+ # having truly empty history files, resulting in ntapes = 0,
+ # which prevents the hybrid-mode model from restarting.
+ # CESM2_0 and, or, CLM5: is that still true?
+ #
+ echo "hist_empty_htapes = .true." >> ${fname}
+ echo "hist_fincl1 = 'TSA'" >> ${fname}
+ echo "hist_nhtfrq = -$stop_n" >> ${fname}
+ echo "hist_mfilt = 1" >> ${fname}
+ echo "hist_avgflag_pertape = 'I'" >> ${fname}
+
+ # This was needed to allow the interpolation of the default CLM restart file.
+ # It is needed in runs that start from a somewhat spun up ensemble.
+
+ if ($do_clm_interp == "true") then
+ echo "use_init_interp = .true. " >> ${fname}
+ echo "init_interp_fill_missing_with_natveg = .true." >> ${fname}
+ endif
+
+ # but we don't particularly want or need methane
+ echo "use_lch4 = .false." >> ${fname}
+
+# echo "check_finidat_year_consistency = .false." >> ${fname}
+# echo "urban_hac = 'OFF'" >> ${fname}
+# echo "building_temp_method = 0 " >> ${fname}
+
+ # ===========================================================================
+ set fname = "user_nl_cice${inst_string}"
+ # ===========================================================================
+ # CICE Namelist
+
+ echo $CAM_CONFIG_OPTS | grep 'cam4'
+ if ($status == 0) then
+ # CAM4:
+ echo "ice_ic = 'default'" >> ${fname}
+ else
+ # CAM5, 6, ...:
+ echo "ice_ic = '${refcase}.cice${inst_string}.r.${reftimestamp}.nc'" >> ${fname}
+ endif
+
+ @ inst ++
+
+end
+
+# ===========================================================================
+# set fname = "user_nl_cpl"
+# ===========================================================================
+# DRV or CPL Namelist
+# For some reason, a single user_nl_cpl works even when --multi-driver is used.
+
+./preview_namelists || exit 75
+
+# ==============================================================================
+# Stage the restarts now that the run directory exists.
+# Create a script to do this since it may be needed to recover or restart.
+# Create the script and then run it here.
+# ==============================================================================
+
+set init_time = ${reftimestamp}
+
+cat << EndOfText >! stage_cesm_files
+#!/bin/csh -f
+# This script can be used to help restart an experiment from any previous step.
+# The appropriate files are copied to the RUN directory.
+#
+# Before running this script:
+# 1) be sure CONTINUE_RUN is set correctly in the env_run.xml file in
+# your caseroot directory.
+# CONTINUE_RUN=FALSE => you are starting over at the initial time.
+# CONTINUE_RUN=TRUE => you are starting from a previous step but not
+# the very first one.
+# 2) be sure 'restart_time' is set to the day and time from which you want to
+# restart, if not the initial time.
+
+set restart_time = $init_time
+
+# ---------------------------------------------------------
+# Get the settings for this case from the CESM environment
+# ---------------------------------------------------------
+cd ${caseroot}
+setenv RUNDIR \`./xmlquery RUNDIR --value\`
+setenv CONTINUE_RUN \`./xmlquery CONTINUE_RUN --value\`
+
+ls \$RUNDIR/*.i.\${restart_time}.nc
+if (\$status == 0) then
+ # The restart set exists in the RUNDIR, regardless of the short term archiver.
+ setenv DOUT_S FALSE
+else
+ set hide_loc = \`ls \$RUNDIR:h/Hide*/*_0001.i.\${restart_time}.nc\`
+ if (\$status == 0) then
+ # The restart set exists in a Hide directory, regardless of the short term archiver.
+ setenv DOUT_S FALSE
+ mv \$hide_loc:h/* \${RUNDIR}
+ else
+ setenv DOUT_S \`./xmlquery DOUT_S --value\`
+ setenv DOUT_S_ROOT \`./xmlquery DOUT_S_ROOT --value\`
+ endif
+endif
+
+# ---------------------------------------------------------
+
+cd \${RUNDIR}
+
+echo 'Copying the required CESM files to the run directory to rerun a previous step. '
+echo 'CONTINUE_RUN from env_run.xml is' \${CONTINUE_RUN}
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+ echo 'so files for some later step than the initial one will be restaged.'
+ echo "Date to reset files to is: \${restart_time}"
+else
+ echo 'so files for the initial step of this experiment will be restaged.'
+ echo "Date to reset files to is: ${init_time}"
+endif
+echo ''
+
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+
+ #----------------------------------------------------------------------
+ # This block copies over a set of restart files from any previous step of
+ # the experiment that is NOT the initial step.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+ echo "Staging restart files for run date/time: " \${restart_time}
+
+ if ( \${DOUT_S} =~ TRUE ) then
+
+ # The restarts should be in the short term archive 'rest' restart directories.
+
+ set RESTARTDIR = \${DOUT_S_ROOT}/rest/\${restart_time}
+
+ if ( ! -d \${RESTARTDIR} ) then
+
+ echo "restart file directory not found: "
+ echo " \${RESTARTDIR}"
+ exit 100
+
+ endif
+
+ ${COPY} -f \${RESTARTDIR}/* . || exit 101
+
+ else
+
+ # The short term archiver is off, which leaves all the restart files
+ # in the run directory. The rpointer files must still be updated to
+ # point to the files with the right day/time.
+
+ @ inst=1
+ while (\$inst <= $num_instances)
+
+ set inst_string = \`printf _%04d \$inst\`
+
+ echo "${case}.clm2\${inst_string}.r.\${restart_time}.nc" >! rpointer.lnd\${inst_string}
+ echo "${case}.cice\${inst_string}.r.\${restart_time}.nc" >! rpointer.ice\${inst_string}
+ echo "${case}.cam\${inst_string}.r.\${restart_time}.nc" >! rpointer.atm\${inst_string}
+ if (${COMP_ROF} == 'rtm') then
+ echo "${case}.rtm\${inst_string}.r.\${restart_time}.nc" >! rpointer.rof\${inst_string}
+ else if (${COMP_ROF} == 'mosart') then
+ echo "${case}.mosart\${inst_string}.r.\${restart_time}.nc" >! rpointer.rof\${inst_string}
+ endif
+ if ($num_drivers > 1) then
+ echo "${case}.cpl\${inst_string}.r.\${restart_time}.nc" >! rpointer.drv\${inst_string}
+ echo "${case}.docn\${inst_string}.r.\${restart_time}.nc" >! rpointer.ocn\${inst_string}
+ echo "${case}.docn\${inst_string}.rs1.\${restart_time}.bin" >> rpointer.ocn\${inst_string}
+ endif
+
+ @ inst ++
+ end
+
+ # There are no instance numbers in these filenames.
+ if ($num_drivers == 1) then
+ echo "${case}.cpl.r.\${restart_time}.nc" >! rpointer.drv
+ echo "${case}.docn.r.\${restart_time}.nc" >! rpointer.ocn
+ echo "${case}.docn.rs1.\${restart_time}.bin" >> rpointer.ocn
+ endif
+
+ endif
+
+ # Relink the CAM initial files back to the hardwired names set in the namelist
+
+ @ inst=1
+ while (\$inst <= $num_instances)
+ set inst_string = \`printf _%04d \$inst\`
+ ${LINK} -f ${case}.cam\${inst_string}.i.\${restart_time}.nc cam_initial\${inst_string}.nc
+ @ inst ++
+ end
+
+ echo "All files reset to rerun experiment step using (ref)time " \$restart_time
+
+else # CONTINUE_RUN == FALSE
+
+ #----------------------------------------------------------------------
+ # This block links the right files to rerun the initial (very first)
+ # step of an experiment. The names and locations are set during the
+ # building of the case; to change them rebuild the case.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+ echo ' '
+
+ @ inst=1
+ while (\$inst <= $num_instances)
+
+ set inst_string = \`printf _%04d \$inst\`
+
+ echo "Staging initial files for instance \$inst of $num_instances"
+
+ ${LINK} -f ${stagedir}/${refcase}.clm2\${inst_string}.r.${init_time}.nc .
+ ${LINK} -f ${stagedir}/${refcase}.cice\${inst_string}.r.${init_time}.nc .
+ ${LINK} -f ${stagedir}/${refcase}.cam\${inst_string}.i.${init_time}.nc cam_initial\${inst_string}.nc
+ if (${COMP_ROF} == 'rtm') then
+ ${LINK} -f ${stagedir}/${refcase}.rtm\${inst_string}.r.${init_time}.nc .
+ else if (${COMP_ROF} == 'mosart') then
+ ${LINK} -f ${stagedir}/${refcase}.mosart\${inst_string}.r.${init_time}.nc .
+ endif
+
+ @ inst ++
+ end
+
+ echo "All files set to run the FIRST experiment step using (ref)time" $init_time
+
+endif
+exit 0
+
+EndOfText
+chmod 0755 stage_cesm_files
+
+./stage_cesm_files
+
+# ==============================================================================
+# Build the case
+# ==============================================================================
+
+echo ''
+echo 'Building the case'
+echo " --skip-provenance-check is used. See note in $0"
+echo ''
+
+# --skip-provenance-check because of svn or git timing out during build
+# of CLM. It wanted authentication(?) to access a private repository.
+# A better solution would be to find out why(whether) it thinks CLM is
+# a private repository.
+
+./case.build --skip-provenance-check
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be built."
+ exit 120
+endif
+
+# ==============================================================================
+# Check some XML settings which should have been set by this script.
+# ==============================================================================
+
+echo ' '
+echo 'CESM settings which are of special interest:'
+echo ' '
+foreach var ( CONTINUE_RUN RESUBMIT RUN_REF RUN_STARTDATE STOP_OPTION \
+ STOP_N SSTICE DOUT RUNDIR MPI_RUN_COMMAND AVGHIST ASSIM)
+ ./xmlquery --partial $var | grep -v 'Results in' | grep -v '^$'
+end
+echo ' '
+
+# ==============================================================================
+# What to do next
+# ==============================================================================
+
+cat << EndOfText >! CESM_instructions.txt
+
+-------------------------------------------------------------------------
+Time to check the case.
+
+1) Scan the output from this setup script for errors and warnings:
+ ERROR, WARNING, 'No such file' (except for MOSART)
+ 'File status unknown' can be ignored.
+ 'ERROR: cice.buildlib failed' can be ignored, unless you've changed the CICE code
+
+2) cd ${RUNDIR}
+ Check the files that were staged; follow the links to confirm the data sources.
+ Check the compatibility between them and the namelists and pointer files.
+
+3) cd ${caseroot}
+ Verify the CESM XML settings, especially in env_batch.xml and env_run.xml.
+ ./xmlquery --partial
+ is particularly useful.
+
+4) The default initial configuration is to do NO ASSIMILATION.
+ When you are ready to add data assimilation, follow the instructions in
+ ${caseroot}/DART_config.
+
+5) Submit the job (and get mail when it starts and stops):
+ ./case.submit -M begin,end
+
+6) After the job has run, check to make sure it worked.
+
+7) If the first cycle generated an ensemble by perturbing a single state,
+ change input.nml as described in the instructions in it,
+ to make cycles 2,...,N use the latest ensemble, unperturbed.
+
+8) To extend the run in $stop_n '$stop_option' steps, use xmlchange to
+ change the CESM runtime variables:
+
+ ./xmlchange DATA_ASSIMILATION_CYCLES= the value you want.
+ ./xmlchange CONTINUE_RUN=TRUE
+ ./xmlchange RESUBMIT= the number of JOBS to run (each JOB performs DATA_ASSIMILATION_CYCLES cycles)
+
+EndOfText
+
+cat CESM_instructions.txt
+
+echo " If the first cycle generated an ensemble from a single state, change input.nml as described in the "
+echo " instructions in it, to make cycles 2,...,N use the latest ensemble, unperturbed."
+echo " Change values in env_batch.xml to accommodate longer runs."
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/models/cam-fv/shell_scripts/cesm2_1/setup_single_from_ens b/models/cam-fv/shell_scripts/cesm2_1/setup_single_from_ens
new file mode 100755
index 0000000000..f253fd9778
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/setup_single_from_ens
@@ -0,0 +1,836 @@
+#!/bin/csh -f
+#
+# 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
+#
+# DART $Id$
+#
+
+#--------------------------------------------
+# The job name should be the name of this script(file),
+# or this file may not be archived in $caseroot causing DART_config to fail.
+#PBS -N setup_single_from_ens
+
+#PBS -A P86850054
+# #PBS -A your_account_there
+# #PBS -q shared_node_queue_for_this_setup_script
+#PBS -q share
+# Resources I want:
+# select=#nodes
+# ncpus=#CPUs/node
+# mpiprocs=#MPI_tasks/node
+#PBS -l select=1:ncpus=2:mpiprocs=2
+#PBS -l walltime=00:30:00
+
+# Send email after a(bort) or e(nd)
+#PBS -m ae
+#PBS -M you@email.org
+# #PBS -M raeder@ucar.edu
+
+# Send standard output and error to this file.
+# It's helpful to use the $casename here.
+#PBS -o Fixed_leap_day.bld1
+#PBS -j oe
+#--------------------------------------------
+
+# ---------------------
+# Purpose
+#
+# This script is designed to set up, stage, and build a single-instance run
+# of CESM2 using an Fxxx compset, in which CAM, CLM, and CICE are active
+# and the initial conditions are taken from a single instance of a
+# multi-instance CAM forecast (the "reference case" or "REFCASE").
+# The case described here should have the exact same set of active physics
+# as the REFCASE, so that the restart files have matching lists of variables.
+
+# ==============================================================================
+# case options:
+#
+# case The value of "case" will be used many ways; directory and file
+# names both locally and on HPSS, and script names; so consider
+# its length and information content.
+# compset Defines the vertical resolution and physics packages to be used.
+# Must be a standard CESM compset; see the CESM documentation.
+# compset_args The local variable passed to create_newcase, which contains $compset
+# and any signal(s) that this compset is non-standard.
+# resolution Defines the horizontal resolution and dynamics; see CESM docs.
+# T85 ... eulerian at ~ 1 degree
+# ne30np4_gx1v6 ... SE core at ~ 1 degree
+# f09_f09 ... FV core at ~ 1 degree
+# BUG 1384 may apply, check if ocean and atm/land must be at same resolution.
+# Notes about the creation of the 0.25x0.25 ocean + 1deg FV resolution are in
+# /glade/work/raeder/Models/CAM_init/SST/README"
+# user_grid Tells create_newcase whether $resolution has any user defined grids,
+# such as the high resolution SST grid, and where to find the definition of that resolution.
+# cesmtag The version of the CESM source code to use when building the code.
+# A directory with this name must exist in your home directory,
+# and have SourceMods in it. See the SourceMods section.
+# http://www.image.ucar.edu/pub/DART/CESM/README
+# sourcemods DART no longer requires a SourceMods directory in order to work with CESM.
+# If you have modifications to CESM, they should be provided in a
+# CESM-structured SourceMods directory, which this script expects to be in
+# $user/$cesmtag/SourceMods.
+# ==============================================================================
+
+setenv case Fixed_leap_day
+
+setenv compset HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+# setenv compset F2000_DEV
+
+setenv compset_args "--run-unsupported --compset $compset"
+
+# A grid long name may need to be in the --res argument,
+# even if an alias is defined for the user's grid.
+# (2018-10-11 create_newcase --help says a long name must be used,
+# but that is incorrect according ot Jim Edwards and experience;
+# an alias must be used.)
+# set resolution = a%0.9x1.25_l%0.9x1.25_oi%d.25x.25_r%r05_m%d.25x.25_g%null_%null
+setenv resolution f09_d025
+
+# CESM2; set user_grid to '' to use standard SST files
+# or '--user-grid' for hi-res (user-defined)
+set user_grid = ''
+# if ($user_grid !~ '') then
+ # --gridfile must have the name of a config_grids.xml file
+ # which has the user's grid installed in it.
+ set user_grid = "${user_grid} --gridfile /glade/work/raeder/Models/CAM_init/SST"
+ set user_grid = "${user_grid}/config_grids+fv1+2deg_oi0.25_gland20.xml"
+ # If the glc/CISM resolution is changed, also change GLC_GRID below.
+# endif
+echo "user_grid is $user_grid"
+
+setenv cesmtag cesm2_1_relsd_m5.6
+setenv sourcemods ~/${cesmtag}/SourceMods
+
+setenv num_instances 1
+
+# ==============================================================================
+# machines and directories:
+#
+# mach Computer name
+# cesmroot Location of the CESM code base.
+# This version of the script only supports version cesm2_#.
+# Alternative locations might be
+# /glade/p/cesm/cseg/collections/${cesmtag} for a released model on cheyenne
+# /glade/p/cesmdata/cseg/.dev/${cesmtag} for beta tags.
+# caseroot Will create the CESM case directory here, where the CESM+DART
+# configuration files will be stored. This should probably not
+# be in scratch (on yellowstone, your 'work' partition is suggested).
+# This script will delete any existing caseroot, so this script,
+# and other useful things should be kept elsewhere.
+# cesmdata Location of some supporting CESM data files.
+# NOTE: rundir and exeroot should be replaced by the cime_output mechanism as in setup_hybrid.
+# rundir Will create the CESM run directory here. Will need large
+# amounts of disk space, generally on a scratch partition.
+# exeroot Will create the CESM executable directory here, where the
+# CESM executables will be built. Medium amount of space
+# needed, generally on a scratch partition.
+# archdir Will create the CESM short-term archive directories here.
+# Large, generally on a scratch partition. Files will remain
+# here until the long-term archiver moves it to permanent storage.
+# ==============================================================================
+
+setenv mach cheyenne
+
+setenv cesmroot /glade/work/${USER}/Models/${cesmtag}
+setenv caseroot /glade/work/${USER}/Exp/${case}
+setenv cesmdata /gpfs/fs1/p/cesmdata/cseg/inputdata/glade/p/cesmdata/cseg/inputdata
+
+setenv rundir /glade/scratch/${USER}/${case}/run
+setenv exeroot /glade/scratch/${USER}/${case}/bld
+setenv archdir /glade/scratch/${USER}/${case}/archive
+
+# ==============================================================================
+# runtime settings:
+#
+# starttype 'branch' for an exact restart from the REFCASE CAM restart file
+# 'hybrid' for starting from REFCASE CAM initial file, like assimilations do.
+
+# refcase The multi-instance case name, from which the IC files will come.
+# refyear Year of the refcase
+# refmon Month (2 digits)
+# refday Day (2 digits)
+# reftod Time (5 digits, seconds)
+# stagedir Script "stage_cesm_files" (below) stages the files from $refcase
+# into the run directory, with single instance names.
+# inst The instance number of the refcase to use as the ICs
+# Usually this will be an instance that died,
+# but could be a healthy instance to use for comparison.
+
+# start_year Generally this is the same as the reference case date,
+# stop_year The end year of the SST data file.
+# start_month but it can be different if you want to start this run
+# start_day as if it was a different time.
+# start_tod (Same formats as refYYY)
+#
+# sst_use_defaults Controls what data ocean files are used.
+# 'true' makes CESM use default files, which are climatological, not monthly,
+# 'false' requires you to supply a set of files; monthly or high resolution.
+# Also be sure to set $user_grid correctly.
+# sst_dataset Data ocean file
+# sst_grid Supporting (consistent) grid file
+# sst_year_start Years included in the sst files.
+# sst_year_end
+# The default SST (as of 2015-3) goes through 2012.
+# Don't use the last few months, since they are incomplete.
+#
+# short_term_archiver Copies the files from each job step to a 'rest' directory.
+#
+# resubmit How many job steps to run on continue runs (should be 0 initially)
+# stop_option Units for determining the forecast length between assimilations
+# stop_n Number of time units in each forecast
+#
+# If the long-term archiver is off, you get a chance to examine the files before
+# they get moved to long-term storage. You can always submit $CASE.l_archive
+# whenever you want to free up space in the short-term archive directory.
+# ==============================================================================
+
+setenv starttype 'hybrid'
+
+setenv refcase f.e21.FHIST_BGC.f09_025.CAM6assim.001
+setenv refyear 2017
+setenv refmon 02
+setenv refday 28
+setenv reftod 64800
+setenv stagedir /glade/scratch/${USER}/${refcase}/run
+setenv inst 3
+
+setenv start_year 2010
+# setenv start_year $refyear
+setenv stop_year $start_year
+setenv start_month $refmon
+setenv start_day $refday
+setenv start_tod $reftod
+
+# useful combinations of time that we use below
+setenv refdate $refyear-$refmon-$refday
+setenv reftimestamp $refyear-$refmon-$refday-$reftod
+
+setenv sst_use_defaults 'false'
+
+if ($sst_use_defaults == 'false') then
+ # Daily, 1/4-degree SSTs from Reynolds,...,Tomas
+ # These require the new 'resolution', as described in the argument to --user-grid, above.
+ # WARNING; these files must have the 'calendar=gregorian' attribute added to the variable 'time',
+ # which can be done with $p/Models/CAM_init/SST/add_calendar_attr.csh.
+ setenv sst_dataset \
+ "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20100101_cat_20101231_filled_c130829.nc"
+# "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20130101_cat_20130731_filled_c170223.nc"
+ setenv sst_grid /glade/work/raeder/Models/CAM_init/SST/domain.ocn.d025.120821.nc
+ setenv sst_year_start $start_year
+ setenv sst_year_end $stop_year
+ # Monthly, 1 degree data set.
+# setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2013_c140701.nc
+# setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv0.9x1.25_gx1v6.130409.nc
+# setenv sst_year_start 1850
+# setenv sst_year_end 2013
+endif
+setenv short_term_archiver off
+
+setenv resubmit 0
+setenv stop_option nhours
+setenv stop_n 6
+
+# ==============================================================================
+# job settings:
+#
+# queue can be changed during a series by changing the ${case}.run
+# timewall can be changed during a series by changing the ${case}.run
+#
+# TJH: Advancing 30 instances for 6 hours and assimilating took
+# less than 10 minutes on yellowstone using 1800 pes (120 nodes)
+# ==============================================================================
+
+setenv ACCOUNT P86850054
+# setenv ACCOUNT Your_account
+setenv queue economy
+setenv timewall 0:15
+
+# ==============================================================================
+# standard commands:
+
+# This prevents user's aliases from giving unintended results.
+
+# The FORCE options are not optional.
+# The VERBOSE options are useful for debugging though
+# some systems don't like the -v option to any of the following
+
+if ($?LS_SUBCWD) then
+ echo "changing directory to $LS_SUBCWD"
+ cd $LS_SUBCWD
+else if ($?PBS_O_WORKDIR) then
+ echo "changing directory to $PBS_O_WORKDIR"
+ cd $PBS_O_WORKDIR
+endif
+
+set MOVE = '/bin/mv -f'
+set COPY = '/bin/cp -f --preserve=timestamps'
+set LINK = '/bin/ln -fs'
+set REMOVE = '/bin/rm -fr'
+
+# If your shell commands don't like the -v option and you want copies to be echoed,
+# set this to be TRUE. Otherwise, it should be FALSE.
+set COPYV = FALSE
+set REMOVEV = FALSE
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+# ==============================================================================
+# ==============================================================================
+# Make sure the CESM directories exist.
+# VAR is the shell variable name, DIR is the value
+# ==============================================================================
+
+foreach VAR ( cesmroot )
+ set DIR = `eval echo \${$VAR}`
+ if ( ! -d $DIR ) then
+ echo "ERROR: directory '$DIR' not found"
+ echo " In the setup script check the setting of: $VAR "
+ exit 10
+ endif
+end
+
+# ==============================================================================
+# Create the case - this creates the CASEROOT directory.
+#
+# For list of the pre-defined component sets: ./create_newcase -list
+# To create a variant compset, see the CESM documentation and carefully
+# incorporate any needed changes into this script.
+# ==============================================================================
+
+# fatal idea to make caseroot the same dir as where this setup script is
+# since the build process removes all files in the caseroot dir before
+# populating it. try to prevent shooting yourself in the foot.
+
+if ( $caseroot == `dirname $0` ) then
+ echo "ERROR: the setup script should not be located in the caseroot"
+ echo "directory, because all files in the caseroot dir will be removed"
+ echo "before creating the new case. move the script to a safer place."
+ exit 20
+endif
+
+echo "removing old files from ${caseroot}"
+echo "removing old files from ${exeroot}"
+echo "removing old files from ${rundir}"
+${REMOVE} ${caseroot}
+${REMOVE} ${exeroot}
+${REMOVE} ${rundir}
+
+# CIMEROOT Must be set before create_newcase.
+setenv CIMEROOT $cesmroot/cime
+
+${CIMEROOT}/scripts/create_newcase \
+ --case ${caseroot} \
+ --mach ${mach} \
+ --queue $queue \
+ --walltime $timewall \
+ --res ${resolution} ${compset_args} ${user_grid}
+
+set cr_stat = $status
+if ( $cr_stat != 0 ) then
+ echo "ERROR: Case could not be created. Code $cr_stat"
+ exit 30
+endif
+
+# Preserve a copy of this script as it was run. (Must be after create_newcase)
+if ($?LSB_JOBNAME) then
+ # This only works if the job name in the BSUB or PBS directives
+ # is the name of this script.
+ setenv setup_file_name $LSB_JOBNAME
+else if ($?PBS_JOBNAME) then
+ setenv setup_file_name $PBS_JOBNAME
+else
+ setenv setup_file_name = $0:t
+endif
+${COPY} $setup_file_name ${caseroot}/${setup_file_name}.original
+
+# ==============================================================================
+# Configure the case.
+# ==============================================================================
+
+cd ${caseroot}
+
+setenv CASEROOT `./xmlquery CASEROOT --value`
+setenv COMPSET `./xmlquery COMPSET --value`
+# setenv TEST_MPI `./xmlquery MPI_RUN_COMMAND --value`
+setenv CLM_CONFIG_OPTS `./xmlquery CLM_CONFIG_OPTS --value`
+setenv COMP_OCN `./xmlquery COMP_OCN --value`
+# setenv BATCHSUBMIT `./xmlquery BATCHSUBMIT --value`
+# setenv BATCH_SYSTEM `./xmlquery BATCHSUBMIT --value`
+setenv BATCH_SYSTEM 'manually'
+setenv MAX_TASKS_PER_NODE `./xmlquery MAX_TASKS_PER_NODE --value`
+
+# Make sure the case is configured with a data ocean.
+if ( ${COMP_OCN} != docn ) then
+ echo " "
+ echo "ERROR: This setup script is not appropriate for active ocean compsets."
+ echo "ERROR: Please use the models/CESM/shell_scripts examples for that case."
+ echo " "
+ exit 40
+endif
+
+# Copy the xml files for debugging purposes.
+foreach FILE ( *xml )
+ if ( ! -e ${FILE}.original ) then
+ if ($COPYV == "FALSE") echo "Copying $FILE ${FILE}.original"
+ ${COPY} $FILE ${FILE}.original
+ endif
+end
+
+# NOTE: If you require bit-for-bit agreement between different runs,
+# in particular, between pmo (single instance) and assimilations (NINST > 1),
+# or if you need to change the number of nodes/member due to changing memory needs,
+# then env_run.xml:BFBFLAG must be set to TRUE, so that the coupler will
+# generate bit-for-bit identical results, regardless of the number of tasks
+# given to it. The time penalty appears to be ~ 0.5% in the forecast.
+# Alternatively, you can set cpl_tasks = same_number in both experiments
+
+# Task layout:
+# Set the nodes_per_instance below to match your case. If you get 'out of memory'
+# errors OR failures without any messages, try increasing the nodes_per_instance.
+# CAM6-FV 1 degree can run on 3 nodes/instance on cheyenne.
+# By computing task counts like we do below, we guarantee each instance uses
+# a whole number of nodes which is the recommended configuration.
+
+# Edwards says there's no speed up by running non-active components concurrently,
+# after ATM has run, so just run all components sequentially.
+
+# MAX_TASKS_PER_NODE comes from $case/Tools/mkbatch.$machine
+@ use_tasks_per_node = $MAX_TASKS_PER_NODE
+@ nthreads = 1
+set nodes_per_instance = 3
+
+
+@ atm_tasks = $use_tasks_per_node * $num_instances * $nodes_per_instance
+@ lnd_tasks = $use_tasks_per_node * $num_instances * $nodes_per_instance
+@ ice_tasks = $use_tasks_per_node * $num_instances * $nodes_per_instance
+@ ocn_tasks = $use_tasks_per_node * $num_instances
+@ cpl_tasks = $use_tasks_per_node * $num_instances
+@ glc_tasks = $use_tasks_per_node * $num_instances
+@ rof_tasks = $use_tasks_per_node * $num_instances * $nodes_per_instance
+@ wav_tasks = $use_tasks_per_node * $num_instances
+
+
+echo "ATM gets $atm_tasks"
+echo "LND gets $lnd_tasks"
+echo "ICE gets $ice_tasks"
+echo "OCN gets $ocn_tasks"
+echo "CPL gets $cpl_tasks"
+echo "GLC gets $glc_tasks"
+echo "ROF gets $rof_tasks"
+echo "WAV gets $wav_tasks"
+echo ""
+
+./xmlchange NTHRDS_ATM=$nthreads,NTASKS_ATM=$atm_tasks,NINST_ATM=$num_instances
+./xmlchange NTHRDS_LND=$nthreads,NTASKS_LND=$lnd_tasks,NINST_LND=$num_instances
+./xmlchange NTHRDS_ICE=$nthreads,NTASKS_ICE=$ice_tasks,NINST_ICE=$num_instances
+./xmlchange NTHRDS_OCN=$nthreads,NTASKS_OCN=$ocn_tasks,NINST_OCN=1
+./xmlchange NTHRDS_CPL=$nthreads,NTASKS_CPL=$cpl_tasks
+./xmlchange NTHRDS_GLC=$nthreads,NTASKS_GLC=$glc_tasks,NINST_GLC=1
+./xmlchange NTHRDS_ROF=$nthreads,NTASKS_ROF=$rof_tasks,NINST_ROF=$num_instances
+./xmlchange NTHRDS_WAV=$nthreads,NTASKS_WAV=$wav_tasks,NINST_WAV=1
+./xmlchange ROOTPE_ATM=0
+./xmlchange ROOTPE_LND=0
+./xmlchange ROOTPE_ICE=0
+./xmlchange ROOTPE_OCN=0
+./xmlchange ROOTPE_CPL=0
+./xmlchange ROOTPE_GLC=0
+./xmlchange ROOTPE_ROF=0
+./xmlchange ROOTPE_WAV=0
+
+./xmlchange RUN_TYPE=$starttype
+
+if ($starttype =~ 'hybrid') then
+ ./xmlchange RUN_STARTDATE=${start_year}-${start_month}-${start_day}
+ ./xmlchange START_TOD=$start_tod
+endif
+
+# The refcase needs to have the instance number removed from the file names,
+# so this script stages the IC files and CESM should not.
+./xmlchange GET_REFCASE=FALSE
+./xmlchange RUN_REFDIR=$rundir
+./xmlchange RUN_REFCASE=$refcase
+./xmlchange RUN_REFDATE=$refdate
+./xmlchange RUN_REFTOD=$reftod
+
+./xmlchange EXEROOT=${exeroot}
+./xmlchange RUNDIR=${rundir}
+
+if ($sst_use_defaults == 'false') then
+ ./xmlchange SSTICE_DATA_FILENAME=$sst_dataset
+ ./xmlchange SSTICE_GRID_FILENAME=$sst_grid
+ ./xmlchange SSTICE_YEAR_ALIGN=$sst_year_start
+ ./xmlchange SSTICE_YEAR_START=$sst_year_start
+ ./xmlchange SSTICE_YEAR_END=$sst_year_end
+endif
+
+
+./xmlchange CALENDAR=GREGORIAN
+./xmlchange CONTINUE_RUN=FALSE
+
+./xmlchange STOP_OPTION=$stop_option
+./xmlchange STOP_N=$stop_n
+./xmlchange RESUBMIT=$resubmit
+
+./xmlchange PIO_TYPENAME=pnetcdf
+
+# set TEST_MPI = `./xmlquery MPI_RUN_COMMAND --value | sed -e 's/MPI_RUN_COMMAND//'`
+# echo "passed assignment of TEST_MPI = $TEST_MPI"
+# if (${TEST_MPI} == 'UNSET') then
+# ./xmlchange MPI_RUN_COMMAND=mpirun.lsf
+# endif
+
+# Extract pieces of the COMPSET for choosing correct setup parameters.
+# E.g. "AMIP_CAM5_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM1%NOEVOLVE_SWAV"
+set comp_list = `echo $COMPSET | sed -e "s/_/ /g"`
+
+# River Transport Model
+./xmlchange ROF_GRID='r05'
+# ./xmlchange RTM_MODE='null'
+echo "comp_list[6] = $comp_list[6]"
+set roff = `echo "$comp_list[6]" | sed -e "s/%/ /g"`
+echo "roff = $roff"
+set river_runoff = "$roff[1]"
+echo "river_runoff = $river_runoff, from $comp_list[6]"
+if ($river_runoff != 'RTM' && $river_runoff != 'MOSART' && \
+ $river_runoff != 'DROF' && $river_runoff != 'SROF') then
+ echo "river_runoff is $river_runoff, which is not supported"
+ exit 50
+endif
+
+
+# COUPLING discussion. F compsets are 'tight' coupling.
+# Only change the ATM_NCPL ... everything is based on this one value,
+# including CAM physics and dynamics timesteps.
+# Default values for coupling are preserved in env_run.xml.original.
+
+./xmlchange NCPL_BASE_PERIOD=day
+./xmlchange ATM_NCPL=48
+
+# CAM physics (etc.) selection.
+# ./xmlchange CAM_CONFIG_OPTS="-phys cam5.4 -club_sgs"
+# ./xmlchange CAM_CONFIG_OPTS="-phys cam4"
+setenv CAM_CONFIG_OPTS `./xmlquery CAM_CONFIG_OPTS --value`
+# echo $CAM_CONFIG_OPTS | grep 'cam4'
+# CLMBuildNamelist::setup_logic_initial_conditions() :
+# using ignore_ic_date is incompatable with crop!
+# If you choose to ignore this error, the counters since planting for crops will be messed up.
+# -- Add -ignore_warnings option to CLM_BLDNML_OPTS to ignore this warning
+echo $compset | grep 'CROP'
+if ($status == 0) then
+ setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+ set clm_opts = "$CLM_BLDNML_OPTS -ignore_warnings "
+ ./xmlchange CLM_BLDNML_OPTS="$clm_opts"
+ # DEBUG/confirm
+ setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+ echo "CLM_BLDNML_OPTS has been changed to $CLM_BLDNML_OPTS"
+endif
+
+# These are archiving options that may be used.
+# You can turn the short/long term archivers on or off,
+# but these settings should be made in either event.
+
+./xmlchange DOUT_S_ROOT=${archdir}
+# ./xmlchange DOUT_S_SAVE_INTERIM_RESTART_FILES=TRUE
+
+if ($short_term_archiver == 'off') then
+ ./xmlchange DOUT_S=FALSE
+else
+ ./xmlchange DOUT_S=TRUE
+endif
+
+# DEBUG = TRUE implies turning on run and compile time debugging.
+# INFO_DBUG level of debug output, 0=minimum, 1=normal, 2=more, 3=too much.
+# WARNING: CAM-SE fails if DEBUG=TRUE
+# ./xmlchange DEBUG=FALSE
+# ./xmlchange INFO_DBUG=0
+# Debug_lwdn
+./xmlchange DEBUG=TRUE
+./xmlchange INFO_DBUG=2
+# Reduce the MPI activity messages. 2 = default (too much).
+# ATM_forcXX: not in the config_definition file: ./xmlchange MP_INFOLEVEL=0
+
+
+
+# ==============================================================================
+# Update source files.
+# DART does not require any modifications to the model source.
+# ==============================================================================
+
+# Import your SourceMods, if you have any. DART doesn't have any of its own.
+if (-d ${sourcemods} ) then
+ echo ' '
+ if ($COPYV == "FALSE") \
+ echo "Copying SourceMods from $sourcemods to $caseroot "
+ ${COPY} -r ${sourcemods}/* ${caseroot}/SourceMods/ || exit 60
+ echo ' '
+ echo ' '
+else
+ echo "No SourceMods directory for this case."
+endif
+
+# ==============================================================================
+# Set up the case.
+# This creates the EXEROOT and RUNDIR directories.
+# ==============================================================================
+
+echo 'Setting up the case ...'
+
+./case.setup
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be set up."
+ exit 70
+# else if (! (-f config_cache.xml || -f Buildconf/camconf/config_cache.xml)) then
+# echo "ERROR: No config_cach.xml."
+# exit 80
+endif
+
+# ==============================================================================
+# Edit the run script to reflect queue and wallclock
+# ==============================================================================
+
+echo ''
+echo 'Updating the run script to set wallclock and queue.'
+echo ''
+
+# ===========================================================================
+
+set inst_string = `printf _%04d $inst`
+
+# ===========================================================================
+set fname = "user_nl_cam"
+
+echo " inithist = 'ENDOFRUN'" >> ${fname}
+echo " ncdata = 'cam_initial${inst_string}.nc'" >> ${fname}
+echo " empty_htapes = .true. " >> ${fname}
+echo " fincl1 = '' " >> ${fname}
+# >0 means the number of time steps.
+echo " nhtfrq = 1 " >> ${fname}
+
+
+# ===========================================================================
+set fname = "user_nl_clm"
+
+# Debugging runs will probably never want to interpolate the CLM restart files.
+echo "use_init_interp = .false. " >> ${fname}
+# echo "init_interp_fill_missing_with_natveg = .true. " >> ${fname}
+
+echo "finidat = '${refcase}.clm2.r.${reftimestamp}.nc'" >> ${fname}
+echo "hist_empty_htapes = .true." >> ${fname}
+echo "hist_fincl1 = 'TSA'" >> ${fname}
+echo "hist_nhtfrq = -$stop_n" >> ${fname}
+# This needs to match the settings in $refcase, or the restart files will be mismatched.
+echo "urban_hac = 'OFF'" >> ${fname}
+echo "building_temp_method = 0 " >> ${fname}
+echo "check_finidat_year_consistency = .false." >> ${fname}
+
+
+set fname = "user_nl_cice"
+echo $CAM_CONFIG_OPTS | grep 'cam4'
+if ($status == 0) then
+ # CAM4:
+ echo "ice_ic = 'default'" >> ${fname}
+else
+ # CAM5, 6, ...:
+ echo "ice_ic = '${refcase}.cice${inst_string}.r.${reftimestamp}.nc'" >> ${fname}
+endif
+
+# ATM_forcXX Test coupler forcing file output
+# ===========================================================================
+set fname = "user_nl_cpl"
+
+# J1850G(lofverstrom) + river (Lindsay)
+echo " histaux_a2x3hr = .true." >> ${fname}
+echo " histaux_a2x24hr = .true." >> ${fname}
+echo " histaux_a2x1hri = .true." >> ${fname}
+echo " histaux_a2x1hr = .true." >> ${fname}
+echo " histaux_r2x = .true." >> ${fname}
+./xmlchange AVGHIST_OPTION=nsteps
+./xmlchange AVGHIST_N=1
+
+./preview_namelists || exit 100
+
+# ===================================================================================
+
+set init_time = ${reftimestamp}
+
+cat << EndOfText >! stage_cesm_files
+#!/bin/csh -f
+# This script can be used to help restart an experiment from any previous step.
+# The appropriate files are copied to the RUN directory.
+#
+# Before running this script:
+# 1) be sure CONTINUE_RUN is set correctly in the env_run.xml file in
+# your caseroot directory.
+# CONTINUE_RUN=FALSE => start at REFTIME.
+# CONTINUE_RUN=TRUE => start from a previous step after REFTIME.
+# 2) be sure 'restart_time' is set to the day and time from which you want to
+# restart, if not the initial time.
+
+set restart_time = $init_time
+
+# ---------------------------------------------------------
+# Get the settings for this case from the CESM environment
+# ---------------------------------------------------------
+cd ${caseroot}
+setenv RUNDIR \`./xmlquery RUNDIR --value\`
+setenv CONTINUE_RUN \`./xmlquery CONTINUE_RUN --value\`
+
+# ---------------------------------------------------------
+
+cd \${RUNDIR}
+
+echo 'Copying the required CESM files to the run directory to rerun a previous step. '
+echo 'CONTINUE_RUN from env_run.xml is' \${CONTINUE_RUN}
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+ echo 'so files for some later step than the initial one will be restaged.'
+ echo "Date to reset files to is: \${restart_time}"
+else
+ echo 'so files for the initial step of this experiment will be restaged.'
+ echo "Date to reset files to is: ${init_time}"
+endif
+echo ''
+
+if ( \${CONTINUE_RUN} =~ TRUE ) then
+
+ #----------------------------------------------------------------------
+ # This block copies over a set of restart files from any previous step of
+ # the experiment that is NOT the initial step.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+ echo "Staging restart files for run date/time: " \${restart_time}
+
+ if ( \${DOUT_S} =~ TRUE ) then
+
+ # The restarts should be in the short term archive 'rest' restart directories.
+
+ set RESTARTDIR = \${DOUT_S_ROOT}/rest/\${restart_time}
+
+ if ( ! -d \${RESTARTDIR} ) then
+
+ echo "restart file directory not found: "
+ echo " \${RESTARTDIR}"
+ exit 100
+
+ endif
+
+ ${COPY} \${RESTARTDIR}/* . || exit 101
+
+ else
+
+ # The short term archiver is off, which leaves all the restart files
+ # in the run directory. The rpointer files must still be updated to
+ # point to the files with the right day/time.
+
+ echo "${case}.cam.r.\${restart_time}.nc" >! rpointer.atm
+ echo "${case}.clm2.r.\${restart_time}.nc" >! rpointer.lnd
+ echo "${case}.cice.r.\${restart_time}.nc" >! rpointer.ice
+ echo "${case}.cpl.r.\${restart_time}.nc" >! rpointer.drv
+ echo "${case}.docn.r.\${restart_time}.nc" >! rpointer.ocn
+ echo "${case}.docn.rs1.\${restart_time}.bin" >> rpointer.ocn
+
+ if ($river_runoff == 'RTM') then
+ echo "${case}.rtm.r.\${restart_time}.nc" >! rpointer.rof
+ else if ($river_runoff == 'MOSART') then
+ echo "${case}.mosart.r.\${restart_time}.nc" >! rpointer.rof
+ endif
+
+
+ endif
+
+ # Relink the CAM initial file back to the hardwired name set in the namelist
+
+ ${LINK} ${case}.cam.i.\${restart_time}.nc cam_initial.nc
+
+ echo "All files reset to rerun experiment step using (ref)time " \$restart_time
+
+
+else # CONTINUE_RUN == FALSE
+
+ #----------------------------------------------------------------------
+ # This block links the right files to rerun the initial (very first)
+ # step of an experiment. The names and locations are set during the
+ # building of the case; to change them rebuild the case.
+ # After running this script resubmit the job to rerun.
+ #----------------------------------------------------------------------
+
+
+ echo ' '
+ echo "Staging initial files for instance $inst of $num_instances"
+
+ if ($starttype =~ 'hybrid') then
+ ${LINK} ${stagedir}/${refcase}.cam${inst_string}.i.\${restart_time}.nc cam_initial${inst_string}.nc
+ # ${refcase}.cam.i.\${restart_time}.nc
+ endif
+
+ ${LINK} ${stagedir}/${refcase}.cam${inst_string}.r.\${restart_time}.nc ${refcase}.cam.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.cam${inst_string}.rs.\${restart_time}.nc ${refcase}.cam.rs.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.clm2${inst_string}.r.\${restart_time}.nc ${refcase}.clm2.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.clm2${inst_string}.rh0.\${restart_time}.nc ${refcase}.clm2.rh0.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.cice${inst_string}.r.\${restart_time}.nc ${refcase}.cice.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.cpl${inst_string}.r.\${restart_time}.nc ${refcase}.cpl.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.docn${inst_string}.rs1.\${restart_time}.bin ${refcase}.docn.rs1.\${restart_time}.bin
+
+ echo "${refcase}.cam.r.\${restart_time}.nc" >! rpointer.atm
+ echo "${refcase}.clm2.r.\${restart_time}.nc" >! rpointer.lnd
+ echo "${refcase}.cice.r.\${restart_time}.nc" >! rpointer.ice
+ echo "${refcase}.cpl.r.\${restart_time}.nc" >! rpointer.drv
+ echo "${refcase}.docn.r.\${restart_time}.nc" >! rpointer.ocn
+ echo "${refcase}.docn.rs1.\${restart_time}.bin" >> rpointer.ocn
+
+ if ($river_runoff == 'RTM') then
+ ${LINK} ${stagedir}/${refcase}.rtm${inst_string}.r.\${restart_time}.nc \
+ ${refcase}.rtm.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.rtm${inst_string}.rh0.\${restart_time}.nc \
+ ${refcase}.rtm.rh0.\${restart_time}.nc
+ echo "${refcase}.rtm.r.\${restart_time}.nc" >! rpointer.rof
+ else if ($river_runoff == 'MOSART') then
+ ${LINK} ${stagedir}/${refcase}.mosart${inst_string}.r.\${restart_time}.nc \
+ ${refcase}.mosart.r.\${restart_time}.nc
+ ${LINK} ${stagedir}/${refcase}.mosart${inst_string}.rh0.\${restart_time}.nc \
+ ${refcase}.mosart.rh0.\${restart_time}.nc
+ echo "${refcase}.mosart.r.\${restart_time}.nc" >! rpointer.rof
+ endif
+
+ echo "All files set to run the FIRST experiment step using (ref)time" $init_time
+
+endif
+
+cd ..
+
+exit 0
+
+EndOfText
+chmod 0755 stage_cesm_files
+
+./stage_cesm_files
+
+# ==============================================================================
+# build
+# ==============================================================================
+
+echo ''
+echo 'Building the case'
+echo ''
+
+# --skip-provenance-check because of svn or git timing out during build
+# of CLM. It wanted authentication(?) to access a private repository.
+# A better solution would be to find out why(whether) it thinks CLM is
+# a private repository.
+./case.build --skip-provenance-check
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be built."
+ exit 200
+endif
+
+exit 0
+
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/models/cam-fv/shell_scripts/cesm2_1/spinup_single b/models/cam-fv/shell_scripts/cesm2_1/spinup_single
new file mode 100755
index 0000000000..81d1247601
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/spinup_single
@@ -0,0 +1,682 @@
+#!/bin/csh -f
+#
+# 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
+#
+# DART $Id$
+
+#--------------------------------------------
+# This script can be run interactively, but on some systems (e.g. cheyenne)
+# it takes longer than is allowed for an interactive job.
+# In that case, it can be run as a batch job using the directives below,
+# or using "qcmd -q share -l select=1 -- ".
+
+# The job name should be the name of this script(file),
+# or this file may not be archived in $caseroot causing DART_config to fail.
+#PBS -N spinup_single
+#PBS -A your_account_there
+#PBS -q shared_node_queue_for_this_setup_script
+# Resources I want:
+# select=#nodes
+# ncpus=#CPUs/node
+# mpiprocs=#MPI_tasks/node
+#PBS -l select=1:ncpus=4:mpiprocs=4
+#PBS -l walltime=00:30:00
+# Send email after a(bort) or e(nd)
+#PBS -m ae
+#PBS -M you@email.org
+# It's helpful to make the output file of this build job contain the case name.
+#PBS -o single_test1.bld1
+# Send standard output and error to this file.
+#PBS -j oe
+
+#--------------------------------------------
+# Purpose
+#
+# This script is designed to set up, stage, and build a single-instance run
+# of CESM using an Fxxx compset where CAM, CLM and CICE are active.
+# ==============================================================================
+# case options:
+#
+# case The value of "case" will be used many ways; directory and file
+# names both locally and on HPSS, and script names; so consider
+# its length and information content.
+# compset Defines the vertical resolution and physics packages to be used.
+# Must be a standard CESM compset; see the CESM documentation.
+# compset_args A variable to accumulate compset arguments for passing to create_newcase.
+# user_grid A variable to accumulate grid arguments for create_newcase,
+# especially high res SSTs.
+# resolution Defines the horizontal resolution and dynamics; see CESM docs.
+# T85 ... eulerian at ~ 1 degree
+# ne30np4_gx1v6 ... SE core at ~ 1 degree
+# f09_f09 ... FV core at ~ 1 degree
+# BUG 1384 may apply, check if ocean and atm/land must be at same resolution.
+# Notes about the creation of the 0.25x0.25 ocean + 1deg FV resolution are in
+# /glade/work/raeder/Models/CAM_init/SST/README"
+# cesmtag The version of the CESM source code to use when building the code.
+# A directory with this name must exist in your home directory,
+# and have SourceMods in it. See the SourceMods section.
+# http://www.image.ucar.edu/pub/DART/CESM/README
+# ==============================================================================
+# AMIP_CAM5_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV (F_AMIP_CAM5) (FAMIPC5)
+
+setenv case single_test1
+
+setenv compset HIST_CAM60_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+# setenv compset F2000_DEV
+# F2000_DEV = 2000_CAM60_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM1%NOEVOLVE_SWAV
+
+setenv compset_args "--run-unsupported --compset $compset"
+# setenv compset_args "-user_compset $compset -user_pes_setby cam"
+
+# CESM2; set user_grid to '' for standard SST files
+# or '--gridfile' for hi-res (user-defined)
+set user_grid = '--gridfile'
+if ($user_grid == '--gridfile') then
+ # --gridfile must have the name of a config_grids.xml file
+ # which has the user's grid installed in it.
+ set user_grid = "${user_grid} /glade/work/raeder/Models/CAM_init/SST"
+ set user_grid = "${user_grid}/config_grids+fv1+2deg_oi0.25_gland20.xml"
+ # A grid long name may be needed in the --res argument,
+ # even if an alias is defined for the user's grid.
+ # set resolution = a%0.9x1.25_l%0.9x1.25_oi%d.25x.25_r%r05_m%d.25x.25_g%null_%null
+ # f09_d025 = the 1 degree CAM + 1/4 degree SST resolution
+ set resolution = f09_d025
+else
+ # Use a CESM supported grid
+ set resolution = f19_g17
+# set resolution = f09_f09_g17
+
+endif
+echo "user_grid is $user_grid"
+
+setenv cesmtag cesm2_1_maint-5.6
+# setenv cesmtag cesm2_0
+setenv num_instances 1
+
+# Set the number of MPI tasks/node and threads/task.
+@ use_tasks_per_node = 36
+@ nthreads = 1
+
+# ==============================================================================
+# machines and directories:
+#
+# mach Computer name
+# cesmdata Location of some supporting CESM data files.
+# cesmroot Location of the CESM code base. This version of the script
+# only supports version cesm1_2_1.
+# caseroot Will create the CESM case directory here, where the CESM+DART
+# configuration files will be stored. This should probably not
+# be in scratch (on yellowstone, your 'work' partition is suggested).
+# This script will delete any existing caseroot, so this script,
+# and other useful things should be kept elsewhere.
+# NOTE: this cime_output is different from setup_{hybrid,advanced}
+# This should be fixed.
+# cime_output The directory where CESM's bld and run directories will be created.
+# $CASEROOT is appended to this first.
+# Large amount of space needed, generally on a scratch partition.
+# DART's preference is to put the archive directory there too,
+# but that's not the CESM default.
+# archdir Will create the CESM short-term archive directories here.
+# Large, generally on a scratch partition. Files will remain
+# here until the long-term archiver moves it to permanent storage.
+# dartroot Location of the root of _your_ DART installation
+# ==============================================================================
+
+setenv mach cheyenne
+setenv cesmdata /gpfs/fs1/p/cesmdata/cseg/inputdata
+setenv cesmroot /glade/work/${USER}/Models/${cesmtag}
+setenv caseroot /glade/work/${USER}/Exp/${case}
+setenv cime_output /glade/scratch/${USER}/${case}
+setenv archdir ${cime_output}/${case}/archive
+
+# configure (called by cesm_setup?) has a new argument, cimeroot, which either needs to be provided
+# on the command line or env var CIMEROOT needs to be defined.
+setenv CIMEROOT $cesmroot/cime
+
+# ==============================================================================
+# runtime settings: This script will find usable files for years 19mumble-2010.
+# Years after that (or before) may require searching $cesmdata for more
+# up-to-date files and adding them to the user_nl_cam_#### in the code below.
+#
+# start_year generally this is the same as the reference case date, but it can
+# start_month be different if you want to start this run as if it was a different time.
+# start_day
+# start_tod
+#
+# sst_dataset Data ocean file
+# sst_grid Supporting (consistent) grid file
+# sst_year_start Years included in the sst files.
+# sst_year_end
+# The default SST (as of 2015-3) goes through 2012.
+# Don't use the last few months, since they are incomplete.
+#
+# short_term_archiver Copies the files from each job step to a 'rest' directory.
+# long_term_archiver Puts the files from all completed steps on tape storage.
+#
+# resubmit How many job steps to run on continue runs (should be 0 initially)
+# stop_option Units for determining the forecast length between assimilations
+# stop_n Number of time units in each forecast
+#
+# If the long-term archiver is off, you get a chance to examine the files before
+# they get moved to long-term storage. You can always submit $CASE.l_archive
+# whenever you want to free up space in the short-term archive directory.
+# ==============================================================================
+
+setenv start_year 2016
+setenv stop_year 2016
+setenv start_month 01
+setenv start_day 01
+setenv start_tod 00000
+
+# The default CAM sea surface temperature file is climatological,
+# which is less than ideal for atmospheric assimilations.
+# The supported alternative is time interpolation of a monthly SST+CICE data set.
+# Examples are provided here.
+# "2 degree":
+# setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_1850_2016_c170525.nc
+# setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv1.9x2.5_gx1v7.170518.nc
+# "1 degree":
+# setenv sst_dataset ${cesmdata}/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_1850_2016_c170525.nc
+# setenv sst_grid ${cesmdata}/share/domains/domain.ocn.fv0.9x1.25_gx1v7.151020.nc
+# Specify the beginning and ending years of the data set.
+# setenv sst_year_start 1850
+# setenv sst_year_end 2016
+
+# "1/4 degree":
+# A better alternative is daily, 1/4-degree SSTs from Reynolds,...,Tomas
+
+set user_grid = "${user_grid} --gridfile /glade/work/raeder/Models/CAM_init/SST"
+set user_grid = "${user_grid}/config_grids+fv1+2deg_oi0.25_gland20.xml"
+setenv sst_dataset \
+ "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20160101_cat_20161231_gregorian_c181119.nc"
+ # "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20100101_cat_20101231_filled_c130829.nc"
+ # "/glade/work/raeder/Models/CAM_init/SST/avhrr-only-v2.20130101_cat_20130731_filled_c170223.nc"
+
+# These files must have the 'calendar=gregorian' attribute added to the variable 'time',
+# which can be done with $p/Models/CAM_init/SST/add_calendar_attr.csh.
+set list = `ncdump -h $sst_dataset | grep calendar`
+if ($list[3] !~ '"gregorian"') then
+ echo "ERROR: $sst_dataset"
+ echo " must have the calendar attribute attached to the time variable."
+ echo " Use: ncatted -a calendar,time,c,c,gregorian $sst_dataset"
+ exit 5
+endif
+setenv sst_grid /glade/work/raeder/Models/CAM_init/SST/domain.ocn.d025.120821.nc
+setenv sst_year_start $start_year
+setenv sst_year_end $start_year
+
+===============================================
+setenv short_term_archiver off
+setenv long_term_archiver off
+
+setenv resubmit 6
+setenv stop_option nmonths
+setenv stop_n 1
+
+# ==============================================================================
+# job settings:
+#
+# queue can be changed during a series by changing the ${case}.run
+# timewall can be changed during a series by changing the ${case}.run
+#
+# TJH: Advancing 30 instances for 6 hours and assimilating took
+# less than 10 minutes on yellowstone using 1800 pes (120 nodes)
+# ==============================================================================
+
+setenv ACCOUNT P86850054
+setenv queue premium
+setenv timewall 6:00
+
+# ==============================================================================
+# standard commands:
+#
+# If you are running on a machine where the standard commands are not in the
+# expected location, add a case for them below.
+# ==============================================================================
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+# if ($?LS_SUBCWD) then
+# cd $LS_SUBCWD
+# else if ($?PBS_O_WORKDIR) then
+# echo "changing directory to $PBS_O_WORKDIR"
+# cd $PBS_O_WORKDIR
+# endif
+
+set MOVE = '/usr/bin/mv'
+set COPY = '/usr/bin/cp --preserve=timestamps'
+set LINK = '/usr/bin/ln -s'
+set LIST = '/usr/bin/ls'
+set REMOVE = '/usr/bin/rm'
+
+
+# ==============================================================================
+# ==============================================================================
+# Make sure the CESM directories exist.
+# VAR is the shell variable name, DIR is the value
+# ==============================================================================
+
+foreach VAR ( cesmroot )
+ set DIR = `eval echo \${$VAR}`
+ if ( ! -d $DIR ) then
+ echo "ERROR: directory '$DIR' not found"
+ echo " In the setup script check the setting of: $VAR "
+ exit -1
+ endif
+end
+
+# ==============================================================================
+# Create the case - this creates the CASEROOT directory.
+#
+# For list of the pre-defined component sets: ./create_newcase -list
+# To create a variant compset, see the CESM documentation and carefully
+# incorporate any needed changes into this script.
+# ==============================================================================
+
+# fatal idea to make caseroot the same dir as where this setup script is
+# since the build process removes all files in the caseroot dir before
+# populating it. try to prevent shooting yourself in the foot.
+
+if ( $caseroot == `dirname $0` ) then
+ echo "ERROR: the setup script should not be located in the caseroot"
+ echo "directory, because all files in the caseroot dir will be removed"
+ echo "before creating the new case. move the script to a safer place."
+ exit -1
+endif
+
+echo "removing old files from ${caseroot}"
+echo "removing old directory ${cime_output}/bld"
+echo "removing old directory ${cime_output}/run"
+${REMOVE} -fr ${caseroot}
+${REMOVE} -fr ${cime_output}/bld
+${REMOVE} -fr ${cime_output}/run
+
+${CIMEROOT}/scripts/create_newcase \
+ --case ${caseroot} \
+ --machine ${mach} \
+ --res ${resolution} \
+ --project $PROJECT \
+ --queue $queue \
+ --walltime $timewall \
+ --pecount ${use_tasks_per_node}x${nthreads} \
+ ${compset_args} \
+ ${user_grid}
+
+set cr_stat = $status
+if ( $cr_stat != 0 ) then
+ echo "ERROR: Case could not be created. Code $cr_stat"
+ exit -1
+endif
+
+# Preserve a copy of this script as it was run.
+if ($?LSB_JOBNAME) then
+ # This only works if the job name in the BSUB or PBS directives
+ # is the name of this script.
+ setenv setup_file_name $LSB_JOBNAME
+else if ($?PBS_JOBNAME) then
+ setenv setup_file_name $PBS_JOBNAME
+else
+ setenv setup_file_name = $0:t
+endif
+${COPY} -n $setup_file_name ${caseroot}/${setup_file_name}.original
+
+
+# ==============================================================================
+# Configure the case.
+# ==============================================================================
+
+cd ${caseroot}
+
+# source ./Tools/ccsm_getenv || exit -2
+setenv TEST_MPI `./xmlquery MPI_RUN_COMMAND --value`
+setenv CLM_CONFIG_OPTS `./xmlquery CLM_CONFIG_OPTS --value`
+# setenv BATCHSUBMIT `./xmlquery BATCHSUBMIT --value`
+# setenv BATCH_SYSTEM `./xmlquery BATCHSUBMIT --value`
+setenv BATCH_SYSTEM 'manually'
+setenv MAX_TASKS_PER_NODE `./xmlquery MAX_TASKS_PER_NODE --value`
+setenv COMP_OCN `./xmlquery COMP_OCN --value`
+setenv CASEROOT `./xmlquery CASEROOT --value`
+
+# Make sure the case is configured with a data ocean.
+
+if ( ${COMP_OCN} != docn ) then
+ echo " "
+ echo "ERROR: This setup script is not appropriate for active ocean compsets."
+ echo "ERROR: Please use the models/CESM/shell_scripts examples for that case."
+ echo " "
+ exit -3
+endif
+
+# Save a copy for debug purposes
+foreach FILE ( *xml )
+ if ( ! -e ${FILE}.original ) then
+ ${COPY} -n $FILE ${FILE}.original
+ endif
+end
+
+# NOTE: If you require bit-for-bit agreement between different runs,
+# in particular, between pmo (single instance) and assimilations (NINST > 1),
+# or if you need to change the number of nodes/member due to changing memory needs,
+# then env_run.xml:BFBFLAG must be set to TRUE, so that the coupler will
+# generate bit-for-bit identical results, regardless of the number of tasks
+# given to it. The time penalty appears to be ~ 0.5% in the forecast.
+# Alternatively, you can set cpl_tasks = same_number in both experiments
+
+# Task layout:
+# Set the nodes_per_instance below to match your case. If you get 'out of memory'
+# errors OR failures without any messages, try increasing the nodes_per_instance.
+# By computing task counts like we do below, we guarantee each instance uses
+# a whole number of nodes which is the recommended configuration.
+
+# @ nodes_per_instance = 10
+@ nodes_per_instance = 3
+@ ntasks_active = -1 * $nodes_per_instance
+@ ntasks_data = -1
+
+./xmlchange ROOTPE_ATM=0,NTHRDS_ATM=$nthreads,NTASKS_ATM=$ntasks_active
+./xmlchange ROOTPE_LND=0,NTHRDS_LND=$nthreads,NTASKS_LND=$ntasks_active
+./xmlchange ROOTPE_ICE=0,NTHRDS_ICE=$nthreads,NTASKS_ICE=$ntasks_active
+./xmlchange ROOTPE_ROF=0,NTHRDS_ROF=$nthreads,NTASKS_ROF=$ntasks_active
+./xmlchange ROOTPE_OCN=0,NTHRDS_OCN=$nthreads,NTASKS_OCN=$ntasks_active
+./xmlchange ROOTPE_GLC=0,NTHRDS_GLC=$nthreads,NTASKS_GLC=$ntasks_active
+./xmlchange ROOTPE_WAV=0,NTHRDS_WAV=$nthreads,NTASKS_WAV=$ntasks_active
+./xmlchange ROOTPE_CPL=0,NTHRDS_CPL=$nthreads,NTASKS_CPL=$ntasks_active
+./xmlchange ROOTPE_ESP=0,NTHRDS_ESP=$nthreads,NTASKS_ESP=$ntasks_data
+
+
+
+./xmlchange RUN_TYPE=startup
+./xmlchange RUN_STARTDATE=${start_year}-${start_month}-${start_day}
+./xmlchange START_TOD=$start_tod
+# ./xmlchange RUN_REFCASE=$refcase
+# ./xmlchange RUN_REFDATE=$refdate
+# ./xmlchange RUN_REFTOD=$reftod
+# ./xmlchange BRNCH_RETAIN_CASENAME=FALSE
+./xmlchange GET_REFCASE=FALSE
+./xmlchange EXEROOT=${cime_output}/bld
+./xmlchange RUNDIR=${cime_output}/run
+
+./xmlchange SSTICE_DATA_FILENAME=$sst_dataset
+./xmlchange SSTICE_GRID_FILENAME=$sst_grid
+./xmlchange SSTICE_YEAR_ALIGN=$sst_year_start
+./xmlchange SSTICE_YEAR_START=$sst_year_start
+./xmlchange SSTICE_YEAR_END=$sst_year_end
+
+
+./xmlchange CALENDAR=GREGORIAN
+./xmlchange CONTINUE_RUN=FALSE
+
+./xmlchange STOP_OPTION=$stop_option
+./xmlchange STOP_N=$stop_n
+./xmlchange RESUBMIT=$resubmit
+
+./xmlchange PIO_TYPENAME=pnetcdf
+
+setenv COMP_OCN `./xmlquery COMP_OCN --value`
+setenv COMP_GLC `./xmlquery COMP_GLC --value`
+setenv COMP_ROF `./xmlquery COMP_ROF --value`
+
+# The river transport model ON is useful only when using an active ocean or
+# land surface diagnostics. Setting ROF_GRID, RTM_MODE to 'null' turns off the RTM.
+#
+# The river transport model ON is useful only when using an active ocean or
+# land surface diagnostics. If you turn it ON, you will have to stage initial files etc.
+# There are 3 choices:
+# > a stub version (best for CAM+DART),
+# > the older River Transport Model (RTM),
+# > the new Model for Scale Adaptive River Transport (MOSART).
+# They are separate CESM components, and are/need to be specified in the compset.
+# It may be that RTM or MOSART can be turned off via namelists.
+# Specify the river runoff model: 'RTM', 'MOSART', or anything else.
+
+if (${COMP_ROF} == 'rtm') then
+ ./xmlchange ROF_GRID='r05'
+else if (${COMP_ROF} == 'mosart') then
+ # There seems to be no MOSART_MODE, but there are some MOSART_ xml variables.
+ # Use defaults for now
+ ./xmlchange ROF_GRID='r05'
+else if (${COMP_ROF} == 'drof') then
+ ./xmlchange ROF_GRID='null'
+else if (${COMP_ROF} == 'srof') then
+ ./xmlchange ROF_GRID='null'
+else
+ echo "river_runoff is ${COMP_ROF}, which is not supported"
+ exit 50
+endif
+
+# COUPLING discussion. F compsets are 'tight' coupling.
+# Only change the ATM_NCPL ... everything is based on this one value,
+# including CAM physics and dynamics timesteps.
+# Default values for coupling are preserved in env_run.xml.original
+
+./xmlchange NCPL_BASE_PERIOD=day
+./xmlchange ATM_NCPL=48
+
+# CAM physics (etc.) selection for non-default choices.
+# ./xmlchange CAM_CONFIG_OPTS="-phys cam5.4 -club_sgs"
+# ./xmlchange CAM_CONFIG_OPTS="-phys cam4"
+# setenv CAM_CONFIG_OPTS `./xmlquery CAM_CONFIG_OPTS --value`
+# echo $CAM_CONFIG_OPTS | grep 'cam4'
+
+# CLMBuildNamelist::setup_logic_initial_conditions() :
+# using ignore_ic_date is incompatable with crop!
+# If you choose to ignore this error, the counters since planting for crops will be messed up.
+# -- Add -ignore_warnings option to CLM_BLDNML_OPTS to ignore this warning
+echo $compset | grep 'CROP'
+if ($status == 0) then
+ setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+ set clm_opts = "$CLM_BLDNML_OPTS -ignore_warnings "
+ ./xmlchange CLM_BLDNML_OPTS="$clm_opts"
+ # DEBUG/confirm
+ setenv CLM_BLDNML_OPTS `./xmlquery CLM_BLDNML_OPTS --value`
+ echo "CLM_BLDNML_OPTS has been changed to $CLM_BLDNML_OPTS"
+endif
+
+# These are archiving options that may be used.
+# You can turn the short/long term archivers on or off,
+# but these settings should be made in either event.
+
+./xmlchange DOUT_S_ROOT=${archdir}
+./xmlchange DOUT_S_SAVE_INTERIM_RESTART_FILES=TRUE
+
+if ($short_term_archiver == 'off') then
+ ./xmlchange DOUT_S=FALSE
+else
+ ./xmlchange DOUT_S=TRUE
+endif
+
+# DEBUG = TRUE implies turning on run and compile time debugging.
+# INFO_DBUG level of debug output, 0=minimum, 1=normal, 2=more, 3=too much.
+# WARNING: CAM-SE fails if DEBUG=TRUE
+./xmlchange DEBUG=FALSE
+./xmlchange INFO_DBUG=0
+# Reduce the MPI activity messages. 2 = default (too much).
+# ATM_forcXX: not in the config_definition file: ./xmlchange MP_INFOLEVEL=0
+
+
+# ==============================================================================
+# Update source files.
+# Ideally, using DART would not require any modifications to the model source.
+# Until then, this script accesses sourcemods from a hardwired location.
+# If you have additional sourcemods, they will need to be merged into any DART
+# mods and put in the SourceMods subdirectory found in the 'caseroot' directory.
+# ==============================================================================
+
+if ( ! -d ~/${cesmtag}/SourceMods ) then
+ echo "NOTE - No SourceMods for this case."
+ echo "NOTE - No SourceMods for this case."
+ echo "CONFIRM that DART does not require modifications to several src files."
+endif
+
+# Copy all of the 'generic' SourceMods
+${COPY} -r ~/${cesmtag}/SourceMods/* ${caseroot}/SourceMods/ || exit 2
+
+# ==============================================================================
+# Set up the case.
+# This creates the EXEROOT and RUNDIR directories.
+# ==============================================================================
+
+echo 'Setting up the case ...'
+
+./case.setup
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be set up."
+ exit -2
+endif
+
+# ==============================================================================
+# Edit the run script to reflect queue and wallclock
+# ==============================================================================
+
+echo ''
+echo 'Updating the run script to set wallclock and queue.'
+echo ''
+
+
+# ===========================================================================
+set fname = "user_nl_cam"
+
+echo " inithist = 'MONTHLY'" >> ${fname}
+echo " empty_htapes = .true. " >> ${fname}
+
+# ATM_forc change: new topography file from Lauritzen
+# echo "bnd_topo = " >> ${fname}
+# Trouble with masks: can't use the gx1v6 CLM restart file as finidat.
+# It needs to be interpolated to make the gridcell value consistent.
+if ($start_year > 2014) then
+
+ set cesm_data_dir = "/glade/p/cesmdata/cseg/inputdata/atm"
+ set cesm_chem_dir = "/gpfs/fs1/p/acom/acom-climate/cmip6inputs/emissions_ssp119"
+ set chem_root = "${cesm_chem_dir}/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp119-1-1"
+ set chem_dates = "175001-210012_0.9x1.25_c20181024"
+
+# Default: H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'," >> ${fname}
+# Try a file with enough years (but questionable content from
+# /glade/scratch/mmills/CH4/CCMI_1955_2099_RCP6_ave_CH4_CHML.nc):
+ echo " ext_frc_specifier = " >> ${fname}
+ echo " 'H2O -> ${cesm_data_dir}/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_1850-2100_CCMI_RCP8_5_c160219.nc'" >> ${fname}
+
+ echo " 'num_a1 -> ${chem_root}_num_so4_a1_anthro-ene_vertical_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'so4_a1 -> ${chem_root}_so4_a1_anthro-ene_vertical_mol_${chem_dates}.nc'" >> ${fname}
+
+ echo " srf_emis_specifier =" >> ${fname}
+ echo " 'bc_a4 -> ${chem_root}_bc_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'bc_a4 -> ${chem_root}_bc_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'DMS -> ${chem_root}_DMS_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'DMS -> ${cesm_chem_dir}/emissions-cmip6-SSP_DMS_other_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a1 -> ${chem_root}_num_so4_a1_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a1 -> ${chem_root}_num_so4_a1_anthro-ag-ship_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a2 -> ${chem_root}_num_so4_a2_anthro-res_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_bc_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_bc_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_pom_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'num_a4 -> ${chem_root}_num_pom_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'pom_a4 -> ${chem_root}_pom_a4_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'pom_a4 -> ${chem_root}_pom_a4_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SO2 -> ${chem_root}_SO2_anthro-ag-ship-res_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SO2 -> ${chem_root}_SO2_anthro-ene_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SO2 -> ${chem_root}_SO2_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'so4_a1 -> ${chem_root}_so4_a1_anthro-ag-ship_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'so4_a2 -> ${chem_root}_so4_a2_anthro-res_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SOAG -> ${chem_root}_SOAGx1.5_anthro_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SOAG -> ${chem_root}_SOAGx1.5_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+ echo " 'SOAG -> ${chem_root}_SOAGx1.5_biogenic_surface_mol_${chem_dates}.nc'" >> ${fname}
+# echo " 'SOAG -> ${chem_root}_SOAGx1.5_biogenic_surface_mol_201501-210012_0.9x1.25_c20181024.nc'" >> ${fname}
+ echo " 'so4_a1 -> ${chem_root}_so4_a1_bb_surface_mol_${chem_dates}.nc'" >> ${fname}
+
+# Queried Mike Mills 2018-12-3
+# He says; not available, and won't be
+# Try using the default file, but with cyclical trace gases, year 2014 (the last full).
+ echo " prescribed_ozone_type = 'CYCLICAL'" >> ${fname}
+ echo " prescribed_ozone_cycle_yr = 2014" >> ${fname}
+ echo " prescribed_strataero_type = 'CYCLICAL'" >> ${fname}
+ echo " prescribed_strataero_cycle_yr = 2014" >> ${fname}
+# tracer_cnst_datapath = '${cesm_data_dir}/cam/tracer_cnst'"
+# tracer_cnst_file = 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'
+ echo " tracer_cnst_type = 'CYCLICAL'" >> ${fname}
+ echo " tracer_cnst_cycle_yr = 2015" >> ${fname}
+# &chem_surfvals_nl
+# flbc_file = "${cesm_data_dir}/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc"
+ echo " flbc_type = 'CYCLICAL'" >> ${fname}
+ echo " flbc_cycle_yr = 2014" >> ${fname}
+ echo " flbc_file = '${cesm_data_dir}/waccm/lb/LBC_17500116-20150116_CMIP6_0p5degLat_c180905.nc' " >> ${fname}
+
+else
+ echo 'WARNING; using default ozone and tracer_cnst forcing files'
+ echo 'WARNING; using default srf_emis_* and ext_frc_*'
+ echo "WARNING; using default bndtvghg"
+ echo "WARNING; using default volcaero"
+endif
+
+# ===========================================================================
+set fname = "user_nl_clm"
+
+echo "use_init_interp = .true. " >> ${fname}
+echo "init_interp_fill_missing_with_natveg = .true. " >> ${fname}
+
+# For cesm2_1 and later, finidat does not need to be specified.
+# set lnd_init = $cesmdata/lnd/clm2/initdata_map
+# 1 degree
+# echo "finidat = '$lnd_init/clmi.I2000CLM45CRUBGC.2000-01-01.0.9x1.25_gx1v6_simyr2000_c141226.nc'" >> ${fname}
+# Guessing that the latest (2 degree) is the greatest:
+# echo "finidat = '$lnd_init/clmi.ICRUCLM45BGCCROP.78pfts.levis_reinterp.1.9x2.5_g1v6_simyr2000_c160127.nc '" >> ${fname}
+# In CAM6_spinup_sst.25 I ended up using(?)
+# /glade/p/cgd/tss/people/oleson/CLM5_restarts/
+# clm5n04r193phs_2deg_calibrateparams_v3_crop_fert10perc_medshrb_1850ADspin_cism2_1_23.clm2.r.0003-01-01-00000.nc
+
+# If interpolation is necessary, the file name of the interpolated fields is automatic, even for multi-instance.
+
+echo "hist_empty_htapes = .true." >> ${fname}
+echo "hist_fincl1 = 'TSA'" >> ${fname}
+# echo "hist_nhtfrq = -$stop_n" >> ${fname}
+# Every month
+echo "hist_mfilt = 1" >> ${fname}
+echo "hist_nhtfrq = 0" >> ${fname}
+
+# ATM_forcXX Test coupler forcing file output
+# ===========================================================================
+set fname = "user_nl_cpl"
+
+# J1850G(lofverstrom) + river (Lindsay)
+echo " histaux_a2x3hr = .true." >> ${fname}
+echo " histaux_a2x24hr = .true." >> ${fname}
+echo " histaux_a2x1hri = .true." >> ${fname}
+echo " histaux_a2x1hr = .true." >> ${fname}
+echo " histaux_r2x = .true." >> ${fname}
+# AVGHIST* controls the writing of *cpl.ha.*, which is not needed for forcing other components.
+# ./xmlchange AVGHIST_OPTION=ndays
+# ./xmlchange AVGHIST_N=1
+# No histaux_a2x3hrp (precip)?
+# No histaux_l2x ?
+
+./preview_namelists || exit 150
+
+# ==============================================================================
+# build
+# ==============================================================================
+
+echo ''
+echo 'Building the case'
+echo ''
+
+# --skip-provenance-check because of svn or git timing out during build
+# of CLM. It wanted authentication(?) to access a private repository.
+# A better solution would be to find out why(whether) it thinks CLM is
+# a private repository.
+./case.build --skip-provenance-check
+
+if ( $status != 0 ) then
+ echo "ERROR: Case could not be built."
+ exit 200
+endif
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/shell_scripts/cesm2_1/standalone.pbs b/models/cam-fv/shell_scripts/cesm2_1/standalone.pbs
new file mode 100755
index 0000000000..0286a73923
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/standalone.pbs
@@ -0,0 +1,100 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+#
+#PBS -N bob
+#PBS -A P86850054
+#PBS -j oe
+#PBS -q premium
+#PBS -m ae
+#PBS -l walltime=00:20:00
+#PBS -l select=3:mpiprocs=36:ncpus=36
+#### -l select=240:mpiprocs=36:ncpus=36:mem=109GB
+#### -l select=240:mpiprocs=36:ncpus=36:mem=45GB
+
+module list
+
+setenv OMP_STACKSIZE 256M
+setenv OMP_NUM_THREADS 1
+setenv TMPDIR /glade/scratch/${USER}
+setenv MPI_TYPE_DEPTH 16
+setenv MPI_IB_CONGESTED 1
+setenv MPIEXEC_MPT_DEBUG 0
+setenv MP_DEBUG_NOTIMEOUT yes
+
+set CASEDIR = /glade/work/${USER}/cases/cesm2.1.0/start_6Z
+set RUNDIR = /glade/scratch/${USER}/cesm2.1.0/start_6Z/standalone
+
+cd $RUNDIR
+
+#----------------------------------------------------------------------------
+# Harvest some information from the environment to construct output file name
+
+set jobname = $PBS_JOBNAME
+set numcpus = $NCPUS
+set numtasks = `cat $PBS_NODEFILE | wc -l`
+set numnodes = `uniq $PBS_NODEFILE | wc -l`
+
+echo "jobname is $jobname"
+echo "numcpus is $numcpus"
+echo "numtasks is $numtasks"
+echo "numnodes is $numnodes"
+
+#----------------------------------------------------------------------------
+# Running filter inheriting all mpi options from environment
+
+set my_output_file = ${jobname}_${numnodes}_simple.out
+
+echo "Running test 1 at `date`, saving output to ${my_output_file}"
+
+cat input.nml >! ${my_output_file}
+env | sort >> ${my_output_file}
+echo " " >> ${my_output_file}
+echo "Starting filter at "`date`
+mpiexec_mpt ./filter >>& ${my_output_file}
+echo "Finished filter at "`date`
+
+echo "TJH skipping all other tests ..."
+exit
+
+#----------------------------------------------------------------------------
+# Running filter with some options used by CESM
+
+set my_output_file = ${jobname}_${numnodes}_omplace.out
+
+echo "Running test 2 at `date`, saving output to ${my_output_file}"
+
+cat input.nml >! ${my_output_file}
+env | sort >> ${my_output_file}
+echo " " >> ${my_output_file}
+echo "Starting filter_omplace at "`date`
+mpiexec_mpt omplace -tm open64 ./filter >>& ${my_output_file}
+echo "Finished filter_omplace at "`date`
+
+#----------------------------------------------------------------------------
+# Running the whole assimilate.csh script in a manner consistent with CESM
+
+cd $CASEDIR
+
+set my_output_file = ${jobname}_${numnodes}_standalone_assim.out
+
+echo "Running test 3 at `date`, saving output to ${my_output_file}"
+
+cat input.nml >! ${my_output_file}
+env | sort >> ${my_output_file}
+echo " " >> ${my_output_file}
+echo "Starting assimilate.csh at "`date`
+./test_assimilate.csh $CASEDIR 0 >>& ${my_output_file}
+echo "Finished assimilate.csh at "`date`
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/shell_scripts/cesm2_1/test_assimilate.csh b/models/cam-fv/shell_scripts/cesm2_1/test_assimilate.csh
new file mode 100755
index 0000000000..ca3158fe51
--- /dev/null
+++ b/models/cam-fv/shell_scripts/cesm2_1/test_assimilate.csh
@@ -0,0 +1,695 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+# ---------------------
+# Purpose
+# ---------------------
+# This template is lightly modified by the setup scripts to be appropriate
+# for specific hardware and other configurations. The modified result is
+# then given execute permission and is appropriate to use for an assimilation.
+# All of this is automatically performed by the DART-supplied setup scripts.
+#
+# Tag DART's state output with names using CESM's convention:
+# ${case}.${scomp}[_$inst].${filetype}[.$dart_file].${date}.nc
+# These should all be named with $scomp = "cam" to distinguish
+# them from the same output from other components in multi-component assims.
+
+# machine-specific dereferencing
+if ($?SLURM_JOB_ID) then
+
+ # SLURM environment variables:
+ # env | grep SLURM | sort
+
+ setenv ORIGINALDIR $SLURM_SUBMIT_DIR
+ setenv JOBNAME $SLURM_JOB_NAME
+ setenv JOBID $SLURM_JOBID
+ setenv MYQUEUE $SLURM_JOB_PARTITION
+ setenv NODENAMES $SLURM_NODELIST
+ setenv LAUNCHCMD "mpirun -np $SLURM_NTASKS -bind-to core"
+
+else if ($?PBS_NODEFILE) then
+
+ # PBS environment variables:
+ # env | grep PBS | sort
+
+ setenv ORIGINALDIR $PBS_O_WORKDIR
+ setenv JOBNAME $PBS_JOBNAME
+ setenv JOBID $PBS_JOBID
+ setenv MYQUEUE $PBS_O_QUEUE
+ setenv NUMCPUS $NCPUS
+ setenv NUMTASKS `cat $PBS_NODEFILE | wc -l`
+ setenv NUMNODES `uniq $PBS_NODEFILE | wc -l`
+ setenv MPIEXEC_MPT_DEBUG 0
+ setenv MP_DEBUG_NOTIMEOUT yes
+ setenv LAUNCHCMD mpiexec_mpt
+
+ echo "jobname is $JOBNAME"
+ echo "numcpus is $NUMCPUS"
+ echo "numtasks is $NUMTASKS"
+ echo "numnodes is $NUMNODES"
+
+else if ($?LSB_HOSTS) then
+
+ # LSF environment variables:
+ # env | grep LS | grep -v LS_COLORS | sort
+
+ setenv ORIGINALDIR $LS_SUBCWD
+ setenv JOBNAME $LSB_OUTPUTFILE:ar
+ setenv JOBID $LSB_JOBID
+ setenv MYQUEUE $LSB_QUEUE
+ setenv NODENAMES ${LSB_HOSTS}
+ setenv MP_DEBUG_NOTIMEOUT yes
+ setenv LAUNCHCMD mpirun.lsf
+
+endif
+
+#=========================================================================
+# Block 0: Set command environment
+#=========================================================================
+# This block is an attempt to localize all the machine-specific
+# changes to this script such that the same script can be used
+# on multiple platforms. This will help us maintain the script.
+
+echo "`date` -- BEGIN CAM_ASSIMILATE"
+pwd
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+setenv CASEROOT $1
+# Python uses C indexing on loops; cycle = [0,....,$DATA_ASSIMILATION_CYCLES - 1]
+# "Fix" that here, so the rest of the script isn't confusing.
+@ cycle = $2 + 1
+
+cd ${CASEROOT}
+
+setenv scomp `./xmlquery COMP_ATM --value`
+setenv CASE `./xmlquery CASE --value`
+setenv ensemble_size `./xmlquery NINST_ATM --value`
+setenv CAM_DYCORE `./xmlquery CAM_DYCORE --value`
+setenv EXEROOT `./xmlquery EXEROOT --value`
+setenv RUNDIR `./xmlquery RUNDIR --value`
+setenv archive `./xmlquery DOUT_S_ROOT --value`
+setenv TOTALPES `./xmlquery TOTALPES --value`
+setenv CONT_RUN `./xmlquery CONTINUE_RUN --value`
+setenv TASKS_PER_NODE `./xmlquery NTASKS_ESP --value`
+setenv DATA_ASSIMILATION_CYCLES `./xmlquery DATA_ASSIMILATION_CYCLES --value`
+
+cd $RUNDIR
+
+# A switch to save all the inflation files
+setenv save_all_inf TRUE
+if (! -d $archive/esp/hist) mkdir -p $archive/esp/hist
+
+# A switch to signal how often to save the stages' ensemble members: NONE, RESTART_TIMES, ALL
+# Mean and sd will always be saved.
+setenv save_stages_freq RESTART_TIMES
+
+set BASEOBSDIR = /glade/p/cisl/dares/Observations/NCEP+ACARS+GPS
+
+# ==============================================================================
+# standard commands:
+#
+# Make sure that this script is using standard system commands
+# instead of aliases defined by the user.
+# If the standard commands are not in the location listed below,
+# change the 'set' commands to use them.
+# The FORCE options listed are required.
+# The VERBOSE options are useful for debugging, but are optional because
+# some systems don't like the -v option to any of the following.
+# ==============================================================================
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+set MOVE = '/usr/bin/mv -f'
+set COPY = '/usr/bin/cp -f --preserve=timestamps'
+set LINK = '/usr/bin/ln -fs'
+set LIST = '/usr/bin/ls '
+set REMOVE = '/usr/bin/rm -fvr'
+
+#=========================================================================
+# Block 1: Populate a run-time directory with the input needed to run DART.
+#=========================================================================
+
+echo "`date` -- BEGIN COPY BLOCK"
+
+# Put a pared down copy (no comments) of input.nml in this assimilate_cam directory.
+# The contents may change from one cycle to the next, so always start from
+# the known configuration in the CASEROOT directory.
+
+if ( -e ${CASEROOT}/input.nml ) then
+
+ sed -e "/#/d;/^\!/d;/^[ ]*\!/d" \
+ -e '1,1i\WARNING: Changes to this file will be ignored. \n Edit \$CASEROOT/input.nml instead.\n\n\n' \
+ ${CASEROOT}/input.nml >! input.nml || exit 20
+else
+ echo "ERROR ... DART required file ${CASEROOT}/input.nml not found ... ERROR"
+ echo "ERROR ... DART required file ${CASEROOT}/input.nml not found ... ERROR"
+ exit 21
+endif
+
+echo "`date` -- END COPY BLOCK"
+
+# If possible, use the round-robin approach to deal out the tasks.
+# This facilitates using multiple nodes for the simultaneous I/O operations.
+
+if ($?TASKS_PER_NODE) then
+ if ($#TASKS_PER_NODE > 0) then
+ ${MOVE} input.nml input.nml.$$
+ sed -e "s#layout.*#layout = 2#" \
+ -e "s#tasks_per_node.*#tasks_per_node = $TASKS_PER_NODE#" \
+ input.nml.$$ >! input.nml || exit 30
+ ${REMOVE} input.nml.$$
+ endif
+endif
+
+#=========================================================================
+# Block 2: Identify requested output stages, to warn about redundant output.
+#=========================================================================
+
+set MYSTRING = `grep stages_to_write input.nml`
+set MYSTRING = (`echo $MYSTRING | sed -e "s#[=,'\.]# #g"`)
+set STAGE_input = FALSE
+set STAGE_forecast = FALSE
+set STAGE_preassim = FALSE
+set STAGE_postassim = FALSE
+set STAGE_analysis = FALSE
+set STAGE_output = FALSE
+
+# Assemble lists of stages to write out, which are not the 'output' stage.
+
+set stages_except_output = "{"
+@ stage = 2
+while ($stage <= $#MYSTRING)
+ if ($MYSTRING[$stage] == 'input') then
+ set STAGE_input = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}input"
+ endif
+ if ($MYSTRING[$stage] == 'forecast') then
+ set STAGE_forecast = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}forecast"
+ endif
+ if ($MYSTRING[$stage] == 'preassim') then
+ set STAGE_preassim = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}preassim"
+ endif
+ if ($MYSTRING[$stage] == 'postassim') then
+ set STAGE_postassim = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}postassim"
+ endif
+ if ($MYSTRING[$stage] == 'analysis') then
+ set STAGE_analysis = TRUE
+ if ($stage > 2) set stages_except_output = "${stages_except_output},"
+ set stages_except_output = "${stages_except_output}analysis"
+ endif
+ if ($stage == $#MYSTRING) then
+ set stages_all = "${stages_except_output}"
+ if ($MYSTRING[$stage] == 'output') then
+ set STAGE_output = TRUE
+ set stages_all = "${stages_all},output"
+ endif
+ endif
+ @ stage++
+end
+
+# Add the closing }
+set stages_all = "${stages_all}}"
+set stages_except_output = "${stages_except_output}}"
+
+# Checking
+echo "stages_except_output = $stages_except_output"
+echo "stages_all = $stages_all"
+if ($STAGE_output != TRUE) then
+ echo "ERROR: assimilate.csh requires that input.nml:filter_nml:stages_to_write includes stage 'output'"
+ exit 40
+endif
+
+#=========================================================================
+# Block 3: Preliminary clean up, which can run in the background.
+#=========================================================================
+
+#=========================================================================
+# Block 4: Determine time of model state
+#=========================================================================
+# ... from file name of first member
+# of the form "./${CASE}.cam_${ensemble_member}.i.2000-01-06-00000.nc"
+#
+# Piping stuff through 'bc' strips off any preceeding zeros.
+#-------------------------------------------------------------------------
+
+set FILE = `head -n 1 rpointer.atm_0001`
+set FILE = $FILE:r
+set ATM_DATE_EXT = `echo $FILE:e`
+set ATM_DATE = `echo $FILE:e | sed -e "s#-# #g"`
+set ATM_YEAR = `echo $ATM_DATE[1] | bc`
+set ATM_MONTH = `echo $ATM_DATE[2] | bc`
+set ATM_DAY = `echo $ATM_DATE[3] | bc`
+set ATM_SECONDS = `echo $ATM_DATE[4] | bc`
+set ATM_HOUR = `echo $ATM_DATE[4] / 3600 | bc`
+
+echo "valid time of model is $ATM_YEAR $ATM_MONTH $ATM_DAY $ATM_SECONDS (seconds)"
+echo "valid time of model is $ATM_YEAR $ATM_MONTH $ATM_DAY $ATM_HOUR (hours)"
+
+#-----------------------------------------------------------------------------
+# Get observation sequence file ... or die right away.
+# The observation file names have a time that matches the stopping time of CAM.
+#-----------------------------------------------------------------------------
+# Make sure the file name structure matches the obs you will be using.
+# PERFECT model obs output appends .perfect to the filenames
+
+set YYYYMM = `printf %04d%02d ${ATM_YEAR} ${ATM_MONTH}`
+if (! -d ${BASEOBSDIR}/${YYYYMM}_6H_CESM) then
+ echo "CESM+DART requires 6 hourly obs_seq files in directories of the form YYYYMM_6H_CESM"
+ echo "The directory ${BASEOBSDIR}/${YYYYMM}_6H_CESM is not found. Exiting"
+ exit 60
+endif
+
+set OBSFNAME = `printf obs_seq.%04d-%02d-%02d-%05d ${ATM_YEAR} ${ATM_MONTH} ${ATM_DAY} ${ATM_SECONDS}`
+
+set OBS_FILE = ${BASEOBSDIR}/${YYYYMM}_6H_CESM/${OBSFNAME}
+echo "OBS_FILE = $OBS_FILE"
+
+if ( -e ${OBS_FILE} ) then
+ ${LINK} ${OBS_FILE} obs_seq.out
+else
+ echo "ERROR ... no observation file ${OBS_FILE}"
+ echo "ERROR ... no observation file ${OBS_FILE}"
+ exit 70
+endif
+
+#=========================================================================
+# Block 5: DART INFLATION
+# This block is only relevant if 'inflation' is turned on AND
+# inflation values change through time:
+# filter_nml
+# inf_flavor(:) = 2 (or 3 (or 4 for posterior))
+# inf_initial_from_restart = .TRUE.
+# inf_sd_initial_from_restart = .TRUE.
+#
+# This block stages the files that contain the inflation values.
+# The inflation files are essentially duplicates of the DART model state,
+# which have names in the CESM style, something like
+# ${case}.dart.rh.${scomp}_output_priorinf_{mean,sd}.YYYY-MM-DD-SSSSS.nc
+# The strategy is to use the latest such files in $rundir.
+# If those don't exist at the start of an assimilation,
+# this block creates them with 'fill_inflation_restart'.
+# If they don't exist AFTER the first cycle, the script will exit
+# because they should have been available from a previous cycle.
+# The script does NOT check the model date of the files for consistency
+# with the current forecast time, so check that the inflation mean
+# files are evolving as expected.
+#
+# CESM's st_archive should archive the inflation restart files
+# like any other "restart history" (.rh.) files; copying the latest files
+# to the archive directory, and moving all of the older ones.
+#=========================================================================
+
+# If we need to run fill_inflation_restart, CAM:static_init_model()
+# always needs a caminput.nc and a cam_phis.nc for geometry information, etc.
+
+set MYSTRING = `grep cam_template_filename input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+set CAMINPUT = $MYSTRING[2]
+${LINK} ${CASE}.cam_0001.i.${ATM_DATE_EXT}.nc $CAMINPUT
+
+# All of the .h0. files contain the same PHIS field, so we can link to any of them.
+
+set hists = `${LIST} ${CASE}.cam_0001.h0.*.nc`
+set MYSTRING = `grep cam_phis_filename input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+${LINK} $hists[1] $MYSTRING[2]
+
+# Now, actually check the inflation settings
+
+set MYSTRING = `grep inf_flavor input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,'\.]# #g"`
+set PRIOR_INF = $MYSTRING[2]
+set POSTE_INF = $MYSTRING[3]
+
+set MYSTRING = `grep inf_initial_from_restart input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,'\.]# #g"`
+
+# If no inflation is requested, the inflation restart source is ignored
+
+if ( $PRIOR_INF == 0 ) then
+ set PRIOR_INFLATION_FROM_RESTART = ignored
+ set USING_PRIOR_INFLATION = false
+else
+ set PRIOR_INFLATION_FROM_RESTART = `echo $MYSTRING[2] | tr '[:upper:]' '[:lower:]'`
+ set USING_PRIOR_INFLATION = true
+endif
+
+if ( $POSTE_INF == 0 ) then
+ set POSTE_INFLATION_FROM_RESTART = ignored
+ set USING_POSTE_INFLATION = false
+else
+ set POSTE_INFLATION_FROM_RESTART = `echo $MYSTRING[3] | tr '[:upper:]' '[:lower:]'`
+ set USING_POSTE_INFLATION = true
+endif
+
+if ($USING_PRIOR_INFLATION == false ) then
+ set stages_requested = 0
+ if ( $STAGE_input == TRUE ) @ stages_requested++
+ if ( $STAGE_forecast == TRUE ) @ stages_requested++
+ if ( $STAGE_preassim == TRUE ) @ stages_requested++
+ if ( $stages_requested > 1 ) then
+ echo " "
+ echo "WARNING ! ! Redundant output is requested at multiple stages before assimilation."
+ echo " Stages 'input' and 'forecast' are always redundant."
+ echo " Prior inflation is OFF, so stage 'preassim' is also redundant. "
+ echo " We recommend requesting just 'preassim'."
+ echo " "
+ endif
+endif
+
+if ($USING_POSTE_INFLATION == false ) then
+ set stages_requested = 0
+ if ( $STAGE_postassim == TRUE ) @ stages_requested++
+ if ( $STAGE_analysis == TRUE ) @ stages_requested++
+ if ( $STAGE_output == TRUE ) @ stages_requested++
+ if ( $stages_requested > 1 ) then
+ echo " "
+ echo "WARNING ! ! Redundant output is requested at multiple stages after assimilation."
+ echo " Stages 'output' and 'analysis' are always redundant."
+ echo " Posterior inflation is OFF, so stage 'postassim' is also redundant. "
+ echo " We recommend requesting just 'output'."
+ echo " "
+ endif
+endif
+
+# IFF we want PRIOR inflation:
+
+if ($USING_PRIOR_INFLATION == true) then
+ if ($PRIOR_INFLATION_FROM_RESTART == false) then
+
+ echo "inf_flavor(1) = $PRIOR_INF, using namelist values."
+
+ else
+ # Look for the output from the previous assimilation (or fill_inflation_restart)
+ # If inflation files exists, use them as input for this assimilation
+ (${LIST} -rt1 *.dart.rh.${scomp}_output_priorinf_mean* | tail -n 1 >! latestfile) > & /dev/null
+ (${LIST} -rt1 *.dart.rh.${scomp}_output_priorinf_sd* | tail -n 1 >> latestfile) > & /dev/null
+ set nfiles = `cat latestfile | wc -l`
+
+ if ( $nfiles > 0 ) then
+
+ set latest_mean = `head -n 1 latestfile`
+ set latest_sd = `tail -n 1 latestfile`
+ # Need to COPY instead of link because of short-term archiver and disk management.
+ ${COPY} $latest_mean input_priorinf_mean.nc
+ ${COPY} $latest_sd input_priorinf_sd.nc
+
+ else if ($CONT_RUN == FALSE) then
+
+ # It's the first assimilation; try to find some inflation restart files
+ # or make them using fill_inflation_restart.
+ # Fill_inflation_restart needs caminput.nc and cam_phis.nc for static_model_init,
+ # so this staging is done in assimilate.csh (after a forecast) instead of stage_cesm_files.
+
+ if (-x ${EXEROOT}/fill_inflation_restart) then
+
+ ${EXEROOT}/fill_inflation_restart
+ ${MOVE} prior_inflation_mean.nc input_priorinf_mean.nc
+ ${MOVE} prior_inflation_sd.nc input_priorinf_sd.nc
+
+ else
+ echo "ERROR: Requested PRIOR inflation restart for the first cycle."
+ echo " There are no existing inflation files available "
+ echo " and ${EXEROOT}/fill_inflation_restart is missing."
+ echo "EXITING"
+ exit 85
+ endif
+
+ else
+ echo "ERROR: Requested PRIOR inflation restart, "
+ echo ' but files *.dart.rh.${scomp}_output_priorinf_* do not exist in the $rundir.'
+ echo ' If you are changing from cam_no_assimilate.csh to assimilate.csh,'
+ echo ' you might be able to continue by changing CONTINUE_RUN = FALSE for this cycle,'
+ echo ' and restaging the initial ensemble.'
+ ${LIST} -l *inf*
+ echo "EXITING"
+ exit 90
+ endif
+ endif
+else
+ echo "Prior Inflation not requested for this assimilation."
+endif
+
+# POSTERIOR: We look for the 'newest' and use it - IFF we need it.
+
+if ($USING_POSTE_INFLATION == true) then
+ if ($POSTE_INFLATION_FROM_RESTART == false) then
+
+ # we are not using an existing inflation file.
+ echo "inf_flavor(2) = $POSTE_INF, using namelist values."
+
+ else
+ # Look for the output from the previous assimilation (or fill_inflation_restart).
+ # (The only stage after posterior inflation.)
+ (${LIST} -rt1 *.dart.rh.${scomp}_output_postinf_mean* | tail -n 1 >! latestfile) > & /dev/null
+ (${LIST} -rt1 *.dart.rh.${scomp}_output_postinf_sd* | tail -n 1 >> latestfile) > & /dev/null
+ set nfiles = `cat latestfile | wc -l`
+
+ # If one exists, use it as input for this assimilation
+ if ( $nfiles > 0 ) then
+
+ set latest_mean = `head -n 1 latestfile`
+ set latest_sd = `tail -n 1 latestfile`
+ ${LINK} $latest_mean input_postinf_mean.nc
+ ${LINK} $latest_sd input_postinf_sd.nc
+
+ else if ($CONT_RUN == FALSE) then
+ # It's the first assimilation; try to find some inflation restart files
+ # or make them using fill_inflation_restart.
+ # Fill_inflation_restart needs caminput.nc and cam_phis.nc for static_model_init,
+ # so this staging is done in assimilate.csh (after a forecast) instead of stage_cesm_files.
+
+ if (-x ${EXEROOT}/fill_inflation_restart) then
+ ${EXEROOT}/fill_inflation_restart
+ ${MOVE} prior_inflation_mean.nc input_postinf_mean.nc
+ ${MOVE} prior_inflation_sd.nc input_postinf_sd.nc
+
+ else
+ echo "ERROR: Requested POSTERIOR inflation restart for the first cycle."
+ echo " There are no existing inflation files available "
+ echo " and ${EXEROOT}/fill_inflation_restart is missing."
+ echo "EXITING"
+ exit 95
+ endif
+
+ else
+ echo "ERROR: Requested POSTERIOR inflation restart, "
+ echo ' but files *.dart.rh.${scomp}_output_postinf_* do not exist in the $rundir.'
+ ${LIST} -l *inf*
+ echo "EXITING"
+ exit 100
+ endif
+ endif
+else
+ echo "Posterior Inflation not requested for this assimilation."
+endif
+
+#=========================================================================
+# Block 6: Actually run the assimilation.
+
+# DART namelist settings required:
+# &filter_nml
+# adv_ens_command = "no_CESM_advance_script",
+# obs_sequence_in_name = 'obs_seq.out'
+# obs_sequence_out_name = 'obs_seq.final'
+# single_file_in = .false.,
+# single_file_out = .false.,
+# stages_to_write = stages you want + ,'output'
+# input_state_file_list = 'cam_init_files'
+# output_state_file_list = 'cam_init_files',
+
+# WARNING: the default mode of this script assumes that
+# input_state_file_list = output_state_file_list,
+# so the CAM initial files used as input to filter will be overwritten.
+# The input model states can be preserved by requesting that stage 'forecast'
+# be output.
+
+#=========================================================================
+
+# In the default mode of CAM assimilations, filter gets the model state(s)
+# from CAM initial files. This section puts the names of those files into a text file.
+# The name of the text file is provided to filter in filter_nml:input_state_file_list.
+
+# NOTE:
+# If the files in input_state_file_list are CESM initial files (all vars and
+# all meta data), then they will end up with a different structure than
+# the non-'output', stage output written by filter ('preassim', 'postassim', etc.).
+# This can be prevented (at the cost of more disk space) by copying
+# the CESM format initial files into the names filter will use for preassim, etc.:
+# > cp $case.cam_0001.i.$date.nc preassim_member_0001.nc.
+# > ... for all members
+# Filter will replace the state variables in preassim_member* with updated versions,
+# but leave the other variables and all metadata unchanged.
+
+# If filter will create an ensemble from a single state,
+# filter_nml: perturb_from_single_instance = .true.
+# it's fine (and convenient) to put the whole list of files in input_state_file_list.
+# Filter will just use the first as the base to perturb.
+
+set line = `grep input_state_file_list input.nml | sed -e "s#[=,'\.]# #g"`
+echo "$line"
+set input_file_list = $line[2]
+
+${LIST} -1 ${CASE}.cam_[0-9][0-9][0-9][0-9].i.${ATM_DATE_EXT}.nc >! $input_file_list
+
+# If the file names in $output_state_file_list = names in $input_state_file_list,
+# then the restart file contents will be overwritten with the states updated by DART.
+
+set line = `grep output_state_file_list input.nml | sed -e "s#[=,'\.]# #g"`
+set output_file_list = $line[2]
+
+if ($input_file_list != $output_file_list) then
+ echo "ERROR: assimilate.csh requires that input_file_list = output_file_list"
+ echo " You can probably find the data you want in stage 'forecast'."
+ echo " If you truly require separate copies of CAM's initial files"
+ echo " before and after the assimilation, see revision 12603, and note that"
+ echo " it requires changing the linking to cam_initial_####.nc, below."
+ exit 105
+endif
+
+echo "`date` -- BEGIN FILTER"
+${LAUNCHCMD} ${EXEROOT}/filter || exit 110
+echo "`date` -- END FILTER"
+
+#========================================================================
+# Block 7: Rename the output using the CESM file-naming convention.
+#=========================================================================
+
+# If output_state_file_list is filled with custom (CESM) filenames,
+# then 'output' ensemble members will not appear with filter's default,
+# hard-wired names. But file types output_{mean,sd} will appear and be
+# renamed here.
+
+# RMA; we don't know the exact set of files which will be written,
+# so loop over all possibilities.
+
+# Handle files with instance numbers first.
+foreach FILE (`$LIST ${stages_all}_member_*.nc`)
+ # split off the .nc
+ set parts = `echo $FILE | sed -e "s#\.# #g"`
+ # separate the pieces of the remainder
+ set list = `echo $parts[1] | sed -e "s#_# #g"`
+ # grab all but the trailing 'member' and #### parts.
+ @ last = $#list - 2
+ # and join them back together
+ set dart_file = `echo $list[1-$last] | sed -e "s# #_#g"`
+
+ set type = "e"
+ echo $FILE | grep "put"
+ if ($status == 0) set type = "i"
+
+ if ($MOVEV == FALSE) \
+ echo "moving $FILE ${CASE}.${scomp}_$list[$#list].${type}.${dart_file}.${ATM_DATE_EXT}.nc"
+ $MOVE $FILE ${CASE}.${scomp}_$list[$#list].${type}.${dart_file}.${ATM_DATE_EXT}.nc
+end
+
+# Files without instance numbers need to have the scomp part of their names = "dart".
+# This is because in st_archive, all files with scomp = "cam"
+# (= compname in env_archive.xml) will be st_archived using a pattern
+# which has the instance number added onto it. {mean,sd} files don't instance numbers,
+# so they need to be archived by the "dart" section of env_archive.xml.
+# But they still need to be different for each component, so include $scomp in the
+# ".dart_file" part of the file name. Somewhat awkward and inconsistent, but effective.
+
+# Means and standard deviation files (except for inflation).
+foreach FILE (`${LIST} ${stages_all}_{mean,sd}*.nc`)
+ set parts = `echo $FILE | sed -e "s#\.# #g"`
+
+ set type = "e"
+ echo $FILE | grep "put"
+ if ($status == 0) set type = "i"
+
+ ${MOVE} $FILE ${CASE}.dart.${type}.${scomp}_$parts[1].${ATM_DATE_EXT}.nc
+end
+
+# Rename the observation file and run-time output
+
+${MOVE} obs_seq.final ${CASE}.dart.e.${scomp}_obs_seq_final.${ATM_DATE_EXT}
+${MOVE} dart_log.out ${scomp}_dart_log.${ATM_DATE_EXT}.out
+
+# Rename the inflation files
+
+# Accommodate any possible inflation files.
+# The .${scomp}_ part is needed by DART to distinguish
+# between inflation files from separate components in coupled assims.
+
+foreach FILE ( `$LIST ${stages_all}_{prior,post}inf_*`)
+ set parts = `echo $FILE | sed -e "s#\.# #g"`
+ if ($MOVEV == FALSE ) \
+ echo "Moved $FILE $CASE.dart.rh.${scomp}_$parts[1].${ATM_DATE_EXT}.nc"
+ ${MOVE} $FILE $CASE.dart.rh.${scomp}_$parts[1].${ATM_DATE_EXT}.nc
+end
+
+# RMA; do these files have new names?
+# Handle localization_diagnostics_files
+set MYSTRING = `grep 'localization_diagnostics_file' input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+set MYSTRING = `echo $MYSTRING | sed -e 's#"# #g'`
+set loc_diag = $MYSTRING[2]
+if (-f $loc_diag) then
+ ${MOVE} $loc_diag ${scomp}_${loc_diag}.dart.e.${ATM_DATE_EXT}
+endif
+
+# Handle regression diagnostics
+set MYSTRING = `grep 'reg_diagnostics_file' input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+set MYSTRING = `echo $MYSTRING | sed -e 's#"# #g'`
+set reg_diag = $MYSTRING[2]
+if (-f $reg_diag) then
+ ${MOVE} $reg_diag ${scomp}_${reg_diag}.dart.e.${ATM_DATE_EXT}
+endif
+
+# RMA
+# Then this script will need to feed the files in output_restart_list_file
+# to the next model advance.
+# This gets the .i. or .r. piece from the CESM format file name.
+set line = `grep 0001 $output_file_list | sed -e "s#[\.]# #g"`
+set l = 1
+while ($l < $#line)
+ if ($line[$l] =~ ${scomp}_0001) then
+ @ l++
+ set file_type = $line[$l]
+ break
+ endif
+ @ l++
+end
+
+set member = 1
+while ( ${member} <= ${ensemble_size} )
+
+ set inst_string = `printf _%04d $member`
+ set ATM_INITIAL_FILENAME = ${CASE}.${scomp}${inst_string}.${file_type}.${ATM_DATE_EXT}.nc
+
+ # TJH I dont think link -f can fail ... this may never exit as intended
+
+ ${LINK} $ATM_INITIAL_FILENAME ${scomp}_initial${inst_string}.nc || exit 120
+
+ @ member++
+
+end
+
+date
+echo "`date` -- END CAM_ASSIMILATE"
+
+# Be sure that the removal of unneeded restart sets and copy of obs_seq.final are finished.
+wait
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/work/cam_out_files b/models/cam-fv/work/cam_out_files
new file mode 100644
index 0000000000..03a974b3e1
--- /dev/null
+++ b/models/cam-fv/work/cam_out_files
@@ -0,0 +1,6 @@
+cam_out_1.nc
+cam_out_2.nc
+cam_out_3.nc
+cam_out_4.nc
+cam_out_5.nc
+cam_out_6.nc
diff --git a/models/cam-fv/work/cross_correlations.txt b/models/cam-fv/work/cross_correlations.txt
new file mode 100644
index 0000000000..4acc95f8c9
--- /dev/null
+++ b/models/cam-fv/work/cross_correlations.txt
@@ -0,0 +1,63 @@
+
+#
+# example of how to control the impact of
+# chemistry observations on model state
+# and vice versa.
+#
+
+GROUP chemistry
+ ALLQTYS EXCEPT
+ QTY_O3
+ QTY_CO
+ QTY_NO
+ QTY_NO2
+ QTY_CO01
+ QTY_CO02
+ QTY_CO03
+ QTY_SFCO
+ QTY_SFCO01
+ QTY_SFCO02
+ QTY_SFCO03
+ QTY_AOD
+ QTY_CB1
+ QTY_CB2
+ QTY_OC1
+ QTY_OC2
+ QTY_CB102
+ QTY_CB202
+ QTY_OC102
+ QTY_OC202
+ QTY_SFCB1
+ QTY_SFCB2
+ QTY_SFOC1
+ QTY_SFOC2
+ QTY_SFCB102
+ QTY_SFCB202
+ QTY_SFOC102
+ QTY_SFOC202
+ QTY_CO2
+ QTY_NH3
+ QTY_CH4
+END GROUP
+
+GROUP met
+ ALLQTYS EXCEPT chemistry
+END GROUP
+
+# actual table to define factors for impacts.
+#
+# the first column can contain either types or kinds because
+# it applies to the current obs being assimilated.
+#
+# the second column has to be kinds because it applies
+# to the state (also unassimilated obs, but states only
+# have kinds so that's the most restrictive).
+#
+# either column can have a group name, but any group used
+# in column 2 can contain only kinds.
+
+IMPACT
+ met chemistry 0.0
+ chemistry met 0.0
+END IMPACT
+
diff --git a/models/cam-fv/work/input.nml b/models/cam-fv/work/input.nml
index 3ec6909128..0254b2538f 100644
--- a/models/cam-fv/work/input.nml
+++ b/models/cam-fv/work/input.nml
@@ -1,340 +1,242 @@
-! This namelist is set up for a single, CAM-FV, assimilation cycle
-! using the default values as found in model_mod.f90 and CESM1_2_1_setup_{hybrid,advanced}
+! This namelist is set up for a single, CAM-FV, assimilation cycle
+! using the default values as found in model_mod.f90 and
+! shell_scripts/cesm2_1/setup_{hybrid,advanced}
! starting from a single model state, which must be perturbed into an ensemble.
! Comments below give suggestions for setting it up for other assimilations:
! > continuing an assimilation (no perturbations) and/or starting from an ensemble.
-! > Setting up a CAM-SE assimilation
-! > Setting up a WACCM assimilation
+! > Setting up a WACCM(-X) assimilation
! > Setting up for perfect_model_obs
!
! PLEASE READ
!
-! https://proxy.subversion.ucar.edu/DAReS/DART/trunk/models/cam/model_mod.html
+! cam-fv/model_mod.html
!
-! for recommendations on namelist settings for CAM. It has examples of configurations
-! for taking a single state and creating an ensemble, differences between using
-! the FV core or SE core ... variable resolution grids, etc.
-
-! ens_size, num_output_* will be (re)set by the setup script
-
-! To use a pre-existing ensemble search for the following variables
-! and make the following changes
-! (This applies to the second cycle after starting from a single ensemble member.)
-! start_from_restart = .true.,
-! inf_initial_from_restart = .true., .false.,
-! inf_sd_initial_from_restart = .true., .false.,
-! Also search for 'single model state' to make changes in model_nml.
-
-! Changes for DART2.0 ("RMA" "Manhattan")
-! To be removed:
-! restart_in_file_name = 'no_restart_in'
-! restart_out_file_name = 'no_restart_out'
-! direct_netcdf*
-! To be added:
-! output_list_file = 'cam_output_init_files'
-! perturb_from_single_instance = .true. MUST be true in order to use model_mod's
-! perturbation routine
-! perturbation_amplitude = 0.2, Will be ignored because the amplitude is
-! provided in model_nml.
-! stages_to_write = Controls diagnostic and restart output. Valid values are
-! 'input', 'forecast','preassim', 'postassim', 'analysis', and 'output'.
-! If only prior inflation is used, then 'postassim' and 'analysis'
-! are redundant with 'output'.
-! If only posterior inflation is used, 'analysis' and 'preassim'
-! are redundant with 'input'.
-! If you want input_mean and input_sd, you'll
-! need to set output_mean and output_sd = .true.
-! (and include 'input' in stages_to_write).
-
-! Removed from the filter_nml in $rma_trunk
-! direct_netcdf_read = .true.
-! direct_netcdf_write = .true.
-! add_domain_extension = .false.
-! overwrite_state_input = .false.
-! use_restart_list = .true.
-! restart_in_file_name = "filter_ics",
-! inf_in_file_name = 'input_priorinf', 'input_postinf'
-! output_inflation = .true.
-! inf_output_restart = .true., .true.
-! inf_out_file_name = 'output_priorinf', 'output_postinf'
-! inf_diag_file_name = 'output_priorobsinfl', 'output_postobsinf'
-
-! These vars are in the filter_nml as of r10786
+! for recommendations on namelist settings for CAM.
+
+! stages_to_write Controls diagnostic and restart output. Valid values are
+! 'input', 'forecast','preassim', 'postassim', 'analysis', and 'output'.
+! If only prior inflation is used, then 'postassim' and 'analysis'
+! are redundant with 'output'.
+! If only posterior inflation is used, 'analysis' and 'preassim'
+! are redundant with 'input'.
+! If you want input_mean and input_sd, you'll
+! need to set output_mean and output_sd = .true.
+! (and include 'input' in stages_to_write).
&filter_nml
- input_state_files = '',
- input_state_file_list = 'cam_init_files',
+ input_state_files = ''
+ input_state_file_list = 'cam_init_files'
+ single_file_in = .false.
+ perturb_from_single_instance = .true.
init_time_days = -1
init_time_seconds = -1
- single_file_in = .false.,
- perturb_from_single_instance = .false.
-
+
stages_to_write = 'preassim','output'
-
- output_state_files = '',
- output_state_file_list = 'cam_init_files',
+
+ output_state_files = ''
+ output_state_file_list = 'cam_init_files'
output_mean = .true.
output_sd = .true.
output_members = .true.
num_output_state_members = 3
- single_file_out = .false.,
+ single_file_out = .false.
write_all_stages_at_end = .false.
-
+ output_interval = 1
+
ens_size = 3
num_groups = 1
+ distributed_state = .true.
inf_flavor = 2, 0
inf_initial_from_restart = .false., .false.
- inf_deterministic = .true., .true.
inf_initial = 1.0, 1.0
inf_lower_bound = 1.0, 1.0
inf_upper_bound = 100.0, 100.0
- inf_damping = 0.9, 0.9
inf_sd_initial_from_restart = .false., .false.
inf_sd_initial = 0.6, 0.6
inf_sd_lower_bound = 0.6, 0.6
inf_sd_max_change = 1.05, 1.05
-
+ inf_damping = 0.9, 0.9
+ inf_deterministic = .true., .true.
+
obs_sequence_in_name = 'obs_seq.out'
obs_sequence_out_name = 'obs_seq.final'
- num_output_obs_members = 3
first_obs_days = -1
first_obs_seconds = -1
last_obs_days = -1
last_obs_seconds = -1
-
+ compute_posterior = .false.
+ num_output_obs_members = 3
+
adv_ens_command = 'no_CESM_advance_script'
trace_execution = .true.
output_timestamps = .true.
output_forward_op_errors = .false.
silence = .false.
/
-
-&perfect_model_obs_nml
- read_input_state_from_file = .true.,
- input_state_files = "caminput.nc",
- init_time_days = -1,
- init_time_seconds = -1,
-
- write_output_state_to_file = .true.,
- output_state_files = "perfect_restart.nc",
-
- obs_seq_in_file_name = "obs_seq.in",
- obs_seq_out_file_name = "obs_seq.out",
- first_obs_days = -1,
- first_obs_seconds = -1,
- last_obs_days = -1,
- last_obs_seconds = -1,
-
- trace_execution = .true.,
- output_timestamps = .true.,
- print_every_nth_obs = 0,
- output_forward_op_errors = .false.,
- /
-
-&state_vector_io_nml
- buffer_state_io = .false.
- single_precision_output = .false.
- /
-&smoother_nml
- num_lags = 0
- start_from_restart = .false.
- output_restart = .false.
- restart_in_file_name = 'smoother_ics'
- restart_out_file_name = 'smoother_restart'
- /
-
-! 'layout' and 'tasks_per_node' will be reset by the assimilate.csh script
-! to match the number ('ptile' for LSF) used when laying out the job.
-
-&ensemble_manager_nml
- layout = 2
- tasks_per_node = 16
- /
-
-&assim_tools_nml
- filter_kind = 1,
- cutoff = 0.15,
- sort_obs_inc = .false.,
- spread_restoration = .false.,
- sampling_error_correction = .false.,
- adaptive_localization_threshold = -1,
- output_localization_diagnostics = .false.,
- localization_diagnostics_file = 'localization_diagnostics',
- print_every_nth_obs = 10000,
- distribute_mean = .false.,
- /
-
-&cov_cutoff_nml
- select_localization = 1
- /
-
-®_factor_nml
- select_regression = 1,
- input_reg_file = 'time_mean_reg'
- save_reg_diagnostics = .false.
- reg_diagnostics_file = 'reg_diagnostics'
- /
-
-&obs_sequence_nml
- write_binary_obs_sequence = .true.
- /
-
-&quality_control_nml
- input_qc_threshold = 3.0
- outlier_threshold = 3.0
- enable_special_outlier_code = .false.
+&perfect_model_obs_nml
+ read_input_state_from_file = .true.
+ input_state_files = "caminput.nc"
+ init_time_days = -1
+ init_time_seconds = -1
+
+ write_output_state_to_file = .true.
+ output_state_files = "perfect_restart.nc"
+
+ obs_seq_in_file_name = "obs_seq.in"
+ obs_seq_out_file_name = "obs_seq.out"
+ first_obs_days = -1
+ first_obs_seconds = -1
+ last_obs_days = -1
+ last_obs_seconds = -1
+
+ trace_execution = .true.
+ output_timestamps = .true.
+ print_every_nth_obs = 0
+ output_forward_op_errors = .false.
/
#========================================================================
-# Start of CAM-SE, CAM-FV dependencies and general discussion.
+# Start of CAM-FV dependencies and general discussion.
#========================================================================
!
-! You MUST configure this file to support EITHER the CAM-SE -OR- CAM-FV cores.
-! There are simply too many changes to support both at the same time.
-! Enable or Disable the appropriate blocks by commenting out or
-! removing the comment character from the block of interest.
+! Creation of initial ensemble from a single model state.
+! fields_to_perturb lists the state variables to be perturbed to make the ensemble.
+! Providing an empty list is one of the changes to use an existing ensemble.
+! perturbation_amplitude > 0 allows each point of the fields_to_perturb fields
+! of each ensemble member to be randomly perturbed with a standard deviation
+! of perturbation_amplitude.
+! Each field can be given a different perturbation_amplitude.
+! Used by filter's call to pert_model_copies.
+!
+! state_variables (5 columns for each variable):
+! netcdf varname, dart quantity, min allowed value, max allowed value, (no)update this var
+!
+! vert_normalization_YYY
+! The vert_normalization_scale_height default value was chosen based on
+! Pedatella's settling on 1.5 (scale heights/radian), based on tuning experiments.
+! This is supported by tuning experiments with CAM5.
!
-! highest_state_pressure_Pa
-! The default values given are the minimums recommended, given the choices
-! of several other CESM and DART parameters.
-! You calculate your own as illustrated in models/cam/doc/highest_state_p_Pa.pptx.
-! Or you can start with the minimum and increase it if there seems to be excessive
+! use_log_vertical_scale(vertical interpolation only):
+! .false. or .true.
+!
+! no_obs_assim_above_level
+! Prevents assimilation of observations whose vertical location is above
+! this model level. Note that, if this value is set to a large value,
+! it may be within CAM's hybrid coordinate layers instead of in the pure pressure layers.
+! This will result in the the observation cutoff height being at different pressure levels
+! over mountains versus lower areas.
+
+! model_damping_ends_at_level
+! This controls how much innovations are reduced near the model top, to mitigate the effects
+! of the extra diffusion sometimes applied there in CAM and WACCM (see fv_div24del2flag).
+! The default value (-1) turns off the damping and relies on the choices of the following
+! variables to prevent assimilation from happening in CAM's diffusive top layers:
+! no_obs_assim_above_level,
+! use_log_vertical_scale,
+! vert_normalization_YYY,
+! cutoff.
+! When it is turned on (> 0), it is the lowest level which will be damped.
+! Damping increases with height (smaller level numbers).
+! The values given below are the minimums recommended for various models.
+! You can start with the minimum and increase it if there seems to be excessive
! noise in the upper layers.
-! The parameters on which the minimum highest_state_pressure_Pa depends are:
-! cutoff (0.2 assumed)
-! vert_coord
-! vert_normalization_{pressure,scale_height}
-! CAM's model top
-! number of model top levels with extra diffusion
!
-! WACCM can be used with either FV or SE
-! vert_normalization_scale_height does not have extensive exploration available.
-! Pedatella settled on 2.5.
-! The model top for WACCM is (naturally) much higher: 4.5e-4 Pa
-! This has ramifications for the diffusion near the model top so
-! changes to the highest_*_pressure_Pa are appropriate.
-! number of model top levels with extra diffusion, controlled by CAM's div24del2:
+! CAM-FV Section
+! Model top 220 Pa
+! Number of CAM model top levels with extra diffusion, controlled by div24del2:
+! 2 = div2 -> 2 levels
+! 4,24 = del2 -> 3 levels
+! CAM assimilations can use pressure or scale height vertical coordinate.
+! We recommend scale height.
+! use_log_vertical_scale = .true.
+! vert_normalization_scale_height = 1.5
+! vert_normalization_pressure = 20000.
+!
+! 26 levels (CAM4):
+! no_obs_assim_above_level = 5 ! corresponds to ~3700 Pa
+! 30 levels (CAM5):
+! no_obs_assim_above_level = 5 ! corresponds to ~3800 Pa
+! 32 levels (CAM6):
+! no_obs_assim_above_level = 5 ! corresponds to ~3600 Pa
+!
+! WACCM
+! The model top for WACCM is (naturally) much higher: 4.5e-4 Pa
+! The number of model top levels with extra diffusion is controlled by WACCM's
+! fv_div24del2flag:
! 2 = div2 -> 3 levels
! 4,24 = del2 -> 4 levels
+! 70 levels (WACCM4):
+! no_obs_assim_above_level = 7 ! corresponds to 0.012 Pa
+! This values must be used with WACCM assimilations;
+! use_log_vertical_scale = .true.
+! This is recommended, but your own tuning experiments may support a different value.
+! vert_normalization_scale_height = 1.5
!
-! WACCM settings that must be changed no matter what core is being used.
-! vert_normalization_scale_height = 2.5
-! vert_coord = 'log_invP'
-! highest_obs_pressure_Pa = .0001,
-! highest_state_pressure_Pa = .01,
-!
-! Creation of initial ensemble from a single model state.
-! pert_names lists the state variables to be perturbed to make the ensemble.
-! Providing an empty list is one of the changes to use an existing ensemble.
-! pert_sd > 0 allows each point of the pert_names fields of each ens member
-! to be randomly perturbed with a standard deviation of pert_sd.
-! Used by filter's call to pert_model_state.
-!
-#========================================================================
-# CAM-FV Section
-# model top 220 Pa
-# number of model top levels with extra diffusion, controlled by div24del2:
-# 2 = div2 -> 2 levels
-# 4,24 = del2 -> 3 levels -> highest_state_pressure_Pa = 10500.
-# vert_normalization_pressure = 20000. is a better choice than
-# 100000. for allowing upper levels to be pulled towards the obs.
-#========================================================================
+!========================================================================
&model_nml
- model_version = '4.0',
- model_config_file = 'caminput.nc'
- cam_phis = 'cam_phis.nc'
- state_num_0d = 0,
- state_num_1d = 0,
- state_num_2d = 1,
- state_num_3d = 6,
- state_names_2d = 'PS'
- state_names_3d = 'T','US','VS','Q','CLDLIQ','CLDICE'
- which_vert_1d = 0,
- which_vert_2d = -1,
- which_vert_3d = 6*1,
- vert_coord = 'log_invP'
- pert_names = 'T'
- pert_sd = 0.1,
- pert_base_vals = -888888.0d0,
- highest_obs_pressure_Pa = 1000.0,
- highest_state_pressure_Pa = 9400.0,
- max_obs_lat_degree = 90.0,
- Time_step_seconds = 21600,
- Time_step_days = 0,
- print_details = .false.,
+ cam_template_filename = 'caminput.nc'
+ cam_phis_filename = 'cam_phis.nc'
+ custom_routine_to_generate_ensemble = .true.
+ fields_to_perturb = 'QTY_TEMPERATURE'
+ perturbation_amplitude = 0.1
+ state_variables = 'T', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE'
+ 'US', 'QTY_U_WIND_COMPONENT', 'NA', 'NA', 'UPDATE'
+ 'VS', 'QTY_V_WIND_COMPONENT', 'NA', 'NA', 'UPDATE'
+ 'Q', 'QTY_SPECIFIC_HUMIDITY', 'NA', 'NA', 'UPDATE'
+ 'CLDLIQ','QTY_CLOUD_LIQUID_WATER', 'NA', 'NA', 'UPDATE'
+ 'CLDICE','QTY_CLOUD_ICE', 'NA', 'NA', 'UPDATE'
+ 'PS', 'QTY_SURFACE_PRESSURE', 'NA', 'NA', 'UPDATE'
+ use_log_vertical_scale = .true.
+ use_variable_mean_mass = .false.
+ no_normalization_of_scale_heights = .true.
+ vertical_localization_coord = 'SCALEHEIGHT'
+ no_obs_assim_above_level = 5
+ model_damping_ends_at_level = -1
+ using_chemistry = .false.
+ assimilation_period_days = 0
+ assimilation_period_seconds = 21600
+ suppress_grid_info_in_output = .false.
+ debug_level = 0
/
+
&location_nml
- horiz_dist_only = .false.,
- vert_normalization_pressure = 20000.0,
- vert_normalization_height = 10000.0,
- vert_normalization_level = 20.0,
- vert_normalization_scale_height = 2.5,
- approximate_distance = .true.,
- nlon = 141,
- nlat = 72,
- output_box_info = .false.,
- print_box_level = 0,
+ horiz_dist_only = .false.
+ vert_normalization_pressure = 20000.0
+ vert_normalization_height = 10000.0
+ vert_normalization_level = 20.0
+ vert_normalization_scale_height = 1.5
+ approximate_distance = .true.
+ nlon = 141
+ nlat = 72
+ output_box_info = .false.
+ print_box_level = 0
/
#========================================================================
-# CAM-SE Section
-# model top 220 Pa
-# number of model top levels with extra diffusion (3 only)
+# End of CAM-FV dependencies.
#========================================================================
-!CAM-SE &model_nml
-!CAM-SE model_version = '5.1.1',
-!CAM-SE model_config_file = 'caminput.nc'
-!CAM-SE cs_grid_file = 'SEMapping_cs_grid.nc'
-!CAM-SE homme_map_file = '../SEMapping.nc'
-!CAM-SE state_num_0d = 0,
-!CAM-SE state_num_1d = 1,
-!CAM-SE state_num_2d = 6,
-!CAM-SE state_num_3d = 0,
-!CAM-SE state_names_1d = 'PS'
-!CAM-SE state_names_2d = 'T','U','V','Q','CLDLIQ','CLDICE'
-!CAM-SE state_names_3d = ''
-!CAM-SE which_vert_1d = -1,
-!CAM-SE which_vert_2d = 6*1,
-!CAM-SE vert_coord = 'pressure'
-!CAM-SE pert_names = 'T'
-!CAM-SE pert_sd = 0.1,
-!CAM-SE pert_base_vals = -888888.0d0,
-!CAM-SE highest_obs_pressure_Pa = 1000.0,
-!CAM-SE highest_state_pressure_Pa = 9400.0,
-!CAM-SE max_obs_lat_degree = 90.0,
-!CAM-SE Time_step_seconds = 21600,
-!CAM-SE Time_step_days = 0,
-!CAM-SE print_details = .false.,
-!CAM-SE /
-!CAM-SE
-!CAM-SE &location_nml
-!CAM-SE horiz_dist_only = .false.,
-!CAM-SE vert_normalization_pressure = 20000.0,
-!CAM-SE vert_normalization_height = 10000.0,
-!CAM-SE vert_normalization_level = 20.0,
-!CAM-SE vert_normalization_scale_height = 2.5,
-!CAM-SE approximate_distance = .FALSE.,
-!CAM-SE nlon = 141,
-!CAM-SE nlat = 72,
-!CAM-SE output_box_info = .false.,
-!CAM-SE print_box_level = 0,
-!CAM-SE /
+&fill_inflation_restart_nml
+ write_prior_inf = .true.
+ prior_inf_mean = 1.01
+ prior_inf_sd = 0.6
-#========================================================================
-# End of CAM-SE, CAM-FV dependencies.
-#========================================================================
+ write_post_inf = .false.
+ post_inf_mean = 1.00
+ post_inf_sd = 0.6
-&xyz_location_nml
+ input_state_files = 'caminput.nc'
+ single_file = .false.
+ verbose = .false.
/
! to use chemistry or saber temperatures, include the following.
! '../../../observations/forward_operators/obs_def_CO_Nadir_mod.f90',
-! '../../../observations/forward_operators/obs_def_SABER_mod.f90'
+! '../../../observations/forward_operators/obs_def_SABER_mod.f90',
! '../../../observations/forward_operators/obs_def_MOPITT_CO_mod.f90',
&preprocess_nml
@@ -345,167 +247,271 @@
input_files = '../../../observations/forward_operators/obs_def_gps_mod.f90',
'../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90',
'../../../observations/forward_operators/obs_def_altimeter_mod.f90',
+ '../../../observations/forward_operators/obs_def_upper_atm_mod.f90'
/
-! Not usually assimilated. No fundamental reason not to.
+! Not usually assimilated. No fundamental reason not to.
! 'RADIOSONDE_SPECIFIC_HUMIDITY',
! Available from mid-2006 onward. Build filter with obs_def_gps_mod.f90
-! 'GPSRO_REFRACTIVITY',
-! WACCM can use higher observations than CAM.
+! 'GPSRO_REFRACTIVITY',
+! WACCM can use higher observations than CAM.
! An example can be included via obs_def_SABER_mod.f90.
-! 'SABER_TEMPERATURE',
+! 'SABER_TEMPERATURE',
&obs_kind_nml
- assimilate_these_obs_types = 'RADIOSONDE_TEMPERATURE',
- 'RADIOSONDE_U_WIND_COMPONENT',
+ assimilate_these_obs_types = 'RADIOSONDE_U_WIND_COMPONENT',
'RADIOSONDE_V_WIND_COMPONENT',
- 'GPSRO_REFRACTIVITY',
- 'AIRCRAFT_TEMPERATURE',
- 'ACARS_TEMPERATURE',
+ 'RADIOSONDE_TEMPERATURE',
'AIRCRAFT_U_WIND_COMPONENT',
'AIRCRAFT_V_WIND_COMPONENT',
+ 'AIRCRAFT_TEMPERATURE',
'ACARS_U_WIND_COMPONENT',
'ACARS_V_WIND_COMPONENT',
+ 'ACARS_TEMPERATURE',
'SAT_U_WIND_COMPONENT',
'SAT_V_WIND_COMPONENT',
+ 'GPSRO_REFRACTIVITY'
+
evaluate_these_obs_types = 'RADIOSONDE_SPECIFIC_HUMIDITY',
/
+&state_vector_io_nml
+ buffer_state_io = .false.
+ single_precision_output = .false.
+ /
+
+
+! 'layout' and 'tasks_per_node' will be reset by the assimilate.csh script
+! to match the number used when laying out the job.
+
+&ensemble_manager_nml
+ layout = 2
+ tasks_per_node = 16
+ /
+
+
+&assim_tools_nml
+ filter_kind = 1
+ cutoff = 0.15
+ sort_obs_inc = .false.
+ spread_restoration = .false.
+ sampling_error_correction = .false.
+ adaptive_localization_threshold = -1
+ output_localization_diagnostics = .false.
+ localization_diagnostics_file = 'localization_diagnostics'
+ convert_all_obs_verticals_first = .true.
+ convert_all_state_verticals_first = .false.
+ print_every_nth_obs = 10000
+ distribute_mean = .false.
+ /
+
+
+&cov_cutoff_nml
+ select_localization = 1
+ /
+
+
+®_factor_nml
+ select_regression = 1
+ input_reg_file = 'time_mean_reg'
+ save_reg_diagnostics = .false.
+ reg_diagnostics_file = 'reg_diagnostics'
+ /
+
+
+&obs_sequence_nml
+ write_binary_obs_sequence = .false.
+ /
+
+
+&quality_control_nml
+ input_qc_threshold = 3.0
+ outlier_threshold = 3.0
+ enable_special_outlier_code = .false.
+ /
+
+
+&xyz_location_nml
+ /
+
+
! : error codes >= TERMLEVEL will cause termination
! E_DBG = -2, E_MSG = -1, E_ALLMSG = 0, E_WARN = 1, E_ERR = 2
&utilities_nml
- TERMLEVEL = 2
+ TERMLEVEL = 2
module_details = .false.
- logfilename = 'dart_log.out'
- nmlfilename = 'dart_log.nml'
- /
+ logfilename = 'dart_log.out'
+ nmlfilename = 'dart_log.nml'
+ /
+
&mpi_utilities_nml
/
+
&obs_def_gps_nml
max_gpsro_obs = 15000000
- /
+ /
+
+
+#========================================================================
+# observation manipulation tools
+#========================================================================
+
+! other possible obs tool namelist items:
+!
+! keep only the U and V radiosonde winds:
+! obs_types = 'RADIOSONDE_U_WIND_COMPONENT'
+! 'RADIOSONDE_V_WIND_COMPONENT'
+! keep_types = .true.
+!
+! remove the U and V radiosonde winds:
+! obs_types = 'RADIOSONDE_U_WIND_COMPONENT'
+! 'RADIOSONDE_V_WIND_COMPONENT'
+! keep_types = .false.
+!
+! keep only observations with a DART QC of 0:
+! qc_metadata = 'Dart quality control'
+! min_qc = 0
+! max_qc = 0
+!
+! keep only radiosonde temp obs between 250 and 300 K:
+! copy_metadata = 'NCEP BUFR observation'
+! copy_type = 'RADIOSONDE_TEMPERATURE'
+! min_copy = 250.0
+! max_copy = 300.0
+
&obs_sequence_tool_nml
- num_input_files = 7
- filename_seq = 'obs_seq.one', 'obs_seq.two',
- filename_out = 'obs_seq.processed',
- first_obs_days = -1,
- first_obs_seconds = -1,
- last_obs_days = -1,
- last_obs_seconds = -1,
- min_lat = -90.0,
- max_lat = 90.0,
- min_lon = 0.0,
- max_lon = 360.0,
+ num_input_files = 2
+ filename_seq = 'obs_seq.one', 'obs_seq.two'
+ filename_out = 'obs_seq.processed'
+ first_obs_days = -1
+ first_obs_seconds = -1
+ last_obs_days = -1
+ last_obs_seconds = -1
+ min_lat = -90.0
+ max_lat = 90.0
+ min_lon = 0.0
+ max_lon = 360.0
gregorian_cal = .true.
- print_only = .false.,
+ print_only = .false.
+ /
+
+
+&obs_common_subset_nml
+ num_to_compare_at_once = 2
+ filename_seq = ''
+ filename_seq_list = ''
+ filename_out_suffix = '.common'
+ print_only = .false.
+ print_every = 10000
+ calendar = 'Gregorian'
+ dart_qc_threshold = 3
+ eval_and_assim_can_match = .false.
/
-# other possible obs tool namelist items:
-#
-# keep only the U and V radiosonde winds:
-# obs_types = 'RADIOSONDE_U_WIND_COMPONENT',
-# 'RADIOSONDE_V_WIND_COMPONENT',
-# keep_types = .true.
-#
-# remove the U and V radiosonde winds:
-# obs_types = 'RADIOSONDE_U_WIND_COMPONENT',
-# 'RADIOSONDE_V_WIND_COMPONENT',
-# keep_types = .false.
-#
-# keep only observations with a DART QC of 0:
-# qc_metadata = 'Dart quality control'
-# min_qc = 0
-# max_qc = 0
-#
-# keep only radiosonde temp obs between 250 and 300 K:
-# copy_metadata = 'NCEP BUFR observation'
-# copy_type = 'RADIOSONDE_TEMPERATURE'
-# min_copy = 250.0
-# max_copy = 300.0
-#
-
-# The times in the namelist for the obs_diag program are vectors
-# that follow the following sequence:
-# year month day hour minute second
-# max_num_bins can be used to specify a fixed number of bins,
-# in which case last_bin_center should be safely in the future.
-#
-# Acceptable latitudes range from [-90, 90]
-# Acceptable longitudes range from [ 0, Inf]
-
-# Other available namelist variables, not in the default obs_diag.nml:
-# hlevel
-# mlevel
-# print_obs_locations
-# outliers_in_histogram
-# plevel_edges
-# hlevel_edges
-# mlevel_edges
-# Standard layers:
-# 1000, 925, 850, 700, 600, 500, 400, 300, 250, 200, 150, 100, 70, 50, 30, 20, 10 hPa
-# +950(MetOffc) -600(skipped in obs_diag.f90 defaults) -70 and less skipped in obs_diag.f90
-# Corresponding heights (assuming a standard atmosphere)
-# 0, 650, 1350, 2900,4100,5480,7090,9080,10280,11700,13520,16100,18358,21060,24640,27480,32330
-
-
-# plevel = 1000.,925.,850.,700.,500.,400.,300.,250.,200.,150.,100.,50.,20.,10.
-# hlevel = 1000., 2000., 3000., 4000., 5000., 6000., 7000., 8000., 9000., 10000.,11000.
-# 0, 1500, 2500, 3500, 4500, 5500, 6500, 7500, 9500, 11500, 13500, 15500
-
-# Defaults
-# plevel = 1000.,850.,700.,500.,400.,300.,200.,150.,100.
-# Nregions = 4,
-# lonlim1 = 0.0, 0.0, 0.0, 235.0,
-# lonlim2 = 360.0, 360.0, 360.0, 295.0,
-# latlim1 = 20.0, -80.0, -20.0, 25.0,
-# latlim2 = 80.0, -20.0, 20.0, 55.0,
-# reg_names = 'Northern Hemisphere', 'Southern Hemisphere', 'Tropics', 'North America',
-
-# for WACCM you will want to change the plevel to match
-# the higher vertical range of the model.
-# plevel = 1000.,850.,700.,500.,400.,300.,200.,150.,100.
-# these are specified in hectopascals (hPa)
+
+&obs_impact_tool_nml
+ input_filename = 'cross_correlations.txt'
+ output_filename = 'control_impact_runtime.txt'
+ debug = .false.
+ /
+
+
+&smoother_nml
+ num_lags = 0
+ start_from_restart = .false.
+ output_restart = .false.
+ restart_in_file_name = 'smoother_ics'
+ restart_out_file_name = 'smoother_restart'
+ /
+
+
+#========================================================================
+# diagnostic tools
+#========================================================================
+
+! The times in the namelist for the obs_diag program are vectors
+! that follow the following sequence:
+! year month day hour minute second
+! max_num_bins can be used to specify a fixed number of bins,
+! in which case last_bin_center should be safely in the future.
+!
+! Acceptable latitudes range from [-90, 90]
+! Acceptable longitudes range from [ 0, Inf]
+!
+! Other available namelist variables, not in the default obs_diag.nml:
+! hlevel
+! mlevel
+! print_obs_locations
+! outliers_in_histogram
+! plevel_edges
+! hlevel_edges
+! mlevel_edges
+! Standard layers:
+! 1000, 925, 850, 700, 600, 500, 400, 300, 250, 200, 150, 100, 70, 50, 30, 20, 10 hPa
+! +950(MetOffc) -600(skipped in obs_diag.f90 defaults) -70 and less skipped in obs_diag.f90
+! Corresponding heights (assuming a standard atmosphere)
+! 0, 650, 1350, 2900,4100,5480,7090,9080,10280,11700,13520,16100,18358,21060,24640,27480,32330
+!
+! plevel = 1000.,925.,850.,700.,500.,400.,300.,250.,200.,150.,100.,50.,20.,10.
+! hlevel = 1000., 2000., 3000., 4000., 5000., 6000., 7000., 8000., 9000., 10000.,11000.
+! 0, 1500, 2500, 3500, 4500, 5500, 6500, 7500, 9500, 11500, 13500, 15500
+!
+! Defaults
+! plevel = 1000.,850.,700.,500.,400.,300.,200.,150.,100.
+! Nregions = 4
+! lonlim1 = 0.0, 0.0, 0.0, 235.0
+! lonlim2 = 360.0, 360.0, 360.0, 295.0
+! latlim1 = 20.0, -80.0, -20.0, 25.0
+! latlim2 = 80.0, -20.0, 20.0, 55.0
+! reg_names = 'Northern Hemisphere', 'Southern Hemisphere', 'Tropics', 'North America'
+!
+! for WACCM you will want to change the plevel to match
+! the higher vertical range of the model.
+! plevel = 1000.,850.,700.,500.,400.,300.,200.,150.,100.
+! these are specified in hectopascals (hPa)
&obs_diag_nml
- obs_sequence_name = 'obs_seq.final',
- obs_sequence_list = '',
- first_bin_center = 2013, 1, 1, 0, 0, 0 ,
- last_bin_center = 2013, 1, 2, 0, 0, 0 ,
- bin_separation = 0, 0, 0, 6, 0, 0 ,
- bin_width = 0, 0, 0, 6, 0, 0 ,
- time_to_skip = 0, 0, 1, 0, 0, 0 ,
- max_num_bins = 1000,
- trusted_obs = 'null',
+ obs_sequence_name = 'obs_seq.final'
+ obs_sequence_list = ''
+ first_bin_center = 2013, 1, 1, 0, 0, 0
+ last_bin_center = 2013, 1, 2, 0, 0, 0
+ bin_separation = 0, 0, 0, 6, 0, 0
+ bin_width = 0, 0, 0, 6, 0, 0
+ time_to_skip = 0, 0, 1, 0, 0, 0
+ max_num_bins = 1000
+ trusted_obs = 'null'
plevel_edges = 1035.5, 962.5, 887.5, 775, 600, 450, 350, 275, 225, 175, 125, 75, 35, 15, 2
hlevel_edges = 0, 630, 930, 1880,3670,5680,7440,9130,10530,12290, 14650,18220,23560,29490,43000
- Nregions = 3,
- lonlim1 = 0.0, 0.0, 0.0,
- lonlim2 = 360.0, 360.0, 360.0,
- latlim1 = 20.0, -20.0, -90.0,
- latlim2 = 90.0, 20.0, -20.0,
- reg_names = 'Northern Hemisphere', 'Tropics', 'Southern Hemisphere',
- print_mismatched_locs = .false.,
- create_rank_histogram = .true.,
- outliers_in_histogram = .true.,
- use_zero_error_obs = .false.,
+ Nregions = 3
+ reg_names = 'Northern Hemisphere', 'Tropics', 'Southern Hemisphere'
+ lonlim1 = 0.0, 0.0, 0.0
+ lonlim2 = 360.0, 360.0, 360.0
+ latlim1 = 20.0, -20.0, -90.0
+ latlim2 = 90.0, 20.0, -20.0
+ print_mismatched_locs = .false.
+ create_rank_histogram = .true.
+ outliers_in_histogram = .true.
+ use_zero_error_obs = .false.
verbose = .false.
/
+
&schedule_nml
- calendar = 'Gregorian'
- first_bin_start = 1601, 1, 1, 0, 0, 0
- first_bin_end = 2999, 1, 1, 0, 0, 0
- last_bin_end = 2999, 1, 1, 0, 0, 0
+ calendar = 'Gregorian'
+ first_bin_start = 1601, 1, 1, 0, 0, 0
+ first_bin_end = 2999, 1, 1, 0, 0, 0
+ last_bin_end = 2999, 1, 1, 0, 0, 0
bin_interval_days = 1000000
bin_interval_seconds = 0
max_num_bins = 1000
print_table = .true.
/
+
&obs_seq_to_netcdf_nml
obs_sequence_name = 'obs_seq.final'
obs_sequence_list = ''
@@ -517,61 +523,54 @@
verbose = .false.
/
-&obs_common_subset_nml
- num_to_compare_at_once = 2
- filename_seq = '',
- filename_seq_list = '',
- filename_out_suffix = '.common' ,
- print_only = .false.,
- print_every = 10000
- calendar = 'Gregorian'
- dart_qc_threshold = 3
- eval_and_assim_can_match = .false.
- /
&model_mod_check_nml
input_state_files = 'caminput.nc'
output_state_files = 'mmc_output.nc'
test1thru = 0
run_tests = 1,2,3,4,5,7
- x_ind = 10
+ x_ind = 175001
+
quantity_of_interest = 'QTY_U_WIND_COMPONENT'
loc_of_interest = 254.727854, 39.9768545, 50000.0
- interp_test_vertcoord = 'VERTISPRESSURE'
- interp_test_lonrange = 0.0, 359.0
+
+ interp_test_lonrange = 0.0, 360.0
interp_test_dlon = 1.0
- interp_test_latrange = -89.0, 89.0
+ interp_test_latrange = -90.0, 90.0
interp_test_dlat = 1.0
- interp_test_vertrange = 1000.0, 1005.0
- interp_test_dvert = 2000.0
+ interp_test_vertrange = 10000.0, 90000.0
+ interp_test_dvert = 10000.0
+ interp_test_vertcoord = 'VERTISPRESSURE'
verbose = .false.
- /
+ /
-&obs_impact_tool_nml
- input_filename = 'cross_correlations.txt'
- output_filename = 'control_impact_runtime.txt'
- allow_any_impact_value = .false.
- debug = .false.
- /
-
-# different methods to compute 'distance' from mean:
-# 1 = simple absolute difference
-# 2 = normalized absolute difference
-# 3 = simple rmse difference
-# 4 = normalized rmse difference
-
-&closest_member_tool_nml
- input_file_name = 'filter_restart',
- output_file_name = 'closest_restart',
+
+! different methods to compute 'distance' from mean:
+! 1 = simple absolute difference
+! 2 = normalized absolute difference
+! 3 = simple rmse difference
+! 4 = normalized rmse difference
+
+&closest_member_tool_nml
+ input_restart_file_list = 'cam_in.txt'
+ output_file_name = 'closest_restart'
+ ens_size = 3
+ single_restart_file_in = .false.
+ difference_method = 4
+ use_only_qtys = ''
+ /
+
+
+&perturb_single_instance_nml
ens_size = 3
- single_restart_file_in = .true.,
- difference_method = 4,
+ input_files = 'caminput.nc'
+ output_files = 'cam_pert1.nc','cam_pert2.nc','cam_pert3.nc'
+ output_file_list = ''
+ perturbation_amplitude = 0.2
+ /
+
+
+&quad_interpolate_nml
+ debug = 0
/
-&fill_inflation_restart_nml
- input_state_files = 'caminput.nc'
- write_prior_inf = .true.
- write_post_inf = .false.
- prior_inf_mean = 1.3
- prior_inf_sd = 0.6
-/
diff --git a/models/cam-fv/work/input_1.nml b/models/cam-fv/work/input_1.nml
deleted file mode 100644
index 87c84c6172..0000000000
--- a/models/cam-fv/work/input_1.nml
+++ /dev/null
@@ -1,248 +0,0 @@
-&assim_model_nml
- write_binary_restart_files = .true.
- netcdf_large_file_support = .true.
- /
-
-
-&assim_tools_nml
- filter_kind = 1
- cutoff = 0.20
- sort_obs_inc = .false.
- spread_restoration = .false.
- sampling_error_correction = .true.
- print_every_nth_obs = 3000
- adaptive_localization_threshold = -1
- /
-
-
-&cam_to_dart_nml
- cam_to_dart_input_file = 'caminput.nc'
- cam_to_dart_output_file = 'dart_ics'
- /
-
-
-&cov_cutoff_nml
- select_localization = 1
- /
-
-
-&dart_to_cam_nml
- dart_to_cam_input_file = 'dart_restart'
- dart_to_cam_output_file = 'caminput.nc'
- advance_time_present = .false.
- /
-
-
-&ensemble_manager_nml
- single_restart_file_in = .true.
- single_restart_file_out = .false.
- perturbation_amplitude = 0.0
- layout = 1
- tasks_per_node = 1
- /
-
-
-&filter_nml
- async = 0
- tasks_per_model_advance = 1
- adv_ens_command = "no_model_advance"
- ens_size = 80
- start_from_restart = .false.
- output_restart = .true.
- obs_sequence_in_name = "obs_seq.out"
- obs_sequence_out_name = "obs_seq.final"
- restart_in_file_name = "filter_ic_old.0001"
- restart_out_file_name = "filter_ic_new"
- init_time_days = -1
- init_time_seconds = -1
- first_obs_days = -1
- first_obs_seconds = -1
- last_obs_days = -1
- last_obs_seconds = -1
- num_output_state_members = 80
- num_output_obs_members = 0
- output_interval = 1
- num_groups = 1
- input_qc_threshold = 4.0
- outlier_threshold = 3.0
- output_inflation = .false.
- output_timestamps = .true.
- output_forward_op_errors = .false.
- trace_execution = .false.
- silence = .false.
- inf_flavor = 0, 0
- inf_initial_from_restart = .false., .false.
- inf_sd_initial_from_restart = .false., .false.
- inf_output_restart = .true., .true.
- inf_deterministic = .true., .true.
- inf_in_file_name = 'prior_inf_ic_old', 'post_inf_ic_old'
- inf_out_file_name = 'prior_inf_ic_new', 'post_inf_ic_new'
- inf_diag_file_name = 'prior_inf_diag', 'post_inf_diag'
- inf_initial = 1.0, 1.0
- inf_sd_initial = 0.1, 0.1
- inf_damping = 1.0, 1.0
- inf_lower_bound = 1.0, 1.0
- inf_upper_bound = 1000.0, 1000.0
- inf_sd_lower_bound = 0.1, 0.0
- /
-
-
-&location_nml
- horiz_dist_only = .false.
- vert_normalization_pressure = 100000.0
- vert_normalization_height = 10000.0
- vert_normalization_level = 26.0
- approximate_distance = .true.
- nlon = 141
- nlat = 72
- output_box_info = .false.
- /
-
-
-&model_nml
- output_state_vector = .false.
- model_version = '4.0.1'
- model_config_file = 'caminput.nc'
- state_num_0d = 0
- state_num_1d = 0
- state_num_2d = 1
- state_num_3d = 6
- state_names_2d = 'PS'
- state_names_3d = 'T','US','VS','Q','CLDLIQ','CLDICE'
- which_vert_1d = 0
- which_vert_2d = -1
- which_vert_3d = 6*1
- pert_names = 'T'
- pert_sd = 1.e-3
- pert_base_vals = -888888.0d0
- highest_obs_pressure_mb = 1.0
- highest_state_pressure_mb = 1.0
- max_obs_lat_degree = 89.0
- time_step_seconds = 43200
- time_step_days = 0
- print_details = .false.
- /
-
-
-&mpi_utilities_nml
- /
-
-
-&obs_diag_nml
- obs_sequence_name = 'obs_0001/obs_seq.final'
- first_bin_center = 2008, 8, 1,12, 0, 0
- last_bin_center = 2008, 9, 1, 0, 0, 0
- bin_separation = 0, 0, 0,12, 0, 0
- bin_width = 0, 0, 0,12, 0, 0
- time_to_skip = 0, 0, 1, 0, 0, 0
- max_num_bins = 1000
- trusted_obs = 'null'
- plevel = 1000.,850.,700.,500.,400.,300.,200.,150.,100.,50.
- nregions = 4
- lonlim1 = 0.0, 0.0, 0.0, 235.0
- lonlim2 = 360.0, 360.0, 360.0, 295.0
- latlim1 = 20.0, -80.0, -20.0, 25.0
- latlim2 = 80.0, -20.0, 20.0, 55.0
- reg_names = 'Northern Hemisphere', 'Southern Hemisphere', 'Tropics', 'North America'
- print_mismatched_locs = .false.
- create_rank_histogram = .true.
- outliers_in_histogram = .true.
- use_zero_error_obs = .false.
- verbose = .false.
- /
-
-
-&obs_kind_nml
- assimilate_these_obs_types = 'RADIOSONDE_TEMPERATURE'
- 'RADIOSONDE_U_WIND_COMPONENT'
- 'RADIOSONDE_V_WIND_COMPONENT'
- /
-
-
-&obs_sequence_nml
- write_binary_obs_sequence = .false.
- /
-
-
-&obs_sequence_tool_nml
- num_input_files = 2
- filename_seq = 'obs_seq.one', 'obs_seq.two'
- filename_out = 'obs_seq.processed'
- print_only = .false.
- first_obs_days = -1
- first_obs_seconds = -1
- last_obs_days = -1
- last_obs_seconds = -1
- min_lat = -90.0
- max_lat = 90.0
- min_lon = 0.0
- max_lon = 360.0
- gregorian_cal = .true.
- /
-
-
-&perfect_model_obs_nml
- start_from_restart = .true.
- output_restart = .true.
- async = 0
- tasks_per_model_advance = 1
- init_time_days = -1
- init_time_seconds = -1
- first_obs_days = -1
- first_obs_seconds = -1
- last_obs_days = -1
- last_obs_seconds = -1
- obs_window_days = -1
- obs_window_seconds = -1
- output_timestamps = .false.
- trace_execution = .true.
- output_forward_op_errors = .false.
- print_every_nth_obs = 3000
- silence = .false.
- output_interval = 1
- restart_in_file_name = "perfect_ic_old"
- restart_out_file_name = "perfect_ic_new"
- obs_seq_in_file_name = "obs_seq.in"
- obs_seq_out_file_name = "obs_seq.out"
- adv_ens_command = "no_advance_model"
- /
-
-
-&preprocess_nml
- input_obs_kind_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
- output_obs_kind_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90'
- input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
- output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90'
- input_files = '../../../observations/forward_operators/obs_def_gps_mod.f90'
- '../../../observations/forward_operators/obs_def_AIRS_mod.f90'
- '../../../observations/forward_operators/obs_def_altimeter_mod.f90'
- '../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90'
- '../../../observations/forward_operators/obs_def_eval_mod.f90'
- '../../../observations/forward_operators/obs_def_QuikSCAT_mod.f90'
- /
-
-
-®_factor_nml
- select_regression = 1
- input_reg_file = "time_mean_reg"
- save_reg_diagnostics = .false.
- reg_diagnostics_file = 'reg_diagnostics'
- /
-
-
-&smoother_nml
- num_lags = 0
- start_from_restart = .false.
- output_restart = .false.
- restart_in_file_name = 'smoother_ics'
- restart_out_file_name = 'smoother_restart'
- /
-
-
-&utilities_nml
- termlevel = 1
- module_details = .false.
- logfilename = 'dart_log.out'
- nmlfilename = 'dart_log.nml'
- /
-
diff --git a/models/cam-fv/work/input_n.nml b/models/cam-fv/work/input_n.nml
deleted file mode 100644
index be7bb04e57..0000000000
--- a/models/cam-fv/work/input_n.nml
+++ /dev/null
@@ -1,248 +0,0 @@
-&assim_model_nml
- write_binary_restart_files = .true.
- netcdf_large_file_support = .true.
- /
-
-
-&assim_tools_nml
- filter_kind = 1
- cutoff = 0.20
- sort_obs_inc = .false.
- spread_restoration = .false.
- sampling_error_correction = .true.
- print_every_nth_obs = 3000
- adaptive_localization_threshold = -1
- /
-
-
-&cam_to_dart_nml
- cam_to_dart_input_file = 'caminput.nc'
- cam_to_dart_output_file = 'dart_ics'
- /
-
-
-&cov_cutoff_nml
- select_localization = 1
- /
-
-
-&dart_to_cam_nml
- dart_to_cam_input_file = 'dart_restart'
- dart_to_cam_output_file = 'caminput.nc'
- advance_time_present = .false.
- /
-
-
-&ensemble_manager_nml
- single_restart_file_in = .false.
- single_restart_file_out = .false.
- perturbation_amplitude = 0.0
- layout = 1
- tasks_per_node = 1
- /
-
-
-&filter_nml
- async = 0
- tasks_per_model_advance = 1
- adv_ens_command = "no_model_advance"
- ens_size = 80
- start_from_restart = .true.
- output_restart = .true.
- obs_sequence_in_name = "obs_seq.out"
- obs_sequence_out_name = "obs_seq.final"
- restart_in_file_name = "filter_ic_old"
- restart_out_file_name = "filter_ic_new"
- init_time_days = -1
- init_time_seconds = -1
- first_obs_days = -1
- first_obs_seconds = -1
- last_obs_days = -1
- last_obs_seconds = -1
- num_output_state_members = 80
- num_output_obs_members = 0
- output_interval = 1
- num_groups = 1
- input_qc_threshold = 4.0
- outlier_threshold = 3.0
- output_inflation = .false.
- output_timestamps = .true.
- output_forward_op_errors = .false.
- trace_execution = .false.
- silence = .false.
- inf_flavor = 0, 0
- inf_initial_from_restart = .false., .false.
- inf_sd_initial_from_restart = .false., .false.
- inf_output_restart = .true., .true.
- inf_deterministic = .true., .true.
- inf_in_file_name = 'prior_inf_ic_old', 'post_inf_ic_old'
- inf_out_file_name = 'prior_inf_ic_new', 'post_inf_ic_new'
- inf_diag_file_name = 'prior_inf_diag', 'post_inf_diag'
- inf_initial = 1.0, 1.0
- inf_sd_initial = 0.1, 0.1
- inf_damping = 1.0, 1.0
- inf_lower_bound = 1.0, 1.0
- inf_upper_bound = 1000.0, 1000.0
- inf_sd_lower_bound = 0.1, 0.0
- /
-
-
-&location_nml
- horiz_dist_only = .false.
- vert_normalization_pressure = 100000.0
- vert_normalization_height = 10000.0
- vert_normalization_level = 26.0
- approximate_distance = .true.
- nlon = 141
- nlat = 72
- output_box_info = .false.
- /
-
-
-&model_nml
- output_state_vector = .false.
- model_version = '4.0.1'
- model_config_file = 'caminput.nc'
- state_num_0d = 0
- state_num_1d = 0
- state_num_2d = 1
- state_num_3d = 6
- state_names_2d = 'PS'
- state_names_3d = 'T','US','VS','Q','CLDLIQ','CLDICE'
- which_vert_1d = 0
- which_vert_2d = -1
- which_vert_3d = 6*1
- pert_names = ''
- pert_sd = -888888.0d0
- pert_base_vals = -888888.0d0
- highest_obs_pressure_mb = 1.0
- highest_state_pressure_mb = 1.0
- max_obs_lat_degree = 89.0
- time_step_seconds = 43200
- time_step_days = 0
- print_details = .false.
- /
-
-
-&mpi_utilities_nml
- /
-
-
-&obs_diag_nml
- obs_sequence_name = 'obs_0001/obs_seq.final'
- first_bin_center = 2008, 8, 1,12, 0, 0
- last_bin_center = 2008, 9, 1, 0, 0, 0
- bin_separation = 0, 0, 0,12, 0, 0
- bin_width = 0, 0, 0,12, 0, 0
- time_to_skip = 0, 0, 1, 0, 0, 0
- max_num_bins = 1000
- trusted_obs = 'null'
- plevel = 1000.,850.,700.,500.,400.,300.,200.,150.,100.,50.
- nregions = 4
- lonlim1 = 0.0, 0.0, 0.0, 235.0
- lonlim2 = 360.0, 360.0, 360.0, 295.0
- latlim1 = 20.0, -80.0, -20.0, 25.0
- latlim2 = 80.0, -20.0, 20.0, 55.0
- reg_names = 'Northern Hemisphere', 'Southern Hemisphere', 'Tropics', 'North America'
- print_mismatched_locs = .false.
- create_rank_histogram = .true.
- outliers_in_histogram = .true.
- use_zero_error_obs = .false.
- verbose = .false.
- /
-
-
-&obs_kind_nml
- assimilate_these_obs_types = 'RADIOSONDE_TEMPERATURE'
- 'RADIOSONDE_U_WIND_COMPONENT'
- 'RADIOSONDE_V_WIND_COMPONENT'
- /
-
-
-&obs_sequence_nml
- write_binary_obs_sequence = .false.
- /
-
-
-&obs_sequence_tool_nml
- num_input_files = 2
- filename_seq = 'obs_seq.one', 'obs_seq.two'
- filename_out = 'obs_seq.processed'
- print_only = .false.
- first_obs_days = -1
- first_obs_seconds = -1
- last_obs_days = -1
- last_obs_seconds = -1
- min_lat = -90.0
- max_lat = 90.0
- min_lon = 0.0
- max_lon = 360.0
- gregorian_cal = .true.
- /
-
-
-&perfect_model_obs_nml
- start_from_restart = .true.
- output_restart = .true.
- async = 0
- tasks_per_model_advance = 1
- init_time_days = -1
- init_time_seconds = -1
- first_obs_days = -1
- first_obs_seconds = -1
- last_obs_days = -1
- last_obs_seconds = -1
- obs_window_days = -1
- obs_window_seconds = -1
- output_timestamps = .false.
- trace_execution = .true.
- output_forward_op_errors = .false.
- print_every_nth_obs = 3000
- silence = .false.
- output_interval = 1
- restart_in_file_name = "perfect_ic_old"
- restart_out_file_name = "perfect_ic_new"
- obs_seq_in_file_name = "obs_seq.in"
- obs_seq_out_file_name = "obs_seq.out"
- adv_ens_command = "no_advance_model"
- /
-
-
-&preprocess_nml
- input_obs_kind_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
- output_obs_kind_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90'
- input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
- output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90'
- input_files = '../../../observations/forward_operators/obs_def_gps_mod.f90'
- '../../../observations/forward_operators/obs_def_AIRS_mod.f90'
- '../../../observations/forward_operators/obs_def_altimeter_mod.f90'
- '../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90'
- '../../../observations/forward_operators/obs_def_eval_mod.f90'
- '../../../observations/forward_operators/obs_def_QuikSCAT_mod.f90'
- /
-
-
-®_factor_nml
- select_regression = 1
- input_reg_file = "time_mean_reg"
- save_reg_diagnostics = .false.
- reg_diagnostics_file = 'reg_diagnostics'
- /
-
-
-&smoother_nml
- num_lags = 0
- start_from_restart = .false.
- output_restart = .false.
- restart_in_file_name = 'smoother_ics'
- restart_out_file_name = 'smoother_restart'
- /
-
-
-&utilities_nml
- termlevel = 1
- module_details = .false.
- logfilename = 'dart_log.out'
- nmlfilename = 'dart_log.nml'
- /
-
diff --git a/models/cam-fv/work/mkmf_closest_member_tool b/models/cam-fv/work/mkmf_closest_member_tool
new file mode 100755
index 0000000000..7fd464d5c6
--- /dev/null
+++ b/models/cam-fv/work/mkmf_closest_member_tool
@@ -0,0 +1,74 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+#
+# usage: mkmf_closest_member_tool [ -mpi | -nompi ]
+#
+# without any args, builds closest_member_tool without mpi libraries, and it will run
+# as a normal executable. if -mpi is given, it will be compiled with the mpi
+# libraries and can run with multiple cooperating processes.
+
+if ( $#argv > 0 ) then
+ if ("$argv[1]" == "-mpi") then
+ setenv usingmpi 1
+ else if ("$argv[1]" == "-nompi") then
+ setenv usingmpi 0
+ else
+ echo "Unrecognized argument to mkmf_closest_member_tool: $argv[1]"
+ echo "Usage: mkmf_closest_member_tool [ -mpi | -nompi ]"
+ echo " default is to generate a Makefile without MPI support."
+ exit -1
+ endif
+else
+ setenv usingmpi 0
+endif
+
+
+# make a backup copy of the path_names file, and then use
+# sed to make sure it includes either the non-mpi subroutines,
+# or the subroutines which really call mpi.
+cp -f path_names_closest_member_tool path_names_closest_member_tool.back
+
+if ( $usingmpi ) then
+
+ echo "Making Makefile with MPI"
+ touch using_mpi_for_closest_member_tool
+ sed -e 's#/null_mpi_util#/mpi_util#' \
+ -e 's#/null_win_mod#/no_cray_win_mod#' path_names_closest_member_tool.back >! path_names_closest_member_tool
+
+ setenv wrapper_arg -w
+
+else
+
+ echo "Making Makefile without MPI"
+ rm -f using_mpi_for_closest_member_tool
+ sed -e 's#/mpi_util#/null_mpi_util#' \
+ -e '\#no_cray_win_mod.f90#d' \
+ -e '\#cray_win_mod.f90#d' path_names_closest_member_tool.back >! path_names_closest_member_tool
+
+ set p=`grep null_win_mod.f90 path_names_closest_member_tool | wc -w`
+ if ( $p == 0) then
+ echo assimilation_code/modules/utilities/null_win_mod.f90 >> path_names_closest_member_tool
+ endif
+
+ setenv wrapper_arg ""
+
+endif
+
+# remove temp file and now really call mkmf to generate makefile
+rm -f path_names_closest_member_tool.back
+
+../../../build_templates/mkmf -p closest_member_tool -t ../../../build_templates/mkmf.template \
+ -a "../../.." ${wrapper_arg} path_names_closest_member_tool
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cam-fv/work/mkmf_perturb_single_instance b/models/cam-fv/work/mkmf_perturb_single_instance
new file mode 100755
index 0000000000..e24fbd6e76
--- /dev/null
+++ b/models/cam-fv/work/mkmf_perturb_single_instance
@@ -0,0 +1,75 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id: mkmf_perturb_single_instance 11289 2017-03-10 21:56:06Z hendric@ucar.edu $
+#
+# usage: mkmf_perturb_single_instance [ -mpi | -nompi ]
+#
+# without any args, builds perturb_single_instance without mpi libraries, and it will run
+# as a normal executable. if -mpi is given, it will be compiled with the mpi
+# libraries and can run with multiple cooperating processes.
+
+if ( $#argv > 0 ) then
+ if ("$argv[1]" == "-mpi") then
+ setenv usingmpi 1
+ else if ("$argv[1]" == "-nompi") then
+ setenv usingmpi 0
+ else
+ echo "Unrecognized argument to mkmf_perturb_single_instance: $argv[1]"
+ echo "Usage: mkmf_perturb_single_instance [ -mpi | -nompi ]"
+ echo " default is to generate a Makefile without MPI support."
+ exit -1
+ endif
+else
+ setenv usingmpi 0
+endif
+
+
+# make a backup copy of the path_names file, and then use
+# sed to make sure it includes either the non-mpi subroutines,
+# or the subroutines which really call mpi.
+cp -f path_names_perturb_single_instance path_names_perturb_single_instance.back
+
+if ( $usingmpi ) then
+
+ echo "Making Makefile with MPI"
+ touch using_mpi_for_perturb_single_instance
+ sed -e 's#/null_mpi_util#/mpi_util#' \
+ -e 's#/null_win_mod#/no_cray_win_mod#' path_names_perturb_single_instance.back >! path_names_perturb_single_instance
+
+ setenv wrapper_arg -w
+
+else
+
+ echo "Making Makefile without MPI"
+ rm -f using_mpi_for_perturb_single_instance
+ sed -e 's#/mpi_util#/null_mpi_util#' \
+ -e '\#no_cray_win_mod.f90#d' \
+ -e '\#cray_win_mod.f90#d' path_names_perturb_single_instance.back >! path_names_perturb_single_instance
+
+ set p=`grep null_win_mod.f90 path_names_perturb_single_instance | wc -w`
+ if ( $p == 0) then
+ echo assimilation_code/modules/utilities/null_win_mod.f90 >> path_names_perturb_single_instance
+ endif
+
+ setenv wrapper_arg ""
+
+endif
+
+# remove temp file and now really call mkmf to generate makefile
+rm -f path_names_perturb_single_instance.back
+
+../../../build_templates/mkmf -p perturb_single_instance -t ../../../build_templates/mkmf.template \
+ -a "../../.." ${wrapper_arg} path_names_perturb_single_instance
+
+exit $status
+
+#
+# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/pertirb_tool/models/cam-fv/work/mkmf_pert_single_instance $
+# $Revision: 11289 $
+# $Date: 2017-03-10 14:56:06 -0700 (Fri, 10 Mar 2017) $
+
+
diff --git a/models/cam-fv/work/path_names_closest_member_tool b/models/cam-fv/work/path_names_closest_member_tool
index 933e33f22f..278fc2f588 100644
--- a/models/cam-fv/work/path_names_closest_member_tool
+++ b/models/cam-fv/work/path_names_closest_member_tool
@@ -29,7 +29,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/closest_member_tool/closest_member_tool.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_create_fixed_network_seq b/models/cam-fv/work/path_names_create_fixed_network_seq
index 8b37742fd7..d230831899 100644
--- a/models/cam-fv/work/path_names_create_fixed_network_seq
+++ b/models/cam-fv/work/path_names_create_fixed_network_seq
@@ -22,7 +22,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/create_fixed_network_seq/create_fixed_network_seq.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_create_obs_sequence b/models/cam-fv/work/path_names_create_obs_sequence
index 2e5484ecb5..fe24c13759 100644
--- a/models/cam-fv/work/path_names_create_obs_sequence
+++ b/models/cam-fv/work/path_names_create_obs_sequence
@@ -23,7 +23,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/create_obs_sequence/create_obs_sequence.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_fill_inflation_restart b/models/cam-fv/work/path_names_fill_inflation_restart
index f5a2191d5e..f798cfe78a 100644
--- a/models/cam-fv/work/path_names_fill_inflation_restart
+++ b/models/cam-fv/work/path_names_fill_inflation_restart
@@ -29,7 +29,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/fill_inflation_restart/fill_inflation_restart.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_filter b/models/cam-fv/work/path_names_filter
index e140f40816..f4e171242c 100644
--- a/models/cam-fv/work/path_names_filter
+++ b/models/cam-fv/work/path_names_filter
@@ -33,7 +33,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/filter/filter.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_model_mod_check b/models/cam-fv/work/path_names_model_mod_check
index 88508069a1..be58f543ab 100644
--- a/models/cam-fv/work/path_names_model_mod_check
+++ b/models/cam-fv/work/path_names_model_mod_check
@@ -33,9 +33,11 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/model_mod_check/model_mod_check.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/model_mod_tools/model_check_utilities_mod.f90
models/model_mod_tools/test_interpolate_threed_sphere.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_obs_common_subset b/models/cam-fv/work/path_names_obs_common_subset
index 5a8afcca86..2ea58b96b8 100644
--- a/models/cam-fv/work/path_names_obs_common_subset
+++ b/models/cam-fv/work/path_names_obs_common_subset
@@ -23,7 +23,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/obs_common_subset/obs_common_subset.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_obs_diag b/models/cam-fv/work/path_names_obs_diag
index 3ef790ce10..90ee7c2edf 100644
--- a/models/cam-fv/work/path_names_obs_diag
+++ b/models/cam-fv/work/path_names_obs_diag
@@ -22,7 +22,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/obs_diag/threed_sphere/obs_diag.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_obs_seq_to_netcdf b/models/cam-fv/work/path_names_obs_seq_to_netcdf
index e3c2f7b211..1bf7480809 100644
--- a/models/cam-fv/work/path_names_obs_seq_to_netcdf
+++ b/models/cam-fv/work/path_names_obs_seq_to_netcdf
@@ -23,7 +23,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/obs_seq_to_netcdf/obs_seq_to_netcdf.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_obs_sequence_tool b/models/cam-fv/work/path_names_obs_sequence_tool
index dcb4ccecbd..b354bba05d 100644
--- a/models/cam-fv/work/path_names_obs_sequence_tool
+++ b/models/cam-fv/work/path_names_obs_sequence_tool
@@ -23,7 +23,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/obs_sequence_tool/obs_sequence_tool.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_perfect_model_obs b/models/cam-fv/work/path_names_perfect_model_obs
index c8a1acb00d..3500ac9cb8 100644
--- a/models/cam-fv/work/path_names_perfect_model_obs
+++ b/models/cam-fv/work/path_names_perfect_model_obs
@@ -33,7 +33,9 @@ assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
assimilation_code/programs/perfect_model_obs/perfect_model_obs.f90
+models/cam-fv/chem_tables_mod.f90
models/cam-fv/model_mod.f90
models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/path_names_perturb_single_instance b/models/cam-fv/work/path_names_perturb_single_instance
new file mode 100644
index 0000000000..fa3344654a
--- /dev/null
+++ b/models/cam-fv/work/path_names_perturb_single_instance
@@ -0,0 +1,37 @@
+assimilation_code/location/threed_sphere/location_mod.f90
+assimilation_code/location/utilities/default_location_mod.f90
+assimilation_code/location/utilities/location_io_mod.f90
+assimilation_code/modules/assimilation/adaptive_inflate_mod.f90
+assimilation_code/modules/assimilation/assim_model_mod.f90
+assimilation_code/modules/assimilation/assim_tools_mod.f90
+assimilation_code/modules/assimilation/cov_cutoff_mod.f90
+assimilation_code/modules/assimilation/quality_control_mod.f90
+assimilation_code/modules/assimilation/reg_factor_mod.f90
+assimilation_code/modules/assimilation/sampling_error_correction_mod.f90
+assimilation_code/modules/io/dart_time_io_mod.f90
+assimilation_code/modules/io/direct_netcdf_mod.f90
+assimilation_code/modules/io/io_filenames_mod.f90
+assimilation_code/modules/io/state_structure_mod.f90
+assimilation_code/modules/io/state_vector_io_mod.f90
+assimilation_code/modules/observations/obs_kind_mod.f90
+assimilation_code/modules/observations/obs_sequence_mod.f90
+assimilation_code/modules/utilities/distributed_state_mod.f90
+assimilation_code/modules/utilities/ensemble_manager_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/null_win_mod.f90
+assimilation_code/modules/utilities/obs_impact_mod.f90
+assimilation_code/modules/utilities/options_mod.f90
+assimilation_code/modules/utilities/parse_args_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/perturb_single_instance/perturb_single_instance.f90
+models/cam-fv/chem_tables_mod.f90
+models/cam-fv/model_mod.f90
+models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
+observations/forward_operators/obs_def_mod.f90
+observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/cam-fv/work/quickbuild.csh b/models/cam-fv/work/quickbuild.csh
index 8f6d6853e4..c7140e2702 100755
--- a/models/cam-fv/work/quickbuild.csh
+++ b/models/cam-fv/work/quickbuild.csh
@@ -24,7 +24,7 @@
set BUILDING = "CAM FV"
# programs which have the option of building with MPI:
-set MPI_TARGETS = "filter perfect_model_obs model_mod_check"
+set MPI_TARGETS = "filter perfect_model_obs model_mod_check perturb_single_instance closest_member_tool"
# set default (override with -mpi or -nompi):
# 0 = build without MPI, 1 = build with MPI
@@ -56,7 +56,8 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+set nonomatch
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -112,7 +113,7 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -129,7 +130,7 @@ end
if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
@@ -143,7 +144,7 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build the MPI-enabled target(s)
@@ -163,7 +164,7 @@ foreach PROG ( $MPI_TARGETS )
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
@@ -171,7 +172,7 @@ end
if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
diff --git a/models/cam-old/work/quickbuild.csh b/models/cam-old/work/quickbuild.csh
index ab11205a6f..51adec8cf9 100755
--- a/models/cam-old/work/quickbuild.csh
+++ b/models/cam-old/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,17 +50,17 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
breaksw
endsw
- rm *.o *.mod
+ rm *.o *.mod Makefile .cppdefs
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo ""
echo "Success: All DART programs compiled."
diff --git a/models/cice/cice_to_dart.f90 b/models/cice/cice_to_dart.f90
new file mode 100644
index 0000000000..5ae3254770
--- /dev/null
+++ b/models/cice/cice_to_dart.f90
@@ -0,0 +1,150 @@
+! 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
+!
+! DART $Id$
+
+!> This program reads in ensemble CICE parameters (2D) and
+!> attach them to the CICE restart files
+
+program cice_to_dart
+
+use types_mod, only : r8,metadatalength
+use utilities_mod, only : error_handler, E_MSG, &
+ find_namelist_in_file, check_namelist_read, &
+ nmlfileunit,do_nml_file, do_nml_term
+use netcdf_utilities_mod, only : nc_check
+use netcdf
+
+!version controlled file description for error handling, do not edit
+character(len=*), parameter :: source = &
+"$URL$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
+
+! Contents specified in the input.nml: &cice_parameter_nml namelist
+integer, parameter :: max_parameters = 10
+integer, parameter :: num_parameter_columns = 1
+character(len=NF90_MAX_NAME) :: parameter_table(max_parameters,num_parameter_columns)
+
+character(len=256) :: cice_restart_input_file = 'cice_restart.nc'
+character(len=256) :: parameter_input_file = 'parameter_prior.nc'
+character(len=metadatalength) :: cice_parameters(max_parameters) = ''
+
+namelist /cice_parameter_nml/ &
+ cice_restart_input_file, &
+ parameter_input_file, &
+ cice_parameters
+
+integer :: iunit, io, ios
+integer :: ipar ! loop index for parameters
+integer :: npar ! number of parameters
+
+integer :: varid, ncid,ncid2, dimid1, dimid2
+real(r8), allocatable :: par(:,:,:)
+
+! message string
+character(len=512) :: string1
+
+! read the namelist
+call find_namelist_in_file('input.nml','cice_parameter_nml',iunit)
+read(iunit, nml = cice_parameter_nml, iostat = io)
+call check_namelist_read(iunit,io, 'cice_parameter_nml')
+
+! Record the namelist values used for the run
+if (do_nml_file()) write(nmlfileunit, nml=cice_parameter_nml)
+if (do_nml_term()) write( * , nml=cice_parameter_nml)
+
+! verify the cice_parameters namelist was filled in correctly
+! returns cice_parameters which has parameter names and number of parameters
+call verify_parameters(cice_parameters,npar,parameter_table)
+! open the parameter input file
+call nc_check(nf90_open(trim(parameter_input_file),NF90_nowrite,ncid), &
+ 'cice_to_dart','open '//trim(parameter_input_file))
+! get dims
+call nc_check(nf90_inq_dimid(ncid,'ni',dimid1), &
+ 'cice_to_dart','inq dimid ni')
+call nc_check(nf90_inquire_dimension(ncid,dimid1,len=ni), &
+ 'cice_to_dart','inq dimlen ni')
+call nc_check(nf90_inq_dimid(ncid,'nj',dimid2), &
+ 'cice_to_dart','inq dimid nj')
+call nc_check(nf90_inquire_dimension(ncid,dimid2,len=nj), &
+ 'cice_to_dart','inq dimlen nj')
+
+allocate (par(npar,ni,nj))
+
+
+do ipar =1, npar
+
+ call nc_check(nf90_inq_varid(ncid,cice_parameters(ipar),varid), &
+ 'cice_to_dart','inquire parameter '//trim(cice_parameters(ipar)))
+ call nc_check(nf90_get_var(ncid,varid,par(ipar,:,:)),&
+ 'cice_to_dart','get parameter '//trim(cice_parameters(ipar)))
+end do
+
+call nc_check(nf90_close(ncid),'cice_to_dart','close'//trim(parameter_input_file))
+
+call nc_check(nf90_open(trim(cice_restart_input_file),NF90_WRITE,ncid2), &
+ 'cice_to_dart','open '//trim(cice_restart_input_file))
+
+call nc_check(nf90_inq_dimid(ncid2,'ni',dimid1), &
+ 'cice_to_dart', 'inq dimid ni')
+call nc_check(nf90_inq_dimid(ncid2,'nj',dimid2), &
+ 'cice_to_dart', 'inq dimid nj')
+
+
+print *,par(1,1,1)
+do ipar=1, npar
+
+ ios = nf90_inq_varid(ncid2,cice_parameters(ipar),varid)
+ if (ios/=nf90_noerr) then !variable does not exist
+ call nc_check(nf90_redef(ncid2), &
+ 'cice_to_dart','redef')
+ call nc_check(nf90_def_var(ncid2,cice_parameters(ipar),nf90_double,dimids=(/dimid1,dimid2/),varid=varid), &
+ 'cice to dart', 'def parameter '//trim(cice_parameters(ipar)))
+ !print *, cice_parameters(ipar)
+ call nc_check(nf90_enddef(ncid2), &
+ 'cice_to_dart','redef')
+ !print *, dimid1,dimid2,size(par(ipar,1,:)),size(par(ipar,:,1))
+ end if
+ call nc_check(nf90_put_var(ncid2,varid,par(ipar,:,:)),&
+ 'cice to dart', 'put parameter '//trim(cice_parameters(ipar)))
+
+end do
+
+call nc_check(nf90_close(ncid2),'cice to dart','close'//trim(cice_restart_input_file))
+
+contains
+
+subroutine verify_parameters(parameters, ngood,table)
+character (len=*), intent(inout) :: parameters(:)
+integer, intent(out) :: ngood
+character (len=*), intent(out) :: table(:,:)
+
+integer:: nrows, i
+character(len=NF90_MAX_NAME) :: parname
+
+nrows = size(table,1)
+
+ngood = 0
+
+if ( parameters(1) == '') then ! no parameters found in the namelist
+ string1 = 'please specify parameters you want to estimate'
+ call error_handler(E_MSG,'verify_parameters', string1, source, revision, revdate)
+endif
+
+MyLoop : do i = 1, nrows
+ parname = trim(parameters(i))
+ if(parameters(i) == ' ') exit MyLoop
+ ngood = ngood + 1
+ end do MyLoop
+print *,'ngood:',ngood
+end subroutine verify_parameters
+
+end program cice_to_dart
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/models/cice/dart_cice_mod.f90 b/models/cice/dart_cice_mod.f90
index d5b1cbb333..47af541d02 100644
--- a/models/cice/dart_cice_mod.f90
+++ b/models/cice/dart_cice_mod.f90
@@ -11,9 +11,11 @@ module dart_cice_mod
set_calendar_type, get_calendar_string, &
print_date, print_time, operator(==), operator(-)
use utilities_mod, only : get_unit, open_file, close_file, file_exist, &
- register_module, error_handler, nc_check, &
+ register_module, error_handler, &
find_namelist_in_file, check_namelist_read, &
E_ERR, E_MSG, find_textfile_dims
+
+use netcdf_utilities_mod, only : nc_check
use typesizes
@@ -436,7 +438,6 @@ subroutine read_horiz_grid(nx, ny, ULAT, ULON, TLAT, TLON)
integer, intent(in) :: nx, ny
real(r8), dimension(nx,ny), intent(out) :: ULAT, ULON, TLAT, TLON
-integer :: i,j
!real(r8), dimension(nx,ny) :: &
! HTN , &! length (cm) of north edge of T box
! HTE , &! length (cm) of east edge of T box
@@ -473,14 +474,6 @@ subroutine read_horiz_grid(nx, ny, ULAT, ULON, TLAT, TLON)
!read(grid_unit, rec=7) ANGLE
close(grid_unit)
-!DEBUG
-!do j=2,ny
-!do i=2,nx
-
-! write(*,*)'i,j',i,j,'ULAT',ULAT(i,j)
-!end do
-!end do
-!DEBUG
call calc_tpoints(nx, ny, ULAT, ULON, TLAT, TLON)
! convert from radians to degrees
diff --git a/models/cice/dart_to_cice.f90 b/models/cice/dart_to_cice.f90
index 6ba49f346a..75eb2323c7 100644
--- a/models/cice/dart_to_cice.f90
+++ b/models/cice/dart_to_cice.f90
@@ -7,7 +7,8 @@
program dart_to_cice
!----------------------------------------------------------------------
-! purpose: muck with cice state vector after filter
+! purpose: implement a 'partition function' to modify the cice state
+! to be consistent with the states from assimilation
!
! method: Read in restart (restart with prior) and out restart (restart
! with posterior) written by DART after filter.
@@ -18,17 +19,17 @@ program dart_to_cice
use types_mod, only : r8
use utilities_mod, only : initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
- logfileunit, nc_check, file_exist, &
- error_handler, E_ERR, E_MSG, to_upper
+ file_exist, error_handler, E_ERR, E_MSG, to_upper
+use netcdf_utilities_mod, only : nc_check
use netcdf
implicit none
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
!------------------------------------------------------------------
@@ -36,10 +37,13 @@ program dart_to_cice
character(len=256) :: original_cice_input_file = 'cice_restart.nc'
character(len=256) :: previous_cice_input_file = 'pre_restart.nc'
character(len=128) :: balance_method = 'simple_squeeze'
+character(len=15) :: r_snw_name = 'r_snw'
+
namelist /dart_to_cice_nml/ dart_to_cice_input_file, &
original_cice_input_file, &
previous_cice_input_file, &
- balance_method
+ balance_method, &
+ r_snw_name
character(len=512) :: string1, string2, msgstring
character(len=15) :: varname
@@ -90,9 +94,13 @@ program dart_to_cice
real(r8), allocatable :: qsno002(:,:,:)
real(r8), allocatable :: qsno003(:,:,:)
real(r8), allocatable :: aice(:,:)
-real(r8), allocatable :: vice(:,:)
-real(r8), allocatable :: vsno(:,:)
+!real(r8), allocatable :: vice(:,:)
+!real(r8), allocatable :: vsno(:,:)
+
+!Parameters
+real(r8), allocatable :: r_snw(:,:)
+!Temporary variables
real(r8), allocatable :: aice_temp(:,:)
real(r8), allocatable :: increment_aice(:,:)
!real(r8), allocatable :: increment_vice(:,:)
@@ -107,10 +115,14 @@ program dart_to_cice
real(r8) :: R, weight_aicen !, weight_vicen, weight_vsnon
-integer :: i, j, k, n
+integer :: i, j, n
+! integer :: k
integer :: VarID, ncid,ncid2, iunit, io, ndims
real(r8) :: squeeze
+real(r8), parameter :: & !from ice_shortwave.F90
+ rsnw_max = 1.6_r8, &
+ rsnw_min = -2.0_r8
real(r8), parameter :: & ! from ice_therm_vertical.F90
phi_init = 0.75_r8, & ! initial liquid fraction of frazil ice
@@ -146,18 +158,18 @@ program dart_to_cice
call error_handler(E_MSG,'dart_to_cice',string1,text2=string2)
if ( .not. file_exist(dart_to_cice_input_file) ) then
- write(string1,*) 'cannot open file ', trim(dart_to_cice_input_file),' for updating.'
+ write(string1,*) 'cannot open "', trim(dart_to_cice_input_file),'" for updating.'
call error_handler(E_ERR,'dart_to_cice:filename not found ',trim(dart_to_cice_input_file))
endif
if ( .not. file_exist(original_cice_input_file) ) then
- write(string1,*) 'cannot open file ', trim(original_cice_input_file),' for reading.'
+ write(string1,*) 'cannot open "', trim(original_cice_input_file),'" for reading.'
call error_handler(E_ERR,'dart_to_cice:filename not found ',trim(original_cice_input_file))
endif
! open original restart file with read only
call nc_check( nf90_open(trim(original_cice_input_file), NF90_NOWRITE, ncid), &
- 'dart_to_cice', 'open '//trim(original_cice_input_file))
+ 'dart_to_cice', 'open "'//trim(original_cice_input_file)//'"')
! get the original ice concentration, ice volume and snow volume (FYI it is allocated in routine)
call get_3d_variable(ncid, 'aicen', aicen_original, original_cice_input_file)
@@ -168,7 +180,7 @@ program dart_to_cice
! open posterior restart file with read and write
call nc_check( nf90_open(trim(dart_to_cice_input_file), NF90_WRITE, ncid), &
- 'dart_to_cice', 'open '//trim(dart_to_cice_input_file))
+ 'dart_to_cice', 'open "'//trim(dart_to_cice_input_file)//'"')
! get the key restart variables (FYI allocated in the routine)
call get_3d_variable(ncid, 'aicen', aicen, dart_to_cice_input_file)
@@ -195,6 +207,8 @@ program dart_to_cice
call get_3d_variable(ncid, 'qsno002', qsno002, dart_to_cice_input_file)
call get_3d_variable(ncid, 'qsno003', qsno003, dart_to_cice_input_file)
+! get the parameter variables in the restart
+call get_2d_variable(ncid, r_snw_name, r_snw, dart_to_cice_input_file)
Nx = size(aicen,1)
Ny = size(aicen,2)
@@ -260,8 +274,8 @@ program dart_to_cice
!Open the restart file from the previous day (beginning of the current
!day's forecast)
if ( .not. file_exist(previous_cice_input_file)) then
- write(string1,*)'cannot open file ',trim(previous_cice_input_file),'for updating.'
- call error_handler(E_ERR,'dart_to_cice: filename not found',trim(previous_cice_input_file))
+ write(string1,*)'cannot open "',trim(previous_cice_input_file),'" for updating.'
+ call error_handler(E_ERR,'dart_to_cice',string1)
endif
call nc_check(nf90_open(trim(previous_cice_input_file),NF90_NOWRITE,ncid2), &
@@ -389,7 +403,7 @@ program dart_to_cice
write(string1,*)'input.nml:dart_to_cice_nml:balance_method "'//trim(balance_method)//'" unsupported.'
write(string2,*)'valid values are "simple_squeeze", "tendency_weight", or "prior weight"'
- call error_handler(E_ERR,'dart_to_cice',string1,source, revision, revdate, text2=string2)
+ call error_handler(E_ERR,'dart_to_cice',string1, source, revision, revdate, text2=string2)
CASE ('PRIOR_WEIGHT')
!Fei
@@ -500,6 +514,10 @@ program dart_to_cice
aicen = min(1.0_r8,aicen) ! concentrations must not exceed 1
Tsfcn = min(Tsmelt,Tsfcn) ! ice/sno surface must not exceed melting
+ ! post-process the parameters
+ r_snw = min(rsnw_max,r_snw)
+ r_snw = max(rsnw_min,r_snw)
+
! calculate aice, which might be negative or >1 at this point
aice = aicen(:,:,1)
do n = 2, Ncat
@@ -668,7 +686,6 @@ program dart_to_cice
!for testing make something to fix
! aicen(10,10,1)=1.1
! write(*,*) (aicen(10,10,k), k=1,5)
-
varname='aicen'
io = nf90_inq_varid(ncid, trim(varname), VarID)
@@ -854,6 +871,13 @@ program dart_to_cice
call nc_check(io, 'dart_to_cice', &
'put_var '//trim(varname)//' '//trim(dart_to_cice_input_file))
+ varname=r_snw_name
+ io = nf90_inq_varid(ncid, trim(varname), VarID)
+ call nc_check(io, 'dart_to_cice', &
+ 'inq_varid '//trim(varname)//' '//trim(dart_to_cice_input_file))
+ io = nf90_put_var(ncid, VarID, r_snw)
+ call nc_check(io, 'dart_to_cice', &
+ 'put_var '//trim(varname)//' '//trim(dart_to_cice_input_file))
call nc_check(nf90_close(ncid),'dart_to_cice', 'close '//trim(dart_to_cice_input_file))
@@ -862,6 +886,7 @@ program dart_to_cice
deallocate( sice001, sice002, sice003, sice004, sice005, sice006, sice007, sice008 )
deallocate( qice001, qice002, qice003, qice004, qice005, qice006, qice007, qice008 )
deallocate( qsno001, qsno002, qsno003 )
+deallocate(r_snw)
call finalize_utilities('dart_to_cice')
@@ -908,6 +933,48 @@ subroutine get_3d_variable(ncid, varname, var, filename)
end subroutine get_3d_variable
+!==============================================================
+
+subroutine get_2d_variable(ncid, varname, var, filename)
+
+integer, intent(in) :: ncid
+character(len=*), intent(in) :: varname
+real(r8), allocatable, intent(out) :: var(:,:)
+character(len=*), intent(in) :: filename
+
+integer, dimension(NF90_MAX_VAR_DIMS) :: dimIDs, dimLengths
+character(len=NF90_MAX_NAME) :: dimName
+
+write(msgstring,*) trim(varname)//' '//trim(filename)
+
+io = nf90_inq_varid(ncid, trim(varname), VarID)
+call nc_check(io, 'dart_to_cice', 'inq_varid '//trim(msgstring))
+
+io = nf90_inquire_variable(ncid, VarID, dimids=dimIDs, ndims=ndims)
+call nc_check(io, 'dart_to_cice', 'inquire_variable '//trim(msgstring))
+
+if (ndims /= 2) then
+ write(string2,*) 'expected 2 dimension, got ', ndims
+ call error_handler(E_ERR,'dart_to_cice',msgstring,text2=string2)
+endif
+
+dimLengths = 1
+DimensionLoop : do i = 1,ndims
+
+ write(string1,'(''inquire dimension'',i2,A)') i,trim(msgstring)
+ io = nf90_inquire_dimension(ncid, dimIDs(i), name=dimname, len=dimLengths(i))
+ call nc_check(io, 'dart_to_cice', string1)
+
+enddo DimensionLoop
+
+allocate( var(dimLengths(1), dimLengths(2)) )
+
+call nc_check(nf90_get_var(ncid, VarID, var), 'dart_to_cice', &
+ 'get_var '//trim(msgstring))
+
+end subroutine get_2d_variable
+
+
!=======================================================================
! Mushy Layer Formulation - Assur (1958) liquidus
! functions from cice/src/source/ice_therm_mushy.F90 by Adrian Turner
diff --git a/models/cice/model_mod.f90 b/models/cice/model_mod.f90
index 3ca3cea36f..ea8a7cba33 100644
--- a/models/cice/model_mod.f90
+++ b/models/cice/model_mod.f90
@@ -8,7 +8,6 @@ module model_mod
! This is the interface between the CICE ocean model and DART.
! author: C Bitz June 2016
-! borrowed heavily from ?
! Modules that are absolutely required for use are listed
use types_mod, only : r4, r8, i4, i8, SECPERDAY, MISSING_R8, rad2deg, &
@@ -53,6 +52,7 @@ module model_mod
QTY_SEAICE_AGREG_SNOWVOLUME, &
QTY_SEAICE_AGREG_THICKNESS , &
QTY_SEAICE_AGREG_SNOWDEPTH , &
+ QTY_SEAICE_CATEGORY , &
QTY_U_SEAICE_COMPONENT , &
QTY_V_SEAICE_COMPONENT , &
QTY_SEAICE_ALBEDODIRVIZ , &
@@ -149,14 +149,14 @@ module model_mod
! generally useful routines for various support purposes.
! the interfaces here can be changed as appropriate.
-! FIXME: we should no longer need restart_file_to_sv and sv_to_restart_file
+
public :: get_cice_restart_filename, test_interpolation
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
! message strings
character(len=512) :: string1
@@ -271,9 +271,6 @@ module model_mod
integer(i8) :: model_size ! the state vector length
-
-!-------------------------- CMB did not touch from here -------------------
-
! NOTE (dipole/tripole grids): since both of the dipole and tripole
! grids are logically rectangular we can use the same interpolation
! scheme originally implemented for the dipole grid. Here we can
@@ -332,13 +329,11 @@ module model_mod
integer :: domain_id
-contains
-
!------------------------------------------------------------------
+contains
!------------------------------------------------------------------
-!-------------------------- CMB did not touch to here ----------------
-! CMB edit to change vertical dimension to cat
+
subroutine static_init_model()
! Called to do one time initialization of the model. In this case,
@@ -354,7 +349,7 @@ subroutine static_init_model()
!
! allocate space, and read in actual grid values
!
-! figure out model timestep. FIXME: from where?
+! figure out model timestep (not really used in cice)
!
! Compute the model size.
!
@@ -434,8 +429,9 @@ subroutine static_init_model()
! Initialize the interpolation routines
call init_interp()
-!CMB I do not understand this next bit, maybe this is the dart restart file
-!> @todo 'cice.r.nc' is hardcoded in dart_cice_mod.f90
+! Determine the shape of the variables from "cice.r.nc"
+! The assimilate.csh, perfect_model.csh must ensure the cice restart file
+! is linked to this filename.
domain_id = add_domain('cice.r.nc', nfields, &
var_names = variable_table(1:nfields, VAR_NAME_INDEX), &
kind_list = state_kinds_list(1:nfields), &
@@ -450,7 +446,6 @@ end subroutine static_init_model
!------------------------------------------------------------
-! CMB no change
subroutine init_interp()
! Initializes data structures needed for cice interpolation for
@@ -477,8 +472,6 @@ end subroutine init_interp
!------------------------------------------------------------
-!CMB change only QTY_X to QTY_SEAICE_X and took out
-! height sent to all_corners_wet since no bathym in cice
subroutine init_dipole_interp()
! Build the data structure for interpolation for a dipole grid.
@@ -631,7 +624,6 @@ end subroutine init_dipole_interp
!------------------------------------------------------------
-!CMB no change
subroutine get_reg_box_indices(lon, lat, x_ind, y_ind)
real(r8), intent(in) :: lon, lat
integer, intent(out) :: x_ind, y_ind
@@ -646,7 +638,6 @@ end subroutine get_reg_box_indices
!------------------------------------------------------------
-!CMB no change
subroutine get_reg_lon_box(lon, x_ind)
real(r8), intent(in) :: lon
integer, intent(out) :: x_ind
@@ -662,7 +653,6 @@ end subroutine get_reg_lon_box
!------------------------------------------------------------
-!CMB no change
subroutine get_reg_lat_box(lat, y_ind)
real(r8), intent(in) :: lat
integer, intent(out) :: y_ind
@@ -678,7 +668,6 @@ end subroutine get_reg_lat_box
!------------------------------------------------------------
-!CMB no change
subroutine reg_box_overlap(x_corners, y_corners, is_pole, reg_lon_ind, reg_lat_ind)
real(r8), intent(in) :: x_corners(4), y_corners(4)
logical, intent(in) :: is_pole
@@ -751,7 +740,6 @@ end subroutine reg_box_overlap
!------------------------------------------------------------
-!CMB no change
subroutine get_quad_corners(x, i, j, corners)
real(r8), intent(in) :: x(:, :)
integer, intent(in) :: i, j
@@ -775,7 +763,6 @@ end subroutine get_quad_corners
!------------------------------------------------------------
-!CMB no change
subroutine update_reg_list(reg_list_num, reg_list_lon, reg_list_lat, &
reg_lon_ind, reg_lat_ind, dipole_lon_index, dipole_lat_index)
@@ -815,7 +802,6 @@ end subroutine update_reg_list
!------------------------------------------------------------------
!> Returns the number of items in the state vector
-!CMB no change
function get_model_size()
integer(i8) :: get_model_size
@@ -827,7 +813,6 @@ end function get_model_size
!------------------------------------------------------------------
-!CMB changed a lot (but do not change variables in call)
subroutine model_interpolate(state_handle, ens_size, location, obs_type, expected_obs, istatus)
type(ensemble_type), intent(in) :: state_handle
@@ -874,7 +859,20 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte
llat = loc_array(2)
cat_index = int(loc_array(3))
-if (debug > 1) print *, 'requesting interpolation of ', obs_type, ' at ', llon, llat, cat_index
+! Special case. Only used when trying to determine the number of ice categories.
+! Note the early return. The actual lat/lon is unimportant.
+
+if (obs_type == QTY_SEAICE_CATEGORY) then
+ if (cat_index <= Ncat) then
+ istatus = 0
+ expected_obs = cat_index
+ RETURN
+ endif
+endif
+
+if (debug > 1) then
+ print *, 'requesting interpolation of ', obs_type, ' at ', llon, llat, cat_index
+endif
! The base_offset is the index of state vector that corresponds to
! a variable block without regard to level or location, so it can be
@@ -978,6 +976,16 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte
call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, obs_type, cat_signal_interm, expected_fy, istatus)
temp = temp + expected_conc * expected_fy !sum(aicen*fyn) = FY % over ice
temp1= temp1+ expected_conc !sum(aicen) = aice
+
+ if (any(expected_conc<0.0) .or. any(expected_conc>1.0))then
+ print*,'obstype FY expected sicn:',expected_conc
+ print*,'FY sicn lat lon:',llat,llon
+ endif
+ if (any(expected_fy>1.0) .or. any(expected_fy<0.0)) then
+ print*,'obstype FY expected fyn:',expected_fy,llat,llon
+ print*,'FY fyn lat lon:',llat,llon
+ endif
+
end do
expected_obs = temp/max(temp1,1.0e-8) !sum(aicen*fyn)/aice = FY % in the gridcell
else if (cat_signal == -3 ) then
@@ -994,16 +1002,35 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte
base_offset = get_index_start(domain_id,get_varid_from_kind(QTY_SEAICE_SURFACETEMP))
base_offset = base_offset + (icat-1) * Nx * Ny
call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, obs_type, cat_signal_interm, expected_tsfc, istatus)
+ if (any(expected_conc<0.0) .or. any(expected_conc>1.0))then
+ print*,'obstype TSFC expected sicn:',expected_conc
+ print*,'TSFC sicn lat lon:',llat,llon
+ endif
if (any(expected_tsfc>50.0) .or. any(expected_tsfc<-100.0)) then
- print*,'expected value:',expected_tsfc
- print*,'lat,lon:',llat,llon
+ print*,'obstype TSFC expected tsfcn:',expected_tsfc
+ print*,'TSFC tsfcn lat lon:',llat,llon
endif
temp = temp + expected_conc * expected_tsfc !sum(aicen*Tsfcn)
temp1= temp1+ expected_conc !sum(aicen) = aice
end do
expected_obs = temp/max(temp1,1.0e-8) !sum(aicen*Tsfcn)/aice = Tsfc ;averaged temperature over sea-ice covered portion
+ if (any(expected_obs>50.0) .or. any(expected_obs<-100.0)) then
+ print*,'obstype TSFC expected obs:',expected_obs
+ print*,'TSFC tsfc lat lon:' ,llat,llon
+ print*,'temp:',temp
+ print*,'temp1:',temp1
+ endif
+
else
call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, obs_type, cat_signal, expected_obs, istatus)
+ if (any(expected_obs<0.0))then
+ print*,'obstype SIC expected concs:',expected_obs
+ print*,'SIC sic negative lat lon:',llat,llon
+ endif
+ if (any(expected_obs>1.0))then
+ print*,'obstype SIC expected concs:',expected_obs
+ print*,'SIC sic positive lat lon:',llat,llon
+ endif
endif
@@ -1013,6 +1040,12 @@ subroutine model_interpolate(state_handle, ens_size, location, obs_type, expecte
base_offset = get_index_start(domain_id, get_varid_from_kind(QTY_SEAICE_CONCENTR))
call lon_lat_interpolate(state_handle, ens_size, base_offset, llon, llat, obs_type, cat_signal, expected_aggr_conc, istatus)
expected_obs = expected_obs/max(expected_aggr_conc,1.0e-8) ! hope this is allowed so we never divide by zero
+
+ if (any(expected_aggr_conc<0.0) .or. any(expected_aggr_conc>1.0))then
+ print*,'obstype SIT expected conc:',expected_aggr_conc
+ print*,'SIT sic lat lon:',llat,llon
+ endif
+
endif
if (debug > 1) print *, 'interp val, istatus = ', expected_obs, istatus
@@ -1243,8 +1276,10 @@ end subroutine lon_lat_interpolate
!------------------------------------------------------------
! CMB changed so bathymetry check is land check only, height was only used
! for masking below bathymetry, not needed in sea ice so removed
+
function get_val(lon_index, lat_index, nlon, state_handle, offset, &
ens_size, var_type, masked)
+
! Returns the index in state vecture structure of a variable at a single level
! given the lat and lon indices. Used by lon_lat_interpolate only
! 'masked' returns true if this is NOT a valid grid location (e.g. land)
@@ -1268,7 +1303,7 @@ function get_val(lon_index, lat_index, nlon, state_handle, offset, &
masked = .false. ! cell is water
-! FIXME: this should call get_dart_vector_index() to convert from lat,lon,cat
+!>@todo FIXME: this should call get_dart_vector_index() to convert from lat,lon,cat
! to offset in the state vector.
! this code assumes it knows the layout (lons varying most rapidly)
! state index must be 8byte integer
@@ -1281,7 +1316,6 @@ end function get_val
!------------------------------------------------------------
-! CMB no change
subroutine get_irreg_box(lon, lat, lon_array, lat_array, &
found_x, found_y, lon_fract, lat_fract, istatus)
@@ -1317,7 +1351,6 @@ end subroutine get_irreg_box
!------------------------------------------------------------
-! CMB no change
subroutine lon_bounds(lon, nlons, lon_array, bot, top, fract)
real(r8), intent(in) :: lon
integer, intent(in) :: nlons
@@ -1362,7 +1395,6 @@ end subroutine lon_bounds
!-------------------------------------------------------------
-! CMB no change
subroutine lat_bounds(lat, nlats, lat_array, bot, top, fract, istatus)
real(r8), intent(in) :: lat
integer, intent(in) :: nlats
@@ -1413,7 +1445,6 @@ end subroutine lat_bounds
!------------------------------------------------------------------
-! CMB no change
function lon_dist(lon1, lon2)
real(r8), intent(in) :: lon1, lon2
real(r8) :: lon_dist
@@ -1437,7 +1468,6 @@ end function lon_dist
!------------------------------------------------------------
-! CMB no change
subroutine get_dipole_quad(lon, lat, qlons, qlats, num_inds, start_ind, &
x_inds, y_inds, found_x, found_y, istatus)
@@ -1476,7 +1506,6 @@ end subroutine get_dipole_quad
!------------------------------------------------------------
-! CMB no change
function in_quad(lon, lat, x_corners, y_corners)
real(r8), intent(in) :: lon, lat, x_corners(4), y_corners(4)
logical :: in_quad
@@ -1538,7 +1567,6 @@ end function in_quad
!------------------------------------------------------------
-! CMB no change
subroutine line_intercept(side_x_in, side_y, x_point_in, y_point, &
cant_be_in_box, in_box, intercept_above, intercept_below)
@@ -1630,7 +1658,6 @@ end subroutine line_intercept
!------------------------------------------------------------
-! CMB no change
subroutine quad_bilinear_interp(lon_in, lat, x_corners_in, y_corners, &
p, ens_size, expected_obs)
@@ -1732,7 +1759,6 @@ end subroutine quad_bilinear_interp
!------------------------------------------------------------
-! CMB no change
subroutine mat3x3(m, v, r)
real(r8), intent(in) :: m(3, 3), v(3)
real(r8), intent(out) :: r(3)
@@ -1760,7 +1786,6 @@ end subroutine mat3x3
!------------------------------------------------------------
-! CMB no change
function deter3(m)
real(r8), intent(in) :: m(3, 3)
real(r8) :: deter3
@@ -1773,14 +1798,11 @@ function deter3(m)
end function deter3
-!------------------------------------------------------------
-! CMB removed height_bounds since unused
!------------------------------------------------------------------
!> Returns the the time step of the model; the smallest increment
!> in time that the model is capable of advancing the state in a given
!> implementation. This interface is required for all applications.
-! CMB no change
function shortest_time_between_assimilations()
type(time_type) :: shortest_time_between_assimilations
@@ -1791,28 +1813,25 @@ function shortest_time_between_assimilations()
end function shortest_time_between_assimilations
!------------------------------------------------------------------
+!> Given an integer index (index_in) to point in state vector structure, returns the
+!> associated location, which is an array of indices for lat, lon, and cat.
+!> A second intent(out) optional argument kind
+!> can be returned if the model has more than one type of field (for
+!> instance temperature and zonal wind component). This interface is
+!> required for all filter applications as it is required for computing
+!> the distance between observations and state variables.
-! CMB changed extensively
subroutine get_state_meta_data(index_in, location, var_type)
- integer(i8), intent(in) :: index_in ! index of point in state vector
- ! depends on variable, lat, lon, and cat
- type(location_type), intent(out) :: location
- integer, intent(out), optional :: var_type
-
-! Given an integer index (index_in) to point in state vector structure, returns the
-! associated location, which is an array of indices for lat, lon, and cat.
-! A second intent(out) optional argument kind
-! can be returned if the model has more than one type of field (for
-! instance temperature and zonal wind component). This interface is
-! required for all filter applications as it is required for computing
-! the distance between observations and state variables.
+
+integer(i8), intent(in) :: index_in
+type(location_type), intent(out) :: location
+integer, intent(out), optional :: var_type
real(r8) :: lat, lon, rcat
-integer :: lon_index, lat_index, cat_index, local_var, var_id
+integer :: lon_index, lat_index, cat_index, local_var, var_id
if ( .not. module_initialized ) call static_init_model
-! get_model_variable_indices is in ../../io/state_structure_mod.f90
call get_model_variable_indices(index_in, lon_index, lat_index, cat_index, var_id=var_id)
call get_state_kind(var_id, local_var)
@@ -1825,10 +1844,10 @@ subroutine get_state_meta_data(index_in, location, var_type)
endif
if (debug > 5) print *, 'lon, lat, cat_index = ', lon, lat, cat_index
-rcat=cat_index*1.0 ! CMB verified needs to be a real though VERTISLEVEL is used
+rcat = cat_index*1.0_r8
location = set_location(lon, lat, rcat, VERTISLEVEL)
-if (present(var_type)) then ! CMB hacked is_dry_land to ignore depth
+if (present(var_type)) then
var_type = local_var
if(is_dry_land(var_type, lon_index, lat_index)) then
var_type = QTY_DRY_LAND
@@ -1839,7 +1858,6 @@ end subroutine get_state_meta_data
!--------------------------------------------------------------------
-! CMB no change
function get_varid_from_kind(dart_kind)
integer, intent(in) :: dart_kind
@@ -1870,7 +1888,6 @@ end function get_varid_from_kind
!------------------------------------------------------------------
-! CMB no change
subroutine get_state_kind(var_ind, var_type)
integer, intent(in) :: var_ind
integer, intent(out) :: var_type
@@ -1887,7 +1904,6 @@ end subroutine get_state_kind
!------------------------------------------------------------------
-! CMB changed to rip height out of is_dry_land call
subroutine get_state_kind_inc_dry(index_in, var_type)
integer(i8), intent(in) :: index_in
integer, intent(out) :: var_type
@@ -2195,7 +2211,6 @@ end subroutine write_model_time
!------------------------------------------------------------------
-! CMB no change
subroutine pert_model_copies(state_ens_handle, ens_size, pert_amp, interf_provided)
type(ensemble_type), intent(inout) :: state_ens_handle
@@ -2247,6 +2262,7 @@ end subroutine pert_model_copies
!------------------------------------------------------------------
! CMB took out bathymetry assuming KMU>0 and KMT>0 for ocn
+
function is_dry_land(obs_type, lon_index, lat_index)
integer, intent(in) :: obs_type
integer, intent(in) :: lon_index, lat_index
@@ -2271,10 +2287,10 @@ end function is_dry_land
!------------------------------------------------------------------
-!CMB edited a bit
function is_on_ugrid(obs_type)
- integer, intent(in) :: obs_type
- logical :: is_on_ugrid
+
+integer, intent(in) :: obs_type
+logical :: is_on_ugrid
! returns true if U, V -- everything else is on T grid
@@ -2289,13 +2305,12 @@ end function is_on_ugrid
!------------------------------------------------------------------
-! CMB took out height in var list to is_dry_land
function all_corners_wet(obs_kind, lon_ind, lat_ind)
- integer, intent(in) :: obs_kind, lon_ind, lat_ind
- logical :: all_corners_wet
+integer, intent(in) :: obs_kind, lon_ind, lat_ind
+logical :: all_corners_wet
- integer :: lon_ind_p1
+integer :: lon_ind_p1
! returns true only if all of the corners are land
@@ -2316,12 +2331,10 @@ function all_corners_wet(obs_kind, lon_ind, lat_ind)
end function all_corners_wet
!------------------------------------------------------------------
+!> Write the grid to a netcdf file for checking.
-!CMB edited, change vert dim to cat
subroutine write_grid_netcdf()
-! Write the grid to a netcdf file for checking.
-
integer :: ncid, NlonDimID, NlatDimID, NcatDimID
integer :: nlon, nlat
integer :: ulatVarID, ulonVarID, TLATvarid, TLONvarid
@@ -2381,7 +2394,6 @@ end subroutine write_grid_netcdf
!------------------------------------------------------------------
-! CMB no change
subroutine get_close_state(filt_gc, base_loc, base_type, locs, loc_qtys, loc_indx, &
num_close, close_indices, distances, state_handle)
@@ -2435,7 +2447,7 @@ subroutine get_close_state(filt_gc, base_loc, base_type, locs, loc_qtys, loc_ind
end subroutine get_close_state
!------------------------------------------------------------------
-! CMB no change
+
subroutine write_grid_interptest()
! Write the grid to an ascii file - in a format suitable for
@@ -2518,7 +2530,7 @@ subroutine write_grid_interptest()
end subroutine write_grid_interptest
!------------------------------------------------------------------
-! CMB no change
+
subroutine test_interpolation(test_casenum)
integer, intent(in) :: test_casenum
@@ -2526,19 +2538,14 @@ subroutine test_interpolation(test_casenum)
end subroutine test_interpolation
-!------------------------------------------------------------------
-!CMB eliminated compute_temperature, insitu_temp, dpth2pres, and do_interp
-! which are not needed for cice
-!------------------------------------------------------------------
-
!--------------------------------------------------------------------
-!CMB changed heavily
+
function read_model_time(filename)
character(len=256) :: filename
type(time_type) :: read_model_time
-integer :: ncid !< netcdf file id
+integer :: ncid !< netcdf file id
integer :: nyr , & ! year number, in cice restart
month , & ! month number, 1 to 12, in cice restart
mday , & ! day of the month, in cice restart
@@ -2573,13 +2580,10 @@ function read_model_time(filename)
nyr = 1
endif
-hour = int(sec/3600)
-minute=int((sec-hour*3600)/60)
-secthismin=int(sec-hour*3600-minute*60)
+hour = int(sec/3600)
+minute = int((sec-hour*3600)/60)
+secthismin = int(sec-hour*3600-minute*60)
-!CMB looked at set_date in ../../time_manager/time_manager_mod.f90
-! and it wants inputs with seconds between 0 and 60
-! it has another variable that is totseconds, which is seconds in a day
read_model_time = set_date(nyr, month, mday, hour, minute, secthismin)
end function read_model_time
@@ -2591,7 +2595,7 @@ end function read_model_time
!>
!> netcdf_variable_name ; dart_kind_string ; update_string
!>
-! CMB changedd as needed
+
subroutine verify_state_variables( state_variables, ngood, table, kind_list, update_var )
character(len=*), intent(inout) :: state_variables(:)
@@ -2609,6 +2613,9 @@ subroutine verify_state_variables( state_variables, ngood, table, kind_list, upd
ngood = 0
+!>@todo deprecate. Remove a hidden 'default' set of variables.
+!>@ The default is provided in the input namelist.
+
if ( state_variables(1) == ' ' ) then ! no model_state_variables namelist provided
call use_default_state_variables( state_variables )
string1 = 'model_nml:model_state_variables not specified using default variables'
@@ -2627,7 +2634,7 @@ subroutine verify_state_variables( state_variables, ngood, table, kind_list, upd
table(i,2) = trim(dartstr)
table(i,3) = trim(update)
- if ( table(i,1) == ' ' .and. table(i,2) == ' ' .and. table(i,3) == ' ') exit MyLoop ! Found end of list.
+ if ( table(i,1) == ' ' .and. table(i,2) == ' ' .and. table(i,3) == ' ') exit MyLoop
if ( table(i,1) == ' ' .or. table(i,2) == ' ' .or. table(i,3) == ' ' ) then
string1 = 'model_nml:model_state_variables not fully specified'
@@ -2670,9 +2677,9 @@ subroutine verify_state_variables( state_variables, ngood, table, kind_list, upd
end subroutine verify_state_variables
!------------------------------------------------------------------
-!> Default state_variables from model_mod. CMB following POP code
-!> which says: Must keep in the same order to be consistent with previous versions.
-! CMB changed kinds
+!> Default state_variables from model_mod.
+!>@todo DEPRECATE
+
subroutine use_default_state_variables( state_variables )
character(len=*), intent(inout) :: state_variables(:)
diff --git a/models/cice/shell_scripts/CESM2_0_DART_config b/models/cice/shell_scripts/CESM2_0_DART_config
new file mode 100755
index 0000000000..7f28bea1dc
--- /dev/null
+++ b/models/cice/shell_scripts/CESM2_0_DART_config
@@ -0,0 +1,413 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+# ---------------------
+# Purpose
+# ---------------------
+#
+# This script integrates DART with a pre-existing CESM multi-instance case.
+# It must be run from a valid CASEROOT directory and some environment variables
+# must be set (as in CESM#_#_setup_YYY). If the case was created
+# using one of the DART scripts, a copy of this script be staged in the
+# CASEROOT directory automatically, and DARTROOT is set at that time.
+#
+# CICE is the only active model component.
+# CESM starts and stops to allow for CICE to assimilate every 24 hours.
+#
+# This script will build the DART executables if they are not found.
+#
+# ---------------------
+# How to configure this script
+# ---------------------
+#
+# -- Ensure DARTROOT references a valid DART directory.
+# -- Examine the whole script to identify things to change for your experiments.
+# -- Provide any initial files needed by your run:
+# inflation
+# sampling error correction
+# -- Run this script.
+# -- Edit the DART input.nml that appears in the ${CASEROOT} directory.
+# -- Submit the job using ${CASEROOT}/case.submit
+#
+# ==============================================================================
+# Get the environment of the case - defines number of instances/ensemble size ...
+# Each model component has their own number of instances.
+# ==============================================================================
+
+if ( ! -e ./xmlquery ) then
+ echo "ERROR: $0 must be run from a CASEROOT directory".
+ exit -1
+endif
+
+setenv CASE `./xmlquery --value CASE `
+setenv CASEROOT `./xmlquery --value CASEROOT `
+setenv COMPSET `./xmlquery --value COMPSET `
+setenv EXEROOT `./xmlquery --value EXEROOT `
+setenv RUNDIR `./xmlquery --value RUNDIR `
+setenv NINST_ICE `./xmlquery --value NINST_ICE`
+setenv ICE_COMPONENT `./xmlquery --value COMP_ICE `
+
+echo $CASE
+echo $CASEROOT
+# Check to make sure we are running what we are supporting
+
+if ( $ICE_COMPONENT != 'cice' ) then
+ echo 'ERROR: This configuration file is specifically for "cice".'
+ echo 'ERROR: the ice component for this case is "'${ICE_COMPONENT}'".'
+ exit 1
+endif
+
+set num_instances = $NINST_ICE
+
+./xmlchange DATA_ASSIMILATION=TRUE
+./xmlchange DATA_ASSIMILATION_CYCLES=1
+./xmlchange DATA_ASSIMILATION_SCRIPT=${CASEROOT}/assimilate.csh
+
+# /glade/u/home/yfzhang/dart_rma_trunk and /glade/p/work/yfzhang/observations/syn/cice5/member10/aggre/aice are replaced by useful
+# values by the CESM_configure script.
+# It should reference the
+# base portion of the DART code tree.
+
+setenv DARTROOT BOGUS_DART_ROOT_STRING
+setenv OBSROOT BOGUS_DART_OBS_STRING
+
+# ==============================================================================
+# Some
+# ==============================================================================
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+# The FORCE options are not optional.
+# The VERBOSE options are useful for debugging though
+# some systems don't like the -v option to any of the following
+switch ("`hostname`")
+ case ys*:
+ # NCAR "yellowstone"
+ set MOVE = '/bin/mv -v'
+ set COPY = '/bin/cp -v --preserve=timestamps'
+ set LINK = '/bin/ln -vs'
+ set REMOVE = '/bin/rm -rf'
+ breaksw
+ case be*:
+ # NCAR "bluefire"
+ set MOVE = '/usr/local/bin/mv -v'
+ set COPY = '/usr/local/bin/cp -v --preserve=timestamps'
+ set LINK = '/usr/local/bin/ln -vs'
+ set REMOVE = '/usr/local/bin/rm -rf'
+ breaksw
+ case r*:
+ set MOVE = '/usr/local/bin/mv -v'
+ set COPY = '/usr/local/bin/cp -v --preserve=timestamps'
+ set LINK = '/usr/local/bin/ln -vs'
+ set REMOVE = '/usr/local/bin/rm -rf'
+ default:
+ # NERSC "hopper"
+ set MOVE = 'mv -v'
+ set COPY = 'cp -v --preserve=timestamps'
+ set LINK = 'ln -vs'
+ set REMOVE = 'rm -rf'
+ breaksw
+endsw
+
+echo ""
+
+# ==============================================================================
+# make sure the required directories exist
+# VAR is the shell variable name, DIR is the value
+# ==============================================================================
+
+foreach VAR ( CASEROOT DARTROOT )
+ set DIR = `eval echo \${$VAR}`
+ if ( ! -d $DIR ) then
+ echo "ERROR: directory '$DIR' not found"
+ echo " In the setup script check the setting of: $VAR"
+ exit -1
+ endif
+end
+
+# ==============================================================================
+# Make sure the DART executables exist or build them if we can't find them.
+# The DART input.nml in the model directory IS IMPORTANT during this part
+# because it defines what observation types are supported.
+# ==============================================================================
+
+foreach MODEL ( cice )
+ set targetdir = $DARTROOT/models/$MODEL/work
+ if ( ! -x $targetdir/filter ) then
+ echo ""
+ echo "WARNING: executable file 'filter' not found."
+ echo " Looking for: $targetdir/filter "
+ echo " Trying to rebuild all executables for $MODEL now ..."
+ (cd $targetdir; ./quickbuild.csh -mpi)
+ if ( ! -x $targetdir/filter ) then
+ echo "ERROR: executable file 'filter' not found."
+ echo " Unsuccessfully tried to rebuild: $targetdir/filter "
+ echo " Required DART assimilation executables are not found."
+ echo " Stopping prematurely."
+ exit -1
+ endif
+ endif
+end
+
+# ==============================================================================
+# Stage the required parts of DART in the CASEROOT directory.
+# ==============================================================================
+
+# The new case.st_archive job script calls st_archive. It runs after the case.run job.
+# It submits the next case.run job, if RESUBMIT > 0.
+# Fix some pieces.
+# /X/ means search for lines with X in them.
+# 'c' means replace the line with the following.
+# This might want to have a conditional around it, to only execute if it's a bsub machine.
+#sed -e "/BSUB[ ]*-o/c\#BSUB -o cesm_st_arch.stdout.%J" \
+# -e "/BSUB[ ]*-e/c\#BSUB -e cesm_st_arch.stderr.%J" \
+# -e "/BSUB[ ]*-J/c\#BSUB -J ${CASE}.st_arch" case.st_archive >! temp.$$ || exit 20
+#${MOVE} temp.$$ case.st_archive
+#chmod 755 case.st_archive
+
+# Same for lt_archive
+# CESM1_5; queue and wall_clock can/should be modified via xmlchange in CESM1_5_setup_advanced
+# (see env_batch.xml)
+#sed -e "/BSUB[ ]*-o/c\#BSUB -o cesm_lt_arch.stdout.%J \n" \
+# -e "/BSUB[ ]*-e/c\#BSUB -e cesm_lt_arch.stderr.%J \n" \
+# -e "/BSUB[ ]*-J/c\#BSUB -J ${CASE}.lt_arch \n" case.lt_archive >! temp.$$ || exit 21
+#${MOVE} temp.$$ case.lt_archive
+#chmod 755 case.lt_archive
+
+# SetupFileName comes from CESM#_#_setup*, the calling script.
+sed -e "s#BOGUSCASEROOT#$CASEROOT#" \
+ -e "s#BOGUSBASEOBSDIR#$OBSROOT#" \
+ ${DARTROOT}/models/cice/shell_scripts/assimilate2_0.csh >! assimilate.csh || exit 23
+
+chmod 755 assimilate.csh
+
+# TODO FIXME
+# chmod 755 perfect_model.csh
+
+# ==============================================================================
+# Stage the DART executables in the CESM execution root directory: EXEROOT
+# If you recompile the DART code (maybe to support more observation types)
+# we're making a script to make it easy to install new DART executables.
+# ==============================================================================
+
+cat << EndOfText >! stage_dart_files
+#!/bin/sh
+
+# Run this script in the ${CASEROOT} directory.
+# This script copies over the dart executables and POSSIBLY a namelist
+# to the proper directory. If you have to update any dart executables,
+# do it in the ${DARTROOT} directory and then rerun stage_dart_files.
+# If an input.nml does not exist in the ${CASEROOT} directory,
+# a default one will be copied into place.
+#
+# This script was autogenerated by $0 using the variables set in that script.
+
+if [[ -e input.nml ]]; then
+ echo "stage_dart_files: Using existing ${CASEROOT}/input.nml"
+ if [[ -e input.nml.original ]]; then
+ echo "input.nml.original already exists - not making another"
+ else
+ ${COPY} input.nml input.nml.original
+ fi
+
+elif [[ -e ${DARTROOT}/models/cice/work/input.nml ]]; then
+ ${COPY} ${DARTROOT}/models/cice/work/input.nml input.nml
+ if [[ -x update_dart_namelists ]]; then
+ ./update_dart_namelists
+ fi
+else
+ echo "ERROR: stage_dart_files could not find an input.nml. Aborting"
+ exit -99
+fi
+
+
+
+${COPY} ${DARTROOT}/models/cice/work/cice_to_dart ${EXEROOT}
+${COPY} ${DARTROOT}/models/cice/work/dart_to_cice ${EXEROOT}
+${COPY} ${DARTROOT}/models/cice/work/filter ${EXEROOT}
+${COPY} ${DARTROOT}/models/cice/work/perfect_model_obs ${EXEROOT}
+
+exit 0
+
+EndOfText
+chmod 0755 stage_dart_files
+
+./stage_dart_files || exit -8
+
+# ==============================================================================
+# Ensure the DART namelists are consistent with the ensemble size,
+# suggest settings for num members in the output diagnostics files, etc.
+# The user is free to update these after setup and before running.
+# ==============================================================================
+
+cat << EndOfText >! update_dart_namelists
+#!/bin/sh
+
+# this script makes certain namelist settings consistent with the number
+# of ensemble members built by the setup script.
+# this script was autogenerated by $0
+# using the variables set in that script
+
+# Ensure that the input.nml ensemble size matches the number of instances.
+# WARNING: the output files contain ALL ensemble members ==> BIG
+
+ex input.nml <
+#
+#
+#
+#
+#
+#
+# Proposed .... TBD
+
+
+#=========================================================================
+# Stage the files needed for SAMPLING ERROR CORRECTION - even if not
+# initially requested. The file is static, small, and may be needed later.
+#
+# If it is requested and is not present ... it is an error.
+#
+# The sampling error correction is a lookup table. Each ensemble size
+# has its own (static) file. It is only needed if any
+# input.nml:&assim_tools_nml:sampling_error_correction = .true.,
+#=========================================================================
+
+if ( $num_instances > 1 ) then
+ set SAMP_ERR_FILE = ${DARTROOT}/system_simulation/final_full_precomputed_tables/final_full.${num_instances}
+ if ( -e ${SAMP_ERR_FILE} ) then
+ ${COPY} ${SAMP_ERR_FILE} .
+ else
+ echo ""
+ echo "WARNING: no final_full.xx file found for an ensemble size of ${num_instances}."
+ echo " This file is NOT needed unless you want to turn on the"
+ echo " sampling_error_correction feature in any of the models."
+ echo " To use it, in addition to setting the namelist to .true., cd to:"
+ echo " ${DARTROOT}/system_simulation"
+ echo " and create a final_full.${num_instances} file"
+ echo " one can be generated for any ensemble size; see docs."
+ echo " Copy it into ${CASEROOT} before running."
+ echo ""
+ endif
+
+ foreach N ( input.nml )
+ set MYSTRING = `grep sampling_error_correction $N`
+ set MYSTRING = `echo $MYSTRING | sed -e "s#[=,'\.]# #g"`
+ set MYSTRING = `echo $MYSTRING | sed -e 's#"# #g'`
+ set SECSTRING = `echo $MYSTRING[2] | tr '[:upper:]' '[:lower:]'`
+
+ if ( ${SECSTRING} == true ) then
+ if ( ! -e ${SAMP_ERR_FILE} ) then
+ echo "ERROR: no sampling error correction file for this ensemble size."
+ echo "ERROR: looking for ${SAMP_ERR_FILE} in"
+ echo "ERROR: ${DARTROOT}/system_simulation/final_full_precomputed_tables"
+ echo "ERROR: one can be generated for any ensemble size; see docs."
+ exit -3
+ endif
+ endif
+ end
+else
+ # sampling error correction not used for perfect_model_obs
+endif
+
+# ==============================================================================
+# INFLATION : Initial setup for the default inflation scenario.
+# ==============================================================================
+# The initial settings for adaptive state-space prior inflation
+# are in the filter_nml and ... during an assimilation experiment, the output
+# from one assimilation is the input for the next. To facilitate this operationally,
+# it is useful to specify an initial file of inflation values for the first
+# assimilation step. However, I can think of no general way to do this. The
+# utility that creates the initial inflation values (fill_inflation_restart)
+# needs the model size from model_mod. To get that, CAM needs a 'caminput.nc'
+# file which we generally don't have at this stage of the game (it exists after
+# a model advance). So ... until I think of something better ... I am making a
+# cookie file that indicates this is the very first assimilation. If this
+# cookie file exists, the assimilate.csh script will make the inflation restart
+# file before it performs the assimilation. After the first assimilation takes
+# place, the cookie file must be 'eaten' so that subsequent assimilations do not
+# overwrite whatever _should_ be there.
+#
+# IMPORTANT: If you stage your own inflation file, you must REMOVE the cookie
+# file from the RUNDIR directory.
+
+if ( $num_instances > 1 ) then
+ date >! ${RUNDIR}/cice_inflation_cookie
+endif
+
+# ==============================================================================
+# What to do next
+# ==============================================================================
+
+
+cat << EndOfText >! DART_instructions.txt
+
+-------------------------------------------------------------------------
+
+Check the DART configuration:
+
+1) The default behavior is to invoke DART (set in CESM1_5_setup_...) .
+ If your confidence is not high that the CESM1_5 configuration will be correct,
+ we recommend turning off the assimilation at first.
+
+2) If you want to turn off DART, edit the env_run.xml: DATA_ASSIMILATION_*
+ to disable running a DART script (assimilate.csh or perfect_model.csh)
+ after the model forecast.
+
+3) Modify what you need to in the DART namelist file, i.e.
+ ${CASEROOT}/input.nml
+
+4) If you have recompiled any part of the DART system, 'stage_dart_files'
+ will copy them into the correct places.
+
+5) If you stage your own inflation files, make sure you read the INFLATION section in
+ ${CASEROOT}/CESM_DART_config
+
+6) Make sure the observation directory name in assimilate.csh or perfect_model.csh
+ matches the one on your system.
+
+7) Submit the CESM job in the normal way.
+
+8) You can use ${CASEROOT}/stage_cesm_files
+ to stage files to restart a run.
+
+-------------------------------------------------------------------------
+
+EndOfText
+
+cat DART_instructions.txt
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cice/shell_scripts/CESM2_0_setup_ensemble b/models/cice/shell_scripts/CESM2_0_setup_ensemble
new file mode 100755
index 0000000000..4d17076b67
--- /dev/null
+++ b/models/cice/shell_scripts/CESM2_0_setup_ensemble
@@ -0,0 +1,460 @@
+#!/bin/csh
+#
+# DART software - Copyright UCAR. This open source software is provided
+# provided by UCAR, "as is", without charge, subject to all terms of use at
+# http://www.image.ucar.edu/DAReS/DART/DART_download
+#
+# DART $Id$
+
+# ------------------------------------------------------------------------------
+# Script to help configure, build, and stage a CESM multi-instance experiment.
+# The experiment initially does not perform any data assimilation. After
+# initial trials are confirmed to be working correctly, the experiment can
+# be restarted with data assimilation enabled. This two-step approach has
+# been shown to have better results than trying to do everything at once.
+# ------------------------------------------------------------------------------
+
+# ==============================================================================
+# Options defining the experiment:
+#
+# CASE The value of "CASE" will be used many ways; directory and file
+# names both locally and (possibly) on the HPSS, and script names;
+# so consider its length and information content.
+# compset Defines the vertical resolution and physics packages to be used.
+# Must be a standard CESM compset; see the CESM documentation.
+# resolution Defines the horizontal resolution and dynamics; see CESM docs.
+# cesmtag The version of the CESM source code to use when building the code.
+# num_instances The number of ensemble members.
+# ==============================================================================
+# 2000_DATM%NYF_SLND_CICE_DOCN%SOM_DROF%NYF_SGLC_SWAV_TEST
+
+setenv CASE test1
+setenv resolution T62_g16
+setenv compset DTEST
+setenv cesmtag cesm2_0_alpha06n
+setenv num_instances 10
+
+# ==============================================================================
+# Directories:
+# cesmdata Location of some supporting CESM data files.
+# cesmroot Location of the CESM code base. This version of the script
+# only supports version cesm1_5_beta06c.
+# caseroot Defines the CESM case directory - where the CESM+DART
+# configuration files will be stored. This should probably not
+# be in scratch (on yellowstone, your 'work' partition is suggested).
+# This script will delete any existing caseroot, so this script,
+# and other useful things should be kept elsewhere.
+# rundir Defines the location of the CESM run directory. Will need large
+# amounts of disk space, generally on a scratch partition.
+# exeroot Defines the location of the CESM executable directory , where the
+# CESM executables will be built. Medium amount of space
+# needed, generally on a scratch partition.
+# archdir Defines the location of the CESM short-term archive directories.
+# Requires large amounts of disk space, may be on a scratch partition if
+# the long-term archiver is invoked to move these files to permanent storage.
+# Files will remain here until the long-term archiver moves it to permanent storage.
+# dartroot Location of the root of _your_ DART installation
+# baseobsdir Part of the directory name containing the obs_seq.out files to be used in the
+# assimilation. The year, month, and filename will be provided in assimilate.csh.
+# Will be inherited by CESM#_#_DART_config and inserted into assimilate.csh
+# ==============================================================================
+
+setenv project UCUB0067
+setenv machine cheyenne
+setenv cesmdata /glade/p/cesm/cseg/inputdata
+setenv cesmroot /glade/work/yfzhang/$cesmtag
+ # cesmroot points to the directory of the CESM code. Change to your own model code if you have one.
+setenv caseroot /glade/work/${USER}/cesmcases/$cesmtag/${CASE}
+ # put the case in somewhere
+setenv rundir /glade/scratch/${USER}/$cesmtag/${CASE}/run
+setenv exeroot /glade/scratch/${USER}/$cesmtag/${CASE}/bld
+setenv archdir /glade/scratch/${USER}/$cesmtag/${CASE}/archive
+
+setenv dartroot /glade/u/home/${USER}/dart_manhattan
+setenv baseobsdir /glade/u/home/${USER}/PWS2018/day4/obs_seqs
+
+# ==============================================================================
+# runtime control namelists
+# ==============================================================================
+
+setenv runtype branch #set refcase and refdate if runtype is branch
+ #will be ignored if runtype is startup
+setenv refcase free_ens10
+setenv refdate 2005-04-01
+
+setenv startdate 2005-04-01
+
+setenv stop_option ndays
+setenv stop_n 5
+setenv rest_option nday
+setenv rest_n 1
+
+setenv resubmit 12
+setenv job_time 00:10 #10 minutes
+
+setenv stream_year_align 2005
+setenv stream_year_first 2005
+setenv stream_year_last 2010
+
+# ==============================================================================
+# standard commands:
+#
+# If you are running on a machine where the standard commands are not in the
+# expected location, add a case for them below.
+# ==============================================================================
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+# The FORCE options are not optional.
+# The VERBOSE options are useful for debugging though
+# some systems don't like the -v option to any of the following
+switch ("`hostname`")
+ case ys*:
+ # NCAR "yellowstone"
+ set MOVE = '/bin/mv -v'
+ set COPY = '/bin/cp -v --preserve=timestamps'
+ set LINK = '/bin/ln -vs'
+ set REMOVE = '/bin/rm -rf'
+ breaksw
+ case be*:
+ # NCAR "bluefire"
+ set MOVE = '/usr/local/bin/mv -v'
+ set COPY = '/usr/local/bin/cp -v --preserve=timestamps'
+ set LINK = '/usr/local/bin/ln -vs'
+ set REMOVE = '/usr/local/bin/rm -rf'
+ breaksw
+ default:
+ # NERSC "hopper", TACC "stampede" ... many more
+ set MOVE = 'mv -v'
+ set COPY = 'cp -v --preserve=timestamps'
+ set LINK = 'ln -vs'
+ set REMOVE = 'rm -rf'
+ breaksw
+endsw
+
+# If an old case exists, exit the script. If the old case is no longer needed, delete it mannually.
+if ( -d $caseroot) then
+ echo "case existed"
+ echo "to delete the old case, please type"
+ echo "rm -rf $caseroot";exit
+endif
+
+# FATAL idea to make caseroot the same dir as where this setup script is
+# since the build process removes all files in the caseroot dir before
+# populating it. try to prevent shooting yourself in the foot.
+
+
+if ( ${caseroot} == `pwd` ) then
+ echo "ERROR: the setup script should not be located in the caseroot"
+ echo "directory, because all files in the caseroot dir will be removed"
+ echo "before creating the new case. move the script to a safer place."
+ exit 11
+endif
+
+echo "removing old files from ${caseroot}"
+echo "removing old files from ${exeroot}"
+echo "removing old files from ${rundir}"
+${REMOVE} ${caseroot}
+${REMOVE} ${exeroot}
+${REMOVE} ${rundir}
+${cesmroot}/cime/scripts/create_newcase --res ${resolution} \
+ -mach ${machine} \
+ -compset ${compset} \
+ -case ${caseroot} \
+ -project ${project} \
+ --output-root /glade/scratch/$USER/$cesmtag \
+ --run-unsupported || exit 1
+
+# ==============================================================================
+# Preserve a copy of this script as it was run.
+# Copy the DART setup script (CESM_DART_config) to CASEROOT.
+# Since we know the DARTROOT and BASEOBSDIR now, record them into
+# CASEROOT/CESM_DART_config now.
+# ==============================================================================
+
+set ThisFileName = $0:t
+${COPY} $ThisFileName ${caseroot}/${ThisFileName}.original
+
+if ( -e ${dartroot}/models/cice/shell_scripts/CESM2_0_DART_config ) then
+ sed -e "s#BOGUS_DART_ROOT_STRING#${dartroot}#" \
+ -e "s#BOGUS_DART_OBS_STRING#${baseobsdir}#" \
+ ${dartroot}/models/cice/shell_scripts/CESM2_0_DART_config \
+ >! ${caseroot}/CESM_DART_config || exit 20
+ chmod 755 ${caseroot}/CESM_DART_config
+else
+ echo "ERROR: the script to configure for data assimilation is not available."
+ echo " ${dartroot}/models/cice/shell_scripts/CESM2_0_DART_config MUST exist."
+ exit 21
+endif
+
+# ==============================================================================
+cd ${caseroot}
+# ==============================================================================
+
+# Save a copy for debug purposes
+foreach FILE ( *xml )
+ if ( ! -e ${FILE}.original ) then
+ ${COPY} $FILE ${FILE}.original
+ endif
+end
+
+# Grab machine-specific resources values
+
+setenv MAX_TASKS_PER_NODE `./xmlquery MAX_TASKS_PER_NODE -value`
+@ ptile = $MAX_TASKS_PER_NODE
+@ nthreads = 1
+
+#> @TODO stream template files & multiple years. Do we need to specify
+#> year 1 and year N (performance penalty?). Can we change years on-the-fly
+#> during a run
+
+
+# TJH ... DIN_LOC_ROOT ... redundant or can we remove it from the stream templates
+# Fei uses DIN_LOC_ROOT on the TACC machines for datasets that are automatically downloaded by CESM
+# TJH ... resubmit 0
+
+# Turn off short-term archiving for now
+./xmlchange DOUT_S=FALSE
+
+# Turn on archiving interm restart files
+./xmlchange DOUT_S_SAVE_INTERIM_RESTART_FILES=TRUE
+
+ ./xmlchange EXEROOT=$exeroot
+./xmlchange STOP_OPTION=$stop_option
+./xmlchange STOP_N=$stop_n
+./xmlchange RESUBMIT=$resubmit
+
+./xmlchange REST_OPTION=$rest_option
+./xmlchange REST_N=$rest_n
+./xmlchange JOB_QUEUE=regular
+./xmlchange JOB_WALLCLOCK_TIME=$job_time
+
+./xmlchange DATM_MODE=CPLHISTForcing
+./xmlchange DATM_CPLHIST_YR_START=$stream_year_first
+./xmlchange DATM_CPLHIST_YR_END=$stream_year_last
+./xmlchange DATM_CPLHIST_YR_ALIGN=$stream_year_align
+
+# A branch run continues a previous run but with a new case name and/or a new startdate
+# The new case will start exactly as "continue run"
+# RUN_REFCASE and RUN_REFDATE will not be used if RUN_TYPE is not branch or hybrid
+./xmlchange RUN_TYPE=$runtype
+./xmlchange RUN_REFCASE=${refcase}
+./xmlchange RUN_REFDATE=${refdate}
+./xmlchange RUN_STARTDATE=${startdate}
+
+./xmlchange PIO_TYPENAME=netcdf
+
+@ nodes_per_instance = 1
+
+@ atm_tasks = $ptile * $nodes_per_instance * $num_instances
+@ lnd_tasks = $ptile * $nodes_per_instance
+@ ice_tasks = $ptile * $nodes_per_instance * $num_instances
+@ ocn_tasks = $ptile * $nodes_per_instance * $num_instances
+@ cpl_tasks = $ptile * $nodes_per_instance
+@ wav_tasks = $ptile * $nodes_per_instance
+@ esp_tasks = $ptile * $nodes_per_instance
+
+# # TJH determine glacier
+# set glacier = CISM2P
+# # CESM1_5_beta03: CISM1 (the default) can only handle 1 task per member.
+# if ($glacier == 'CISM1' || $glacier == 'CISM2S') then
+# @ glc_tasks = $num_instances
+# else if ($glacier == 'CISM2P') then
+# @ glc_tasks = $ptile * $nodes_per_instance * $num_instances
+# else
+# # @ glc_tasks = 1 Exercised in ATM_spinup5, which failed to run in some MCT mapping routine.
+# @ glc_tasks = $ptile * $nodes_per_instance
+# endif
+#
+# # TJH determine river_runoff
+# set river_runoff = bob
+# if ($river_runoff == 'RTM' || $river_runoff == 'MOSART') then
+# @ rof_tasks = $ptile * $nodes_per_instance * $num_instances
+# else
+# @ rof_tasks = $ptile * $nodes_per_instance
+# endif
+
+@ glc_tasks = $ptile * $nodes_per_instance
+@ rof_tasks = $ptile * $nodes_per_instance
+
+./xmlchange ROOTPE_CPL=0,NTHRDS_CPL=$nthreads,NTASKS_CPL=$cpl_tasks
+./xmlchange ROOTPE_ICE=0,NTHRDS_ICE=$nthreads,NTASKS_ICE=$ice_tasks,NINST_ICE=$num_instances
+./xmlchange ROOTPE_ATM=0,NTHRDS_ATM=$nthreads,NTASKS_ATM=$atm_tasks,NINST_ATM=$num_instances
+./xmlchange ROOTPE_OCN=0,NTHRDS_OCN=$nthreads,NTASKS_OCN=$ocn_tasks,NINST_OCN=$num_instances
+./xmlchange ROOTPE_LND=0,NTHRDS_LND=$nthreads,NTASKS_LND=$lnd_tasks,NINST_LND=1
+./xmlchange ROOTPE_GLC=0,NTHRDS_GLC=$nthreads,NTASKS_GLC=$glc_tasks,NINST_GLC=1
+./xmlchange ROOTPE_ROF=0,NTHRDS_ROF=$nthreads,NTASKS_ROF=$rof_tasks,NINST_ROF=1
+./xmlchange ROOTPE_WAV=0,NTHRDS_WAV=$nthreads,NTASKS_WAV=$wav_tasks,NINST_WAV=1
+./xmlchange ROOTPE_ESP=0,NTHRDS_ESP=$nthreads,NTASKS_ESP=$esp_tasks,NINST_ESP=1
+
+
+./case.setup || exit 9
+echo "case setup finished"
+
+# Customize the user namelists and text stream files for each instance (aka ensemble member)
+# The default multi-instance behaviour is to run N identical instances, which is not
+# what we want to do.
+
+#===========================================================
+# perturbed parameters for CICE
+# you can perturb the parameters you're interested in
+#===========================================================
+
+set r_snw = ( -0.8346421 -0.8321888 -0.2238045 -0.9605725 -0.7291763 \
+ -1.445741 0.03836016 0.9545915 -0.8282194 -0.7757131 \
+ 1.222636 -0.788242 -0.9739172 -0.1878285 0.7847106 \
+ -1.923835 -1.866753 -0.9538506 -1.690121 0.6913126 \
+ -0.7059948 -1.250739 -1.712841 -1.467445 0.5493592 \
+ -0.5763934 0.7519119 0.3253862 -0.2969795 1.094377 )
+
+set Cf = ( 45.2172 4.77717 22.83 13.4244 26.1557 12.5715 \
+ 5.45581 11.9083 31.6812 45.0404 8.36396 46.4757 \
+ 45.6548 29.6026 25.856 38.746 20.8352 41.8975 \
+ 35.9006 9.72523 42.139 7.36385 1.38402 2.0052 \
+ 49.101 29.1324 1.09503 31.06 20.8142 6.37866 )
+
+@ inst = 1
+while ( $inst <= $num_instances )
+
+ set inst_string = `printf %04d $inst`
+
+ # ===========================================================================
+ set fname = "user_nl_datm"_${inst_string}
+ # ===========================================================================
+ # DATM namelist
+
+ echo "streams = 'datm.streams.txt.CPLHISTForcing.Solar_$inst_string $stream_year_align $stream_year_first $stream_year_last'," >> ${fname}
+ echo " 'datm.streams.txt.CPLHISTForcing.nonSolarFlux_$inst_string $stream_year_align $stream_year_first $stream_year_last'," >> ${fname}
+ echo " 'datm.streams.txt.CPLHISTForcing.State1hr_$inst_string $stream_year_align $stream_year_first $stream_year_last'," >> ${fname}
+ echo " 'datm.streams.txt.CPLHISTForcing.State3hr_$inst_string $stream_year_align $stream_year_first $stream_year_last'," >> ${fname}
+ echo " 'datm.streams.txt.presaero.clim_2000_$inst_string 1 1 1'" >> ${fname}
+ echo "vectors = 'u:v' " >> ${fname}
+ echo "mapmask = 'nomask', " >> ${fname}
+ echo " 'nomask', " >> ${fname}
+ echo " 'nomask', " >> ${fname}
+ echo " 'nomask' " >> ${fname}
+ echo "tintalgo = 'coszen', " >> ${fname}
+ echo " 'nearest'," >> ${fname}
+ echo " 'linear', " >> ${fname}
+ echo " 'linear' " >> ${fname}
+ echo " 'linear' " >> ${fname}
+
+ # Create stream files for each ensemble member
+ cp ${dartroot}/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_2005to2010 \
+ user_datm.streams.txt.CPLHISTForcing.Solar_${inst_string}
+ cp ${dartroot}/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_2005to2010 \
+ user_datm.streams.txt.CPLHISTForcing.nonSolarFlux_${inst_string}
+ cp ${dartroot}/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_2005to2010 \
+ user_datm.streams.txt.CPLHISTForcing.State1hr_${inst_string}
+ cp ${dartroot}/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_2005to2010 \
+ user_datm.streams.txt.CPLHISTForcing.State3hr_${inst_string}
+
+ foreach FNAME ( user_datm.streams.txt*_${inst_string} )
+ echo "modifying $FNAME"
+ sed s/NINST/${inst_string}/g $FNAME >! temp
+ sed s/RUNYEAR/${stream_year_first}/g temp >! $FNAME
+ end
+ ${REMOVE} temp
+
+ # ===========================================================================
+ set fname = "user_nl_cice_${inst_string}"
+ # ===========================================================================
+ # CICE namelist
+
+ # Do not need to specify ice_ic if the runtype is branch
+ # put it back if your runtype is startup
+ # echo "ice_ic = '/glade/scratch/yfzhang/inputdata_cam/ice/cice/${refdate}/${refcase}.cice_${inst_string}.r.${refdate}-00000.nc' " >> $fname
+ echo "histfreq_n = 1,1,1,1,1 " >> $fname
+ echo "histfreq = 'd','m','x','x','x' " >> $fname
+ echo "f_sst = 'dmxxx' " >> $fname
+ echo "f_sss = 'dmxxx' " >> $fname
+ echo "f_frzmlt = 'dmxxx' " >> $fname
+ echo "f_frz_onset = 'dmxxx' " >> $fname
+ echo "f_aicen = 'dmxxx' " >> $fname
+ echo "f_vicen = 'dmxxx' " >> $fname
+ echo "f_vsnon = 'dmxxx' " >> $fname
+ echo "f_hi = 'dmxxx' " >> $fname
+ echo "f_hs = 'dmxxx' " >> $fname
+ echo "f_aice = 'dmxxx' " >> $fname
+ echo "f_snowfrac = 'dmxxx' " >> $fname
+ echo "f_albsni = 'dmxxx' " >> $fname
+ echo "f_albsno = 'dmxxx' " >> $fname
+ echo "f_albice = 'dmxxx' " >> $fname
+ echo "f_albpnd = 'dmxxx' " >> $fname
+ echo "Cf = ${Cf[$inst]} " >> $fname
+ echo "r_snw = ${r_snw[$inst]} " >> $fname
+ echo "highfreq = .false. " >> $fname
+
+ @ inst = $inst + 1
+end
+
+./preview_namelists
+
+# ==============================================================================
+# Copy the restart files and pointers to the run directory if runtype is branch
+# ==============================================================================
+
+if ( $runtype == "branch" ) then
+ cp /glade/scratch/yfzhang/inputdata_cam/ice/cice/$startdate/$refcase/* $rundir/
+endif
+
+# now build the case
+./case.build || exit 10
+
+# ==============================================================================
+# What to do next
+# ==============================================================================
+# 1. Go to the case directory and run the CESM_DART_config script
+# It will do the following things
+# 1.1 Copy the DART executables (filter and dart_to_cice) to the exeroot
+# 1.2 Copy the assimilation script (assimilate.csh) and DART namelist file (input.nml)
+# to the case directory and integrate enviornment variables
+# 1.3 Modify DA-related namelist variables in env_run.xml
+# 2. Submit the job as usual: ./case.submit
+# 3. Checkout the results!
+
+cat << EndOfText >! CESM_instructions.txt
+
+-------------------------------------------------------------------------
+Time to check the case.
+
+1) cd ${rundir}
+ and check the compatibility between the namelists/pointer files
+ and the files that were staged.
+
+2) cd ${caseroot}
+
+3) check things
+
+4) run a single day, verify that it works without assimilation
+ ./case.submit
+
+5) IF NEEDED, compile all the DART executables by
+ cd ${dartroot}/models/cice/work
+ ./quickbuild.csh -mpi
+
+5) configure the case to be able to DART by executing
+ cd ${caseroot}
+ ./CESM_DART_config
+
+6) Make sure the DART-related parts are appropriate.
+ Check the input.nml
+ Check the assimilate.csh
+ ./case.submit
+
+7) If that works
+ ./xmlchange CONTINUE_RUN=TRUE
+ that sort of thing
+-------------------------------------------------------------------------
+
+EndOfText
+
+cat CESM_instructions.txt
+
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/models/cice/shell_scripts/README b/models/cice/shell_scripts/README
new file mode 100644
index 0000000000..70c2073c51
--- /dev/null
+++ b/models/cice/shell_scripts/README
@@ -0,0 +1,31 @@
+#To whom use CESM2_0_alpha06n and higher versions
+
+Datmmode has changed to CPLHISTForcing. This mode has slightly different stream files.
+
+1. datm.streams.txt.CPLHISTForcing.Solar is the same as before
+ a2x6h_Faxa_swndr swndr
+ a2x6h_Faxa_swvdr swvdr
+ a2x6h_Faxa_swndf swndf
+ a2x6h_Faxa_swvdf swvdf
+2. datm.streams.txt.CPLHISTForcing.nonSolarFlux is longwave plus precipitation
+ a2x6h_Faxa_rainc rainc
+ a2x6h_Faxa_rainl rainl
+ a2x6h_Faxa_snowc snowc
+ a2x6h_Faxa_snowl snowl
+ a2x6h_Faxa_lwdn lwdn
+
+3.datm.streams.txt.CPLHISTForcing.State1hr is horizontal wind speeds
+ a2x6h_Sa_u u
+ a2x6h_Sa_v v
+
+4. datm.streams.txt.CPLHISTForcing.State3hr is the remaining forcing fields
+ a2x6h_Sa_z z
+ a2x6h_Sa_tbot tbot
+ a2x6h_Sa_ptem ptem
+ a2x6h_Sa_shum shum
+ a2x6h_Sa_pbot pbot
+ a2x6h_Faxa_lwdn lwdn
+ a2x6h_Sa_dens dens
+ a2x6h_Sa_pslv pslv
+
+
diff --git a/models/cice/shell_scripts/assimilate2_0.csh b/models/cice/shell_scripts/assimilate2_0.csh
new file mode 100755
index 0000000000..06b8f0590e
--- /dev/null
+++ b/models/cice/shell_scripts/assimilate2_0.csh
@@ -0,0 +1,732 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+# This block is an attempt to localize all the machine-specific
+# changes to this script such that the same script can be used
+# on multiple platforms. This will help us maintain the script.
+
+echo "`date` -- BEGIN ICE_ASSIMILATE"
+
+set nonomatch # suppress "rm" warnings if wildcard does not match anything
+
+set PARAMETER_ESTIMATION = "FALSE"
+set use_mean = "FALSE"
+set cice_parameters = ( r_snw Cf )
+# these aliases look like a module bug workaround. if you get
+# errors running the nco commands you can try to uncomment these,
+# but they should NOT be necessary. feel free to remove these
+# lines if you test this script and it just works.
+#set ncodir = "/glade/u/apps/ch/opt/nco/4.6.2/gnu/6.3.0/bin/"
+#alias ncks $ncodir/ncks
+#alias ncwa $ncodir/ncwa
+#alias ncrename $ncodir/ncrename
+#alias ncap2 $ncodir/ncap2
+module load nco
+
+# The FORCE options are not optional.
+# The VERBOSE options are useful for debugging though
+# some systems don't like the -v option to any of the following
+switch ("`hostname`")
+ case ys*:
+ # NCAR "yellowstone"
+ set MOVE = '/bin/mv -v'
+ set COPY = '/bin/cp -v --preserve=timestamps'
+ set LINK = '/bin/ln -vs'
+ set REMOVE = '/bin/rm -rf'
+ set LAUNCHCMD = mpirun.lsf
+ set TASKS_PER_NODE = `echo $LSB_SUB_RES_REQ | sed -ne '/ptile/s#.*\[ptile=\([0-9][0-9]*\)]#\1#p'`
+ setenv MP_DEBUG_NOTIMEOUT yes
+ breaksw
+ case r*:
+ # cheyenne has nodes like r1i0n14
+ set MOVE = '/usr/bin/mv -v'
+ set COPY = '/usr/bin/cp -v --preserve=timestamps'
+ set LINK = '/usr/bin/ln -vs'
+ set REMOVE = '/usr/bin/rm -rf'
+ set LAUNCHCMD = 'mpiexec_mpt omplace'
+ breaksw
+
+ case linux_system_with_utils_in_other_dirs*:
+ # example of pointing this script at a different set of basic commands
+ set MOVE = '/usr/local/bin/mv -v'
+ set COPY = '/usr/local/bin/cp -v --preserve=timestamps'
+ set LINK = '/usr/local/bin/ln -vs'
+ set REMOVE = '/usr/local/bin/rm -fr'
+ set LAUNCHCMD = mpirun.lsf
+ breaksw
+ default:
+ # NERSC "hopper"
+ set MOVE = 'mv -v'
+ set COPY = 'cp -v --preserve=timestamps'
+ set LINK = 'ln -vs'
+ set REMOVE = 'rm -fr'
+ set LAUNCHCMD = "aprun -n 1" #$NTASKS"
+ breaksw
+endsw
+
+# The bogus strings get replaced when CESM_DART_config is run
+setenv CASEROOT BOGUSCASEROOT
+setenv BASEOBSROOT BOGUSBASEOBSDIR
+#-------------------------------------------------------------------------
+# Get the case-specific variables
+#-------------------------------------------------------------------------
+
+cd ${CASEROOT} || exit 1
+setenv CASE `./xmlquery --value CASE `
+setenv EXEROOT `./xmlquery --value EXEROOT `
+setenv RUNDIR `./xmlquery --value RUNDIR `
+setenv ensemble_size `./xmlquery --value NINST_ICE`
+setenv ICE_COMPONENT `./xmlquery --value COMP_ICE`
+setenv archive `./xmlquery --value DOUT_S_ROOT`
+setenv CONTINUE_RUN `./xmlquery --value CONTINUE_RUN`
+# Check to make sure we are running what we are supporting
+
+if ( $ICE_COMPONENT != 'cice' ) then
+ echo 'ERROR: This assimilate.csh file is specifically for "cice".'
+ echo 'ERROR: the ice component for this case is "'${ICE_COMPONENT}'".'
+ exit 1
+endif
+
+cd ${RUNDIR}
+
+#-------------------------------------------------------------------------
+# Determine time of model state ... from the last coupler restart file name
+# of the form "./${CASE}.cpl.r.YYYY-MM-DD-SSSSS.nc"
+#
+# Piping stuff through 'bc' strips off any preceeding zeros.
+#-------------------------------------------------------------------------
+
+set FILE = `ls -1 $CASE.cpl.r.*.nc | tail -n 1`
+set FILE = $FILE:r
+set CPL_DATE_EXT = `echo $FILE:e`
+set CPL_DATE = `echo $FILE:e | sed -e "s#-# #g"`
+set CPL_YEAR = `echo $CPL_DATE[1] | bc`
+set CPL_MONTH = `echo $CPL_DATE[2] | bc`
+set CPL_DAY = `echo $CPL_DATE[3] | bc`
+set CPL_SECONDS = `echo $CPL_DATE[4] | bc`
+set CPL_HOUR = `echo $CPL_DATE[4] / 3600 | bc`
+
+echo "valid time of model is $CPL_YEAR $CPL_MONTH $CPL_DAY $CPL_SECONDS (seconds)"
+echo "valid time of model is $CPL_YEAR $CPL_MONTH $CPL_DAY $CPL_HOUR (hours)"
+
+#-------------------------------------------------------------------------
+# Create temporary working directory for the assimilation and go there
+#-------------------------------------------------------------------------
+
+set temp_dir = assimilate_ice
+echo "temp_dir is $temp_dir"
+
+if ( -d $temp_dir ) then
+ ${REMOVE} $temp_dir/*
+else
+ mkdir -p $temp_dir
+endif
+cd $temp_dir
+
+#-----------------------------------------------------------------------------
+# Get observation sequence file ... or die right away.
+# The observation file names have a time that matches the stopping time of ICE.
+#-----------------------------------------------------------------------------
+# Make sure the file name structure matches the obs you will be using.
+# PERFECT model obs output appends .perfect to the filenames
+
+set YYYYMM = `printf %04d%02d ${CPL_YEAR} ${CPL_MONTH}`
+if (! -d ${BASEOBSROOT}/) then
+ echo "CESM+DART requires 6 hourly obs_seq files in directories of the form YYYYMM"
+ echo "The directory ${BASEOBSROOT}/${YYYYMM} is not found. Exiting"
+ exit 2
+endif
+
+set OBSFNAME = `printf obs_seq.%04d-%02d-%02d-%05d ${CPL_YEAR} ${CPL_MONTH} ${CPL_DAY} ${CPL_SECONDS}`
+
+set OBS_FILE = ${BASEOBSROOT}/${OBSFNAME}
+
+if ( -e ${OBS_FILE} ) then
+ ${LINK} ${OBS_FILE} obs_seq.out
+else
+ echo "ERROR ... no observation file ${OBS_FILE}"
+ echo "ERROR ... no observation file ${OBS_FILE}"
+ exit 2
+endif
+
+#=========================================================================
+# Block 1: Populate a run-time directory with the input needed to run DART.
+#=========================================================================
+
+echo "`date` -- BEGIN COPY BLOCK"
+
+if ( -e ${CASEROOT}/input.nml ) then
+ ${COPY} ${CASEROOT}/input.nml .
+else
+ echo "ERROR ... DART required file ${CASEROOT}/input.nml not found ... ERROR"
+ echo "ERROR ... DART required file ${CASEROOT}/input.nml not found ... ERROR"
+ exit 2
+endif
+
+echo "`date` -- END COPY BLOCK"
+
+# If possible, use the round-robin approach to deal out the tasks.
+# Since the ensemble manager is not used by dart_to_cice,
+# it is OK to set it here and have it used by all routines.
+
+if ($?TASKS_PER_NODE) then
+ if ($#TASKS_PER_NODE > 0) then
+ ${COPY} input.nml input.nml.$$
+ sed -e "s#layout.*#layout = 2#" \
+ -e "s#tasks_per_node.*#tasks_per_node = $TASKS_PER_NODE#" \
+ input.nml.$$ >! input.nml || exit 3
+ ${REMOVE} input.nml.$$
+ endif
+endif
+
+#=========================================================================
+# Block 2: Stage the files needed for SAMPLING ERROR CORRECTION
+#
+# The sampling error correction is a lookup table.
+# The tables were originally in the DART distribution, but should
+# have been staged to $CASEROOT at setup time.
+# Each ensemble size has its own (static) file.
+# It is only needed if
+# input.nml:&assim_tools_nml:sampling_error_correction = .true.,
+#=========================================================================
+
+set MYSTRING = `grep 'sampling_error_correction' input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,'\.]# #g"`
+set MYSTRING = `echo $MYSTRING | sed -e 's#"# #g'`
+set SECSTRING = `echo $MYSTRING[2] | tr '[:upper:]' '[:lower:]'`
+
+if ( $SECSTRING == true ) then
+ set SAMP_ERR_FILE = ${CASEROOT}/final_full.${ensemble_size}
+ if ( -e ${SAMP_ERR_FILE} ) then
+ ${COPY} ${SAMP_ERR_FILE} .
+ else
+ echo "ERROR: no sampling error correction file for this ensemble size."
+ echo "ERROR: looking for ${SAMP_ERR_FILE}"
+ exit 2
+ endif
+else
+ echo "Sampling Error Correction not requested for this assimilation."
+endif
+
+#=========================================================================
+# Block 3: DART_INFLATION
+# This stages the files that contain the inflation values.
+# The inflation values change through time and should be archived.
+#
+# This file is only relevant if 'inflation' is turned on -
+# i.e. if inf_flavor(:) /= 0 AND inf_initial_from_restart = .TRUE.
+#
+# filter_nml
+# inf_flavor = 2, 0,
+# inf_initial_from_restart = .true., .false.,
+# inf_in_file_name = 'prior_inflation_input', 'posterior_inflation_input',
+# inf_out_file_name = 'prior_inflation_output', 'posterior_inflation_output',
+# inf_diag_file_name = 'prior_obs_infl_out', 'posterior_obs_infl_out',
+#
+# NOTICE: the archiving scripts require the names of these
+# files to be as listed above. When being archived, the filenames get a
+# unique extension (describing the assimilation time) appended to them.
+#
+# The inflation file is essentially a duplicate of the DART model state ...
+# For the purpose of this script, they are the output of a previous assimilation,
+# so they should be named something like prior_inflate_output.YYYY-MM-DD-SSSSS
+#
+# NOTICE: inf_initial_from_restart and inf_sd_initial_from_restart are somewhat
+# problematic. During the bulk of an experiment, these should be TRUE, since
+# we want to read existing inflation files. However, the first assimilation
+# might need these to be FALSE and then subsequently be set to TRUE.
+# There is now only one way to handle this:
+#
+# 1) create a cookie file called RUNDIR/cice_inflation_cookie
+# The existence of this file will cause this script to set the
+# namelist appropriately. This script will 'eat' the cookie file
+# to prevent this from happening for subsequent executions. If the
+# inflation file does not exist for them, and it needs to, this script
+# should die. The CESM_DART_config script automatically creates a cookie
+# file to support this option.
+#
+# The strategy is to use the LATEST inflation file from the CESM 'rundir'.
+# After an assimilation, the new inflation values/files will be moved to
+# the CESM rundir to be used for subsequent assimilations. If the short-term
+# archiver has worked correctly, only the LATEST files will available. Of
+# course, it is not required to have short-term archiving turned on, so ...
+#=========================================================================
+
+set MYSTRING = `grep 'inf_flavor' input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,'\.]# #g"`
+set PRIOR_INF = $MYSTRING[2]
+set POSTE_INF = $MYSTRING[3]
+
+set MYSTRING = `grep 'inf_initial_from_restart' input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,'\.]# #g"`
+set PRIOR_TF = `echo $MYSTRING[2] | tr '[:upper:]' '[:lower:]'`
+set POSTE_TF = `echo $MYSTRING[3] | tr '[:upper:]' '[:lower:]'`
+
+# IFF we want PRIOR inflation:
+
+if ( $PRIOR_INF > 0 ) then
+
+ if ($PRIOR_TF == false) then
+ # we are not using an existing inflation file.
+ echo "inf_flavor(1) = $PRIOR_INF, using namelist values."
+
+ else if ( -e ../cice_inflation_cookie ) then
+ # We want to use an existing inflation file, but this is
+ # the first assimilation so there is no existing inflation
+ # file. This is the signal we need to to coerce the namelist
+ # to have different values for this execution ONLY.
+ # Since the local namelist comes from CASEROOT each time, we're golden.
+
+ set PRIOR_TF = FALSE
+
+ex input.nml <! latestfile) > & /dev/null
+ set nfiles = `cat latestfile | wc -l`
+
+ if ( $nfiles > 0 ) then
+ set latest = `cat latestfile`
+ ${LINK} $latest input_priorinf_mean.nc
+ else
+ echo "ERROR: Requested PRIOR inflation but specified no incoming inflation MEAN file."
+ echo "ERROR: expected something like ../cice.output_priorinf_mean.YYYY-MM-DD-SSSSS.nc"
+ exit 2
+ endif
+
+ # Checking for a prior inflation sd file to use
+
+ (ls -rt1 ../cice.output_priorinf_sd.* | tail -n 1 >! latestfile) > & /dev/null
+ set nfiles = `cat latestfile | wc -l`
+
+ if ( $nfiles > 0 ) then
+ set latest = `cat latestfile`
+ ${LINK} $latest input_priorinf_sd.nc
+ else
+ echo "ERROR: Requested PRIOR inflation but specified no incoming inflation SD file."
+ echo "ERROR: expected something like ../cice.input_priorinf_sd.YYYY-MM-DD-SSSSS.nc"
+ exit 2
+ endif
+
+ endif
+else
+ echo "Prior Inflation not requested for this assimilation."
+endif
+
+# POSTERIOR: We look for the 'newest' and use it - IFF we need it.
+
+if ( $POSTE_INF > 0 ) then
+
+ if ($POSTE_TF == false) then
+ # we are not using an existing inflation file.
+ echo "inf_flavor(2) = $POSTE_INF, using namelist values."
+
+ else if ( -e ../cice_inflation_cookie ) then
+ # We want to use an existing inflation file, but this is
+ # the first assimilation so there is no existing inflation
+ # file. This is the signal we need to to coerce the namelist
+ # to have different values for this execution ONLY.
+ # Since the local namelist comes from CASEROOT each time, we're golden.
+
+ set POSTE_TF = FALSE
+
+ex input.nml <! latestfile) > & /dev/null
+ set nfiles = `cat latestfile | wc -l`
+
+ if ( $nfiles > 0 ) then
+ set latest = `cat latestfile`
+ ${LINK} $latest input_postinf_mean.nc
+ else
+ echo "ERROR: Requested POSTERIOR inflation but specified no incoming inflation MEAN file."
+ echo "ERROR: expected something like ../cice.output_postinf_mean.YYYY-MM-DD-SSSSS.nc"
+ exit 2
+ endif
+
+ # Checking for a posterior inflation sd file to use
+
+ (ls -rt1 ../cice.output_postinf_sd.* | tail -n 1 >! latestfile) > & /dev/null
+ set nfiles = `cat latestfile | wc -l`
+
+ if ( $nfiles > 0 ) then
+ set latest = `cat latestfile`
+ ${LINK} $latest input_postinf_sd.nc
+ else
+ echo "ERROR: Requested POSTERIOR inflation but specified no incoming inflation SD file."
+ echo "ERROR: expected something like ../cice.output_postinf_sd.YYYY-MM-DD-SSSSS.nc"
+ exit 2
+ endif
+
+ endif
+else
+ echo "Posterior Inflation not requested for this assimilation."
+endif
+
+# Eat the cookie regardless
+${REMOVE} ../cice_inflation_cookie
+
+#=========================================================================
+# Block 4: Create a set of restart files before DART has modified anything.
+#
+# filter has the ability to directly modify the cice restart files
+# i.e. it creates the posterior IN-PLACE.
+# We usually want a prior estimate, so we have to save a copy of the
+# input files before we feed them to filter. If we saved every
+# restart, the directory gets polluted pretty fast, so we overwrite
+# the same filenames over and over. The timestamps IN the file can
+# confirm the valid time of the model state.
+#
+# At this time we also create a list of files we want to read/modify.
+#=========================================================================
+
+echo "`date` -- BEGIN CREATING SAFETY FILES"
+
+# create the list of restart files by dereferencing the pointer files.
+# While we are at it, we have to account for the fact they are 1 dir up.
+# CP the input (prior) CICE states for restart purposes.
+# The original CICE files will be updated directly by filter.
+
+${REMOVE} cice_restarts.txt
+
+set member = 1
+while ( ${member} <= ${ensemble_size} )
+
+ set SAFETY_FILE = `printf cice_prior.r.%04d.nc ${member}`
+ set POINTER_FILE = `printf ../rpointer.ice_%04d ${member}`
+
+ set MYFILE = `head -n 1 $POINTER_FILE`
+ set ICE_FILENAME = `echo $MYFILE:t`
+
+ echo "../"${ICE_FILENAME} >> cice_restarts.txt
+
+ ${COPY} ../${ICE_FILENAME} ${SAFETY_FILE} &
+
+ @ member++
+end
+
+wait
+
+echo "`date` -- END CREATING SAFETY FILES for all ${ensemble_size} members."
+
+#=========================================================================
+# If do parameter estimation, call the followsing block
+#=========================================================================
+# if ($PARAMETER_ESTIMATION == TRUE ) then
+#
+# set member = 1
+# while ( $member <= ${ensemble_size} )
+# set inst_string = `printf _%04d $member`
+# set member_dir = `printf member_%04d $member`
+#
+# if (! -d ${member_dir}) mkdir ${member_dir}
+# cd ${member_dir}
+#
+# set ICE_FILENAME = `head -n $member ../cice_restarts.txt | tail -n 1`
+# set PARAMETER_FILENAME = "CICE_PARAMETERS_PRIOR"${inst_string}"."${CPL_DATE_EXT}".nc"
+#
+# ln -sf ../${ICE_FILENAME} cice_restart.nc
+#
+# ln -sf ../input.nml .
+#
+# ln -sf ../../${PARAMETER_FILENAME} parameter_prior.nc
+# echo "starting cice_to_dart for member ${member} at "`date`
+# ${EXEROOT}/cice_to_dart >! output.${member}.cice_to_dart &
+# cd ..
+# @ member ++
+# end
+#
+# wait
+#
+# endif
+
+set member = 1
+while ( $member <= ${ensemble_size} )
+ set inst_string = `printf _%04d $member`
+ set member_dir = `printf member_%04d $member`
+ if (! -d ${member_dir}) mkdir ${member_dir}
+ cd ${member_dir}
+ set ICE_FILENAME = `head -n $member ../cice_restarts.txt | tail -n 1`
+if ( $PARAMETER_ESTIMATION == "TRUE" ) then
+ foreach PARAM ($cice_parameters)
+ if ( $CONTINUE_RUN == "FALSE" || $use_mean == "TRUE" ) then
+ ncks -v fsnow ../$ICE_FILENAME -O temp.nc
+
+ ncrename -v fsnow,$PARAM temp.nc
+
+ set par_value = `grep "$PARAM" "${CASEROOT}/user_nl_cice${inst_string}" | cut -d'=' -f2 | sed "s/^ *//"`
+ echo ${PARAM} $par_value
+ ncap2 -s "${PARAM}[nj,ni]=$par_value" temp.nc temp2.nc
+ echo "ncap2 done"
+ ncks -v ${PARAM} temp2.nc -A ../$ICE_FILENAME
+ rm -rf temp.nc temp2.nc
+ else # use filters delta r_snow
+ set date_yesterday = `date -d "${CPL_DATE[1]}-${CPL_DATE[2]}-${CPL_DATE[3]} 1 day ago" +%F`-${CPL_DATE[4]}
+ set pre_restart = `printf $RUNDIR/${CASE}.cice_%04d.r.${date_yesterday}.nc $member`
+ ncks -v $PARAM $pre_restart -A ../$ICE_FILENAME
+ endif
+ end
+ endif
+ ln -sf ../${ICE_FILENAME} cice_restart.nc
+
+ ln -sf ../input.nml .
+ echo "input.nml linked"
+ @ member ++
+ cd ..
+end
+
+#=========================================================================
+# Block 5: Actually run the assimilation.
+#
+# >@todo FIXME ... this whole section
+#
+# REQUIRED DART namelist settings:
+# &filter_nml: async = 0,
+# &filter_nml: adv_ens_command = "no_advance_script",
+# &filter_nml: obs_sequence_in_name = 'obs_seq.out'
+# &filter_nml: obs_sequence_out_name = 'obs_seq.final'
+# &filter_nml: init_time_days = -1,
+# &filter_nml: init_time_seconds = -1,
+# &filter_nml: first_obs_days = -1,
+# &filter_nml: first_obs_seconds = -1,
+# &filter_nml: last_obs_days = -1,
+# &filter_nml: last_obs_seconds = -1,
+#
+# &filter_nml: input_restart_file_list = "cice_restarts.txt"
+# &filter_nml: output_restart_file_list = "cice_restarts.txt"
+# &filter_nml: output_restarts = .true.
+# &filter_nml: stages_to_write = 'output'
+#=========================================================================
+
+# The cice model_mod.f90:static_init_model() has a hardcoded 'cice.r.nc'
+# that must exist. The cice_in,drv_in namelists must also exist in this directory
+
+set TEMPLATEFILE = `head -n 1 cice_restarts.txt`
+ln -sf $TEMPLATEFILE cice.r.nc
+ln -sf ../ice_in_0001 cice_in
+ln -sf ../drv_in drv_in
+
+echo "`date` -- BEGIN FILTER"
+${LAUNCHCMD} ${EXEROOT}/filter || exit 5
+echo "`date` -- END FILTER"
+
+# 1) rename DART files to reflect current date and component
+# 2) move to RUNDIR so they get archived and the DART_INFLATION block works next cycle
+
+foreach FILE ( input_*mean.nc input_*sd.nc \
+ preassim_*nc \
+ postassim_*.nc \
+ output_*mean.nc output_*sd.nc \
+ dart_log* obs_seq.final )
+
+ if ( -e $FILE ) then
+ set FEXT = $FILE:e
+ set FBASE = $FILE:r
+ ${MOVE} $FILE ../cice.${FBASE}.${CPL_DATE_EXT}.${FEXT}
+ else
+ echo "$FILE does not exist, no need to take action."
+ endif
+
+end
+
+# Copy obs_seq.final files to a place that won't be archived,
+# so that they don't need to be retrieved from the HPSS.
+if (! -d ../../Obs_seqs) mkdir ../../Obs_seqs
+${COPY} ../cice.obs_seq.${CPL_DATE_EXT}.final ../../Obs_seqs &
+
+# Handle localization_diagnostics_files
+set MYSTRING = `grep 'localization_diagnostics_file' input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+set MYSTRING = `echo $MYSTRING | sed -e 's#"# #g'`
+set loc_diag = $MYSTRING[2]
+if (-f $loc_diag) then
+ $MOVE $loc_diag ../cice.${loc_diag}.${CPL_DATE_EXT}
+endif
+
+# Handle regression diagnostics
+set MYSTRING = `grep 'reg_diagnostics_file' input.nml`
+set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+set MYSTRING = `echo $MYSTRING | sed -e 's#"# #g'`
+set reg_diag = $MYSTRING[2]
+if (-f $reg_diag) then
+ $MOVE $reg_diag ../cice.${reg_diag}.${CPL_DATE_EXT}
+endif
+
+#=========================================================================
+# Block 6:
+# The filter settings update the cice netcdf files directly - BUT -
+# they need to be rebalanced before being used. The rebalancing is done
+# by the dart_to_cice program.
+# Each member will do its job in its own directory.
+# Block 7: The ice files have now been updated, move them into position.
+# >@todo FIXME ... rename 'dart_to_cice' to 'rebalance_cice' or something
+# more accurate.
+#=========================================================================
+
+echo "`date` -- BEGIN DART-TO-CICE"
+set member = 1
+while ( $member <= $ensemble_size )
+
+ set inst_string = `printf _%04d $member`
+ set member_dir = `printf member_%04d $member`
+
+ if (! -d ${member_dir}) mkdir ${member_dir}
+ cd ${member_dir}
+
+ ${REMOVE} output.${member}.dart_to_ice
+
+ set ICE_FILENAME = `head -n $member ../cice_restarts.txt | tail -n 1`
+
+ ${LINK} ../${ICE_FILENAME} dart_restart.nc || exit 6
+
+ #========================================================
+ # FEI: link the prior restart file cice_prior.r.$member.nc
+ # to cice_restart.nc `
+ #========================================================
+
+ set PRIOR_FILENAME = `printf cice_prior.r.%04d.nc $member`
+ ln -sf ../${PRIOR_FILENAME} cice_restart.nc
+
+ #========================================================
+ # FEI: link yesterday's restart file
+ # to pre_restart.nc
+ #========================================================
+ cd ${CASEROOT}
+
+ if ( ${CONTINUE_RUN} == "TRUE" ) then
+
+ set date_yesterday = `date -d "${CPL_DATE[1]}-${CPL_DATE[2]}-${CPL_DATE[3]} 1 day ago" +%F`-${CPL_DATE[4]}
+ echo "the forecast began at " $date_yesterday
+ set pre_restart = `printf $RUNDIR/${CASE}.cice_%04d.r.${date_yesterday}.nc $member`
+
+ else
+
+ set infile = `printf $RUNDIR/ice_in_%04d $member`
+ set MYSTRING = `grep 'ice_ic' $infile`
+ set MYSTRING = `echo $MYSTRING | sed -e "s#[=,']# #g"`
+ set MYSTRING = `echo $MYSTRING | sed -e 's#"# #g'`
+ set pre_restart = $MYSTRING[2]
+
+ endif
+
+ cd $RUNDIR/assimilate_ice/${member_dir} #go back to the assim dir
+ ${LINK} $pre_restart pre_restart.nc
+
+
+ echo "starting dart_to_ice for member ${member} at "`date`
+ ${EXEROOT}/dart_to_cice >! output.${member}.dart_to_ice &
+
+ cd ..
+
+ @ member++
+end
+
+wait
+
+set nsuccess = `fgrep 'Finished ... at YYYY' member*/output.[0-9]*.dart_to_ice | wc -l`
+if (${nsuccess} != ${ensemble_size}) then
+ echo "ERROR ... DART died in 'dart_to_cice' ... ERROR"
+ echo "ERROR ... DART died in 'dart_to_cice' ... ERROR"
+ exit 2
+endif
+
+echo "`date` -- END DART-TO-CICE for all ${ensemble_size} members."
+
+
+#=========================================================================
+# Fei: Now take an average of the 2D parameter field and get a global constant
+# Put the new parameter to user_nl_cice_xxxx
+#=========================================================================
+if ( $PARAMETER_ESTIMATION == "TRUE" ) then
+set member = 1
+
+set npar = `echo $#cice_parameters`
+
+while ( $member <= $ensemble_size )
+
+ set inst_string = `printf _%04d $member`
+ set member_dir = `printf member_%04d $member`
+
+ if (! -d ${member_dir} ) exit
+
+ cd ${member_dir}
+
+ set ICE_FILENAME = `head -n $member ../cice_restarts.txt | tail -n 1`
+
+ #${LINK} ../${ICE_FILENAME} dart_restart.nc || exit 6
+
+ #set PARAMETER_FILENAME = "CICE_PARAMETERS_POSTERIOR"${inst_string}"."${CPL_DATE_EXT}".nc"
+ set ipar = 1
+ while ( $ipar <= $npar )
+ set parameter = $cice_parameters[$ipar]
+
+ # use ncwa to get the spatial averaged parameter
+ # store in a netcdf file $parameter.nc
+ # ncks -v $parameter dart_restart.nc $PARAMETER_FILENAME
+
+ cp dart_restart.nc bob.nc
+ ncks -v gw $WORK/headfiles/gw.nc -A bob.nc
+ ncwa -a nj,ni -w gw -v $parameter bob.nc ${parameter}.nc
+
+ rm -rf bob.nc
+ # dump the parameter value into a ascii file
+ ncdump -v $parameter ${parameter}.nc > ${parameter}.txt
+
+ # extract the parameter value from the ascii file
+ set par_string = `grep -oP "${parameter} =\K.*" ${parameter}.txt`
+ set par_value = $par_string[1]
+
+ # now put the new parameter value into user_nl_cice_xxxx under the case root
+ set currdir = `pwd`
+ cd $CASEROOT
+ set myfile = `printf user_nl_cice${inst_string}`
+ sed -e "/${parameter}/c\${parameter} = ${par_value} " $myfile >${myfile}.new
+ mv ${myfile}.new ${myfile}
+ cd ${currdir}
+ @ ipar ++
+ end
+
+ cd ..
+ @ member ++
+ end
+
+endif
+#-------------------------------------------------------------------------
+# Cleanup
+#-------------------------------------------------------------------------
+
+echo "`date` -- END ICE_ASSIMILATE"
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.Precip_template b/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.Precip_template
index d3bce8b029..576d583bbe 100644
--- a/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.Precip_template
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.Precip_template
@@ -4,10 +4,10 @@
- Stream description file for CPL history 3-hourly Precip data at 0.9x1.25 resolution
+ Stream description file for CPL history 3-hourly Precip data
- Raeder et al. 80 member CAM/DART reanalysis
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
@@ -18,7 +18,7 @@
doma_mask mask
- /glade/p/rda/data/ds199.1
+ /glade/collections/rda/data/ds199.1
CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
@@ -32,7 +32,7 @@
a2x6h_Faxa_snowl snowl
- /glade/p/rda/data/ds199.1
+ /glade/collections/rda/data/ds199.1
nearest
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.Solar_template b/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.Solar_template
index 2676f7418d..969819950b 100644
--- a/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.Solar_template
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.Solar_template
@@ -4,10 +4,10 @@
- Stream description file for CPL history 3-hourly Solar data at 0.9x1.25 resolution
+ Stream description file for CPL history 3-hourly Solar data
- Raeder et al. 80 member CAM/DART reanalysis
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
@@ -18,7 +18,7 @@
doma_mask mask
- /glade/p/rda/data/ds199.1
+ /glade/collections/rda/data/ds199.1
CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
@@ -32,7 +32,7 @@
a2x6h_Faxa_swvdf swvdf
- /glade/p/rda/data/ds199.1
+ /glade/collections/rda/data/ds199.1
coszen
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.nonSolarNonPrecip_template b/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.nonSolarNonPrecip_template
index b1653812b2..feadcd5721 100644
--- a/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.nonSolarNonPrecip_template
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHIST3HrWx.nonSolarNonPrecip_template
@@ -4,10 +4,10 @@
- Stream description file for CPL history 3-hourly Solar data at 0.9x1.25 resolution
+ Stream description file for CPL history 3-hourly Solar data
- Raeder et al. 80 member CAM/DART reanalysis
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
@@ -18,7 +18,7 @@
doma_mask mask
- /glade/p/rda/data/ds199.1
+ /glade/collections/rda/data/ds199.1
CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
@@ -38,7 +38,7 @@
a2x6h_Sa_pslv pslv
- /glade/p/rda/data/ds199.1
+ /glade/collections/rda/data/ds199.1
linear
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_2005to2010 b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_2005to2010
new file mode 100644
index 0000000000..6fade7c355
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_2005to2010
@@ -0,0 +1,55 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Faxa_swndr swndr
+ a2x6h_Faxa_swvdr swvdr
+ a2x6h_Faxa_swndf swndf
+ a2x6h_Faxa_swvdf swvdf
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ coszen
+
+
+ -21600
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2006.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2007.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2008.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2009.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2010.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_complete b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_complete
new file mode 100644
index 0000000000..36846c7ae3
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_complete
@@ -0,0 +1,59 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Faxa_swndr swndr
+ a2x6h_Faxa_swvdr swvdr
+ a2x6h_Faxa_swndf swndf
+ a2x6h_Faxa_swvdf swvdf
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ coszen
+
+
+ -21600
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2001.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2002.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2003.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2004.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2005.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2006.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2007.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2008.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2009.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2010.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_single b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_single
new file mode 100644
index 0000000000..4ed9fd8509
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_single
@@ -0,0 +1,50 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Faxa_swndr swndr
+ a2x6h_Faxa_swvdr swvdr
+ a2x6h_Faxa_swndf swndf
+ a2x6h_Faxa_swvdf swvdf
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ coszen
+
+
+ -21600
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_template b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_template
new file mode 100644
index 0000000000..969819950b
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.Solar_template
@@ -0,0 +1,53 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Faxa_swndr swndr
+ a2x6h_Faxa_swvdr swvdr
+ a2x6h_Faxa_swndf swndf
+ a2x6h_Faxa_swvdf swvdf
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ coszen
+
+
+ -21600
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2001.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2002.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2003.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_2005to2010 b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_2005to2010
new file mode 100644
index 0000000000..9dfddf64e2
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_2005to2010
@@ -0,0 +1,53 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Sa_u u
+ a2x6h_Sa_v v
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ linear
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2006.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2007.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2008.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2009.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2010.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_complete b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_complete
new file mode 100644
index 0000000000..3a8c0d7975
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_complete
@@ -0,0 +1,57 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/p/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Sa_u u
+ a2x6h_Sa_v v
+
+
+ /glade/p/collections/rda/data/ds199.1
+
+
+ linear
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2001.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2002.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2003.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2004.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2005.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2006.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2007.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2008.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2009.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2010.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_single b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_single
new file mode 100644
index 0000000000..0cc35331e4
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_single
@@ -0,0 +1,48 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Sa_u u
+ a2x6h_Sa_v v
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ linear
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_template b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_template
new file mode 100644
index 0000000000..c03d2bed67
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State1hr_template
@@ -0,0 +1,51 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Sa_u u
+ a2x6h_Sa_v v
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ linear
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2001.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2002.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2003.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_2005to2010 b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_2005to2010
new file mode 100644
index 0000000000..e79be1cf9b
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_2005to2010
@@ -0,0 +1,59 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Sa_z z
+ a2x6h_Sa_tbot tbot
+ a2x6h_Sa_ptem ptem
+ a2x6h_Sa_shum shum
+ a2x6h_Sa_pbot pbot
+ a2x6h_Faxa_lwdn lwdn
+ a2x6h_Sa_dens dens
+ a2x6h_Sa_pslv pslv
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ linear
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2006.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2007.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2008.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2009.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2010.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_3hr b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_3hr
new file mode 100644
index 0000000000..1b5fe2404a
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_3hr
@@ -0,0 +1,54 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx3h.RUNYEAR.nc
+
+
+
+
+ a2x3h_Sa_z z
+ a2x3h_Sa_tbot tbot
+ a2x3h_Sa_ptem ptem
+ a2x3h_Sa_shum shum
+ a2x3h_Sa_pbot pbot
+ a2x3h_Faxa_lwdn lwdn
+ a2x3h_Sa_dens dens
+ a2x3h_Sa_pslv pslv
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ linear
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx3h.RUNYEAR.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_complete b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_complete
new file mode 100644
index 0000000000..0f03f47ff0
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_complete
@@ -0,0 +1,63 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Sa_z z
+ a2x6h_Sa_tbot tbot
+ a2x6h_Sa_ptem ptem
+ a2x6h_Sa_shum shum
+ a2x6h_Sa_pbot pbot
+ a2x6h_Faxa_lwdn lwdn
+ a2x6h_Sa_dens dens
+ a2x6h_Sa_pslv pslv
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ linear
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2001.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2002.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2003.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2004.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2005.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2006.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2007.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2008.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2009.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2010.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_single b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_single
new file mode 100644
index 0000000000..4bb162abbf
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_single
@@ -0,0 +1,54 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Sa_z z
+ a2x6h_Sa_tbot tbot
+ a2x6h_Sa_ptem ptem
+ a2x6h_Sa_shum shum
+ a2x6h_Sa_pbot pbot
+ a2x6h_Faxa_lwdn lwdn
+ a2x6h_Sa_dens dens
+ a2x6h_Sa_pslv pslv
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ linear
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_template b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_template
new file mode 100644
index 0000000000..e7dec9697a
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.State3hr_template
@@ -0,0 +1,57 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Solar data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Sa_z z
+ a2x6h_Sa_tbot tbot
+ a2x6h_Sa_ptem ptem
+ a2x6h_Sa_shum shum
+ a2x6h_Sa_pbot pbot
+ a2x6h_Faxa_lwdn lwdn
+ a2x6h_Sa_dens dens
+ a2x6h_Sa_pslv pslv
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ linear
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2001.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2002.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2003.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_2005to2010 b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_2005to2010
new file mode 100644
index 0000000000..f223eae38b
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_2005to2010
@@ -0,0 +1,53 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Precip data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Faxa_rainc rainc
+ a2x6h_Faxa_rainl rainl
+ a2x6h_Faxa_snowc snowc
+ a2x6h_Faxa_snowl snowl
+ a2x6h_Faxa_lwdn lwdn
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2006.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2007.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2008.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2009.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2010.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_3hr b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_3hr
new file mode 100644
index 0000000000..bd8ecc3c00
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_3hr
@@ -0,0 +1,48 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Precip data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx3h.RUNYEAR.nc
+
+
+
+
+ a2x3h_Faxa_rainc rainc
+ a2x3h_Faxa_rainl rainl
+ a2x3h_Faxa_snowc snowc
+ a2x3h_Faxa_snowl snowl
+ a2x3h_Faxa_lwdn lwdn
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx3h.RUNYEAR.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_complete b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_complete
new file mode 100644
index 0000000000..25f2fd1f6c
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_complete
@@ -0,0 +1,57 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Precip data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Faxa_rainc rainc
+ a2x6h_Faxa_rainl rainl
+ a2x6h_Faxa_snowc snowc
+ a2x6h_Faxa_snowl snowl
+ a2x6h_Faxa_lwdn lwdn
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2001.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2002.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2003.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2004.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2005.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2006.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2007.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2008.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2009.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2010.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_single b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_single
new file mode 100644
index 0000000000..02d088af5b
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_single
@@ -0,0 +1,50 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Precip data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Faxa_rainc rainc
+ a2x6h_Faxa_rainl rainl
+ a2x6h_Faxa_snowc snowc
+ a2x6h_Faxa_snowl snowl
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ nearest
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_template b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_template
new file mode 100644
index 0000000000..16321df6a7
--- /dev/null
+++ b/models/cice/shell_scripts/datm.streams.txt.CPLHISTForcing.nonSolarFlux_template
@@ -0,0 +1,51 @@
+
+
+ streams template for datm in CESM1_5
+
+
+
+ Stream description file for CPL history 3-hourly Precip data
+
+
+ Raeder et al. 80 member FV 2 deg CAM/DART reanalysis
+
+
+
+ time time
+ doma_lon lon
+ doma_lat lat
+ doma_area area
+ doma_mask mask
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+
+
+
+
+ a2x6h_Faxa_rainc rainc
+ a2x6h_Faxa_rainl rainl
+ a2x6h_Faxa_snowc snowc
+ a2x6h_Faxa_snowl snowl
+ a2x6h_Faxa_lwdn lwdn
+
+
+ /glade/collections/rda/data/ds199.1
+
+
+ -10800
+
+
+ CAM_DATM.cpl_NINST.ha2x1dx6h.RUNYEAR.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2001.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2002.nc
+ CAM_DATM.cpl_NINST.ha2x1dx6h.2003.nc
+
+
+
+
+
+
diff --git a/models/cice/shell_scripts/docn.streams.txt.som_template b/models/cice/shell_scripts/docn.streams.txt.som_template
new file mode 100644
index 0000000000..1266658922
--- /dev/null
+++ b/models/cice/shell_scripts/docn.streams.txt.som_template
@@ -0,0 +1,40 @@
+
+
+ GENERIC
+
+
+
+ time time
+ xc lon
+ yc lat
+ area area
+ mask mask
+
+
+ /glade/p/work/yfzhang/dataset/SOM
+
+
+ pop_frc.bc.15.1x1d.090130.nc
+
+
+
+
+ T t
+ S s
+ U u
+ V v
+ dhdx dhdx
+ dhdy dhdy
+ hblt h
+ qdp qbot
+
+
+ /glade/p/work/yfzhang/dataset/SOM
+
+
+ pop_frc.bc.15.1x1d.090130.nc
+
+
+ 0
+
+
diff --git a/models/cice/shell_scripts/loop_obs_common_subset.csh b/models/cice/shell_scripts/loop_obs_common_subset.csh
new file mode 100755
index 0000000000..7a0714559e
--- /dev/null
+++ b/models/cice/shell_scripts/loop_obs_common_subset.csh
@@ -0,0 +1,48 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+#>@todo FIXME ... this should use the advance_time program to manipulate the dates.
+#> advance_time gracefully handles leap years etc.
+
+set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
+set case = ( osse_inf_loc0.01_sst osse_inf_loc0.01_pw_sst osse_inf_loc0.01_tw_sst )
+
+set nmonth = 36
+set imonth = 1
+
+set year = 2001
+set m = 1
+while ( $imonth <= $nmonth )
+ if ( $m > 12 ) then
+ @ m = $m - 12
+ @ year = $year + 1
+ endif
+
+ set iday = 1
+ while ( $iday <= $month_days[$m] )
+ set month = `printf %02d $m`
+ set day = `printf %02d $iday`
+ echo $year $month $day
+
+ ls $SCRATCH/$case[1]/Obs_seqs/cice.obs_seq.$year-$month-$day-00000.final \
+ $SCRATCH/$case[2]/Obs_seqs/cice.obs_seq.$year-$month-$day-00000.final \
+ $SCRATCH/$case[3]/Obs_seqs/cice.obs_seq.$year-$month-$day-00000.final > list1.txt
+
+ ./obs_common_subset
+ @ iday = $iday + 1
+ end
+ @ imonth = $imonth + 1
+ @ m = $m + 1
+end
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/models/cice/shell_scripts/loop_obs_seq_tool.csh b/models/cice/shell_scripts/loop_obs_seq_tool.csh
new file mode 100755
index 0000000000..2f67e455b8
--- /dev/null
+++ b/models/cice/shell_scripts/loop_obs_seq_tool.csh
@@ -0,0 +1,53 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+#>@todo FIXME ... this should use the advance_time program to manipulate the dates.
+#> advance_time gracefully handles leap years etc.
+
+set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
+
+set nmonth = 12
+set imonth = 1
+
+set year = 2001
+set m = 1
+while ( $imonth <= $nmonth )
+ if ( $m > 12 ) then
+ @ m = $m - 12
+ @ year = $year + 1
+ endif
+
+ set iday = 1
+ while ( $iday <= $month_days[$m] )
+ set month = `printf %02d $m`
+ set day = `printf %02d $iday`
+ echo $year $month $day
+ set obsdir = "$WORK/observations/syn/cesm2/cice5_init/obs_seqs/"
+
+# ls $obsdir/bootstrap/daily/obs_seqs/obs_seq.$year$month$day \
+# $obsdir/modis-tsfc/obs_seqs/obs_seq.$year-$month-$day-00000 > aice.tsfc.list
+
+ ls $obsdir/aice/obs_seq.${year}-${month}-${day}-00000 \
+ $obsdir/hice/obs_seq.${year}-${month}-${day}-00000 > aice_hice.list
+
+ sed "/filename_out/ c\ filename_out = '/$obsdir/aice_hice/obs_seq.$year-$month-$day-00000'" input.nml > temp
+
+ mv temp input.nml
+ ./obs_sequence_tool
+ @ iday = $iday + 1
+ end
+ @ imonth = $imonth + 1
+ @ m = $m + 1
+end
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/models/cice/work/input.nml b/models/cice/work/input.nml
index 062d5842f9..be5bdec2fe 100644
--- a/models/cice/work/input.nml
+++ b/models/cice/work/input.nml
@@ -36,6 +36,8 @@
num_output_obs_members = 6
output_interval = 1
num_groups = 1
+ distributed_state = .true.
+ compute_posterior = .true.
output_forward_op_errors = .false.
output_timestamps = .true.
trace_execution = .true.
@@ -72,12 +74,10 @@
# {input,forecast,preassim,postassim,analysis,output}_postinf_mean[_dom].nc
# {input,forecast,preassim,postassim,analysis,output}_postinf_sd[_dom].nc
-
# cutoff of 0.03 (radians) is about 200km
&assim_tools_nml
filter_kind = 1
cutoff = 0.05
- allow_missing_in_clm = .false.
sort_obs_inc = .false.
spread_restoration = .false.
sampling_error_correction = .false.
@@ -156,18 +156,30 @@
debug = 1
model_state_variables = 'aicen', 'QTY_SEAICE_CONCENTR' , 'UPDATE',
'vicen', 'QTY_SEAICE_VOLUME' , 'UPDATE',
- 'vsnon', 'QTY_SEAICE_SNOWVOLUME' , 'UPDATE'
+ 'vsnon', 'QTY_SEAICE_SNOWVOLUME' , 'UPDATE',
/
+# r_snw is appended to the cice restart file by 'cice_to_dart.f90', which reads the
+# cice_parameter_nml namelist.
+ 'r_snw', 'QTY_2D_PARAMETER' , 'UPDATE',
+
+
# See the cice model_mod.html for a larger listing of CICE variables and their
# associated DART quantities (QTYs). The list is by no means complete.
+&cice_parameter_nml
+ cice_restart_input_file = 'cice_restart.nc'
+ parameter_input_file = 'parameter_prior.nc'
+ cice_parameters = 'r_snw'
+ /
+
&dart_to_cice_nml
dart_to_cice_input_file = 'dart_restart.nc'
original_cice_input_file = 'cice_restart.nc'
previous_cice_input_file = 'pre_restart.nc'
balance_method = 'simple_squeeze'
+ r_snw_name = 'r_snw_vary'
/
@@ -205,8 +217,8 @@
&obs_common_subset_nml
num_to_compare_at_once = 3
filename_seq = ''
- filename_seq_list = 'list1.txt','list2.txt','list3.txt'
- filename_out = '/glade/p/work/yfzhang/observations/syn/cice5/member10/aggre/aice_hice_fy_tsfc/obs_seq.2003-12-31-00000'
+ filename_seq_list = 'cat.list'
+ filename_out = 'obs_seq.2005-04-02-00000'
print_only = .false.
calendar = 'Gregorian'
/
@@ -223,9 +235,9 @@
&obs_diag_nml
obs_sequence_name = ''
- obs_sequence_list = 'obs_seq_files.txt'
- first_bin_center = 2004, 1, 1, 0, 0, 0
- last_bin_center = 2004, 1, 8, 0, 0, 0
+ obs_sequence_list = 'cat.list'
+ first_bin_center = 2001, 1, 1, 0, 0, 0
+ last_bin_center = 2001, 1, 2, 0, 0, 0
bin_separation = 0, 0, 1, 0, 0, 0
bin_width = 0, 0, 1, 0, 0, 0
time_to_skip = 0, 0, 0, 0, 0, 0
@@ -248,8 +260,8 @@
&obs_sequence_tool_nml
filename_seq = ''
- filename_seq_list = 'pieces.txt'
- filename_out = 'obs_seq.combined'
+ filename_seq_list = 'cat.list'
+ filename_out = 'obs_seq.2005-04-02-00000'
print_only = .false.
gregorian_cal = .true.
synonymous_qc_list = 'COSMOS QC','Ameriflux QC'
diff --git a/models/cice/work/loop_obs_seq_tool.csh b/models/cice/work/loop_obs_seq_tool.csh
new file mode 100755
index 0000000000..71c017de69
--- /dev/null
+++ b/models/cice/work/loop_obs_seq_tool.csh
@@ -0,0 +1,52 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+#>@todo FIXME ... this should use the advance_time program to manipulate the dates.
+#> advance_time gracefully handles leap years etc.
+
+set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
+
+set nmonth = 1
+set imonth = 1
+
+set year = 2005
+set m = 4
+while ( $imonth <= $nmonth )
+ if ( $m > 12 ) then
+ @ m = $m - 12
+ @ year = $year + 1
+ endif
+
+ set iday = 2
+ while ( $iday <= 2 )#$month_days[$m] )
+ set month = `printf %02d $m`
+ set day = `printf %02d $iday`
+ echo $year $month $day
+ set obsdir = "$WORK/observations/syn/cesm2/ice-bridge/cice5_free_2005to2010/obs_seqs/aicen/err0.1/"
+
+# ls $obsdir/bootstrap/daily/obs_seqs/obs_seq.$year$month$day \
+# $obsdir/modis-tsfc/obs_seqs/obs_seq.$year-$month-$day-00000 > aice.tsfc.list
+
+ ls $obsdir/obs_seq.aice?.${year}-${month}-${day}-00000 > cat.list
+
+ sed "/filename_out/ c\ filename_out = '/$obsdir/obs_seq.$year-$month-$day-00000'" input.nml>temp
+
+ mv temp input.nml
+ ./obs_sequence_tool
+ @ iday = $iday + 1
+ end
+ @ imonth = $imonth + 1
+ @ m = $m + 1
+end
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/models/cice/work/mkmf_cice_to_dart b/models/cice/work/mkmf_cice_to_dart
new file mode 100755
index 0000000000..a330c1203b
--- /dev/null
+++ b/models/cice/work/mkmf_cice_to_dart
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../build_templates/mkmf -p cice_to_dart -t ../../../build_templates/mkmf.template \
+ -a "../../.." path_names_cice_to_dart
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/models/cice/work/obs_seq.identity.in b/models/cice/work/obs_seq.identity.in
deleted file mode 100644
index 41dc637767..0000000000
--- a/models/cice/work/obs_seq.identity.in
+++ /dev/null
@@ -1,15 +0,0 @@
- obs_sequence
-obs_kind_definitions
- 0
- num_copies: 0 num_qc: 0
- num_obs: 1 max_num_obs: 1
- first: 1 last: 1
- OBS 1
- -1 -1 -1
-obdef
-loc3d
- 5.771585830797751 -1.289420480267993 1.000000000000000 1
-kind
- -3210
- 0 145732
- 2.000000000000000E-003
diff --git a/models/cice/work/obs_seq.identity.out b/models/cice/work/obs_seq.identity.out
deleted file mode 100644
index eda651f913..0000000000
--- a/models/cice/work/obs_seq.identity.out
+++ /dev/null
@@ -1,21 +0,0 @@
- obs_sequence
-obs_kind_definitions
- 0
- num_copies: 2 num_qc: 1
- num_obs: 1 max_num_obs: 1
-observations
-truth
-Quality Control
- first: 1 last: 1
- OBS 1
- 0.173883378509040
- 0.188380167943492
- 0.000000000000000E+000
- -1 -1 -1
-obdef
-loc3d
- 5.771585830797751 -1.289420480267993 1.000000000000000 1
-kind
- -3210
- 0 145732
- 2.000000000000000E-003
diff --git a/models/cice/work/obs_seq.in b/models/cice/work/obs_seq.in
index a6b4707cf1..ea8def1f13 100644
--- a/models/cice/work/obs_seq.in
+++ b/models/cice/work/obs_seq.in
@@ -1,11 +1,30 @@
obs_sequence
obs_kind_definitions
- 1
+ 2
1 SAT_SEAICE_AGREG_CONCENTR
+ 15 SAT_SEAICE_AGREG_THICKNESS
num_copies: 0 num_qc: 0
- num_obs: 1 max_num_obs: 1
- first: 1 last: 1
+ num_obs: 3 max_num_obs: 3
+ first: 1 last: 3
OBS 1
+ -1 2 -1
+obdef
+loc3d
+ 5.771585830797751 -1.289420480267993 1.000000000000000 1
+kind
+ -3210
+ 0 146128
+ 2.000000000000000E-003
+ OBS 2
+ 1 3 -1
+obdef
+loc3d
+ 2.914699850830530 1.483529864195180 0.000000000000000 -1
+kind
+ 15
+ 0 146128
+ 2.400000000000000E-002
+ OBS 3
-1 -1 -1
obdef
loc3d
diff --git a/models/cice/work/obs_seq.out b/models/cice/work/obs_seq.out
deleted file mode 100644
index c7f4d4b813..0000000000
--- a/models/cice/work/obs_seq.out
+++ /dev/null
@@ -1,22 +0,0 @@
- obs_sequence
-obs_kind_definitions
- 1
- 1 SAT_SEAICE_AGREG_CONCENTR
- num_copies: 2 num_qc: 1
- num_obs: 1 max_num_obs: 1
-observations
-truth
-Quality Control
- first: 1 last: 1
- OBS 1
- 0.81029306812277313
- 0.82853802243329699
- 0.0000000000000000
- -1 -1 -1
-obdef
-loc3d
- 5.759586531581287 -1.291543646475804 1.000000000000000 1
-kind
- 1
- 0 146128
- 2.0000000000000000E-003
diff --git a/models/cice/work/path_names_cice_to_dart b/models/cice/work/path_names_cice_to_dart
new file mode 100644
index 0000000000..ce751aa0f6
--- /dev/null
+++ b/models/cice/work/path_names_cice_to_dart
@@ -0,0 +1,26 @@
+assimilation_code/location/threed_sphere/location_mod.f90
+assimilation_code/location/utilities/default_location_mod.f90
+assimilation_code/location/utilities/location_io_mod.f90
+assimilation_code/modules/assimilation/adaptive_inflate_mod.f90
+assimilation_code/modules/assimilation/assim_model_mod.f90
+assimilation_code/modules/io/dart_time_io_mod.f90
+assimilation_code/modules/io/direct_netcdf_mod.f90
+assimilation_code/modules/io/io_filenames_mod.f90
+assimilation_code/modules/io/state_structure_mod.f90
+assimilation_code/modules/io/state_vector_io_mod.f90
+assimilation_code/modules/observations/obs_kind_mod.f90
+assimilation_code/modules/utilities/distributed_state_mod.f90
+assimilation_code/modules/utilities/ensemble_manager_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/null_win_mod.f90
+assimilation_code/modules/utilities/options_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+models/cice/cice_to_dart.f90
+models/cice/dart_cice_mod.f90
+models/cice/model_mod.f90
+models/utilities/default_model_mod.f90
diff --git a/models/cice/work/quickbuild.csh b/models/cice/work/quickbuild.csh
index 7c428ae88c..148c30576f 100755
--- a/models/cice/work/quickbuild.csh
+++ b/models/cice/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 1
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/clm/clm_to_dart.f90 b/models/clm/clm_to_dart.f90
index a1091d4614..1114acd952 100644
--- a/models/clm/clm_to_dart.f90
+++ b/models/clm/clm_to_dart.f90
@@ -1,8 +1,8 @@
-! 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
+! 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$
+! DART $Id$
program clm_to_dart
@@ -31,16 +31,16 @@ program clm_to_dart
implicit none
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
!-----------------------------------------------------------------------
! namelist parameters with default values.
!-----------------------------------------------------------------------
-character(len=512) :: clm_to_dart_output_file = 'clm_restart.nc'
+character(len=256) :: clm_to_dart_output_file = 'clm_restart.nc'
namelist /clm_to_dart_nml/ clm_to_dart_output_file
diff --git a/models/clm/dart_to_clm.f90 b/models/clm/dart_to_clm.f90
index f2449800bd..018af7ee7c 100644
--- a/models/clm/dart_to_clm.f90
+++ b/models/clm/dart_to_clm.f90
@@ -1,5 +1,5 @@
-! 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
+! 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$
@@ -10,16 +10,7 @@ program dart_to_clm
! purpose: interface between DART and the CLM model
!
! method: Read DART state vector and overwrite values in a CLM restart file.
-! If the DART state vector has an 'advance_to_time' present,
-! it is read ... but nothing happens with it at this time.
-! DART is NEVER expected to advance CLM.
!
-! The dart_to_clm_nml namelist setting for advance_time_present
-! determines whether or not the input file has an 'advance_to_time'.
-! Typically, only temporary files like 'assim_model_state_ic' have
-! an 'advance_to_time'.
-!
-! author: Tim Hoar 12 July 2011
!----------------------------------------------------------------------
use types_mod, only : r8
@@ -35,26 +26,26 @@ program dart_to_clm
implicit none
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
!------------------------------------------------------------------
! The namelist variables
!------------------------------------------------------------------
-character (len = 128) :: dart_to_clm_input_file = 'model_restart.nc'
-logical :: advance_time_present = .false.
+character(len=256) :: dart_to_clm_input_file = 'model_restart.nc'
+logical :: advance_time_present = .false.
namelist /dart_to_clm_nml/ dart_to_clm_input_file, &
advance_time_present
!----------------------------------------------------------------------
-character(len=256) :: clm_restart_filename
-integer :: iunit, io
-type(time_type) :: model_time, adv_to_time
+character(len=256) :: clm_restart_filename
+integer :: iunit, io
+type(time_type) :: model_time, adv_to_time
!----------------------------------------------------------------------
diff --git a/models/clm/work/input.nml b/models/clm/work/input.nml
index e9ca66ecf8..f03e4f26fb 100644
--- a/models/clm/work/input.nml
+++ b/models/clm/work/input.nml
@@ -45,6 +45,8 @@
num_output_obs_members = 3
output_interval = 1
num_groups = 1
+ distributed_state = .true.
+ compute_posterior = .true.
output_forward_op_errors = .false.
output_timestamps = .true.
trace_execution = .true.
diff --git a/models/clm/work/mkmf_clm_to_dart b/models/clm/work/mkmf_clm_to_dart
index 494b4d622d..47bd3be6a1 100755
--- a/models/clm/work/mkmf_clm_to_dart
+++ b/models/clm/work/mkmf_clm_to_dart
@@ -1,7 +1,7 @@
#!/bin/csh
#
-# 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
+# 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
#
# DART $Id$
diff --git a/models/clm/work/mkmf_dart_to_clm b/models/clm/work/mkmf_dart_to_clm
index c25a87cf8e..ba9935518a 100755
--- a/models/clm/work/mkmf_dart_to_clm
+++ b/models/clm/work/mkmf_dart_to_clm
@@ -1,7 +1,7 @@
#!/bin/csh
#
-# 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
+# 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
#
# DART $Id$
diff --git a/models/clm/work/quickbuild.csh b/models/clm/work/quickbuild.csh
index f321ff5b43..5befdf79ec 100755
--- a/models/clm/work/quickbuild.csh
+++ b/models/clm/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 1
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/cm1/work/input.nml b/models/cm1/work/input.nml
index 4fd57b082f..62ccbb9a49 100644
--- a/models/cm1/work/input.nml
+++ b/models/cm1/work/input.nml
@@ -25,6 +25,8 @@
output_sd = .true.
stages_to_write = 'preassim', 'analysis', 'output'
write_all_stages_at_end = .true.
+ distributed_state = .true.
+ compute_posterior = .true.
trace_execution = .true.
output_timestamps = .true.
num_groups = 1
diff --git a/models/cm1/work/quickbuild.csh b/models/cm1/work/quickbuild.csh
index 658e619b34..d1a2e3b9f6 100755
--- a/models/cm1/work/quickbuild.csh
+++ b/models/cm1/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 1
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/coamps/shell_scripts/quickbuild.csh b/models/coamps/shell_scripts/quickbuild.csh
index fc5813a8bb..4641776fbf 100755
--- a/models/coamps/shell_scripts/quickbuild.csh
+++ b/models/coamps/shell_scripts/quickbuild.csh
@@ -43,7 +43,7 @@ endif
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -76,7 +76,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -84,18 +84,18 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -104,13 +104,13 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
\rm -f filter wakeup_filter
@@ -137,7 +137,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
exit 0
diff --git a/models/coamps_nest/shell_scripts/COAMPS_RESTART_SCRIPTS/quickbuild.csh b/models/coamps_nest/shell_scripts/COAMPS_RESTART_SCRIPTS/quickbuild.csh
index dfab045649..290d5be2b7 100755
--- a/models/coamps_nest/shell_scripts/COAMPS_RESTART_SCRIPTS/quickbuild.csh
+++ b/models/coamps_nest/shell_scripts/COAMPS_RESTART_SCRIPTS/quickbuild.csh
@@ -32,13 +32,13 @@ endif
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -71,7 +71,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -80,15 +80,15 @@ foreach TARGET ( mkmf_* )
end
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -97,16 +97,16 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
-\rm -f *.o *.mod filter wakeup_filter
+\rm -f *.o *.mod filter wakeup_filter Makefile .cppdefs
@ n = $n + 1
echo
@@ -130,7 +130,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
exit 0
diff --git a/models/coamps_nest/shell_scripts/quickbuild.csh b/models/coamps_nest/shell_scripts/quickbuild.csh
index 02237597f7..92d08cfa4b 100755
--- a/models/coamps_nest/shell_scripts/quickbuild.csh
+++ b/models/coamps_nest/shell_scripts/quickbuild.csh
@@ -35,12 +35,12 @@ endif
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -73,7 +73,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -81,18 +81,18 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -101,13 +101,13 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
\rm -f filter wakeup_filter create_mean_std create_increment
@@ -148,7 +148,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
exit 0
diff --git a/models/coamps_nest/work/quickbuild.csh b/models/coamps_nest/work/quickbuild.csh
index 02237597f7..92d08cfa4b 100755
--- a/models/coamps_nest/work/quickbuild.csh
+++ b/models/coamps_nest/work/quickbuild.csh
@@ -35,12 +35,12 @@ endif
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -73,7 +73,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -81,18 +81,18 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -101,13 +101,13 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
\rm -f filter wakeup_filter create_mean_std create_increment
@@ -148,7 +148,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
exit 0
diff --git a/models/dynamo/work/quickbuild.csh b/models/dynamo/work/quickbuild.csh
index 8691368613..15b4e6255c 100755
--- a/models/dynamo/work/quickbuild.csh
+++ b/models/dynamo/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -58,13 +58,13 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
@@ -79,7 +79,7 @@ else
endif
#----------------------------------------------------------------------
-# to enable an MPI parallel version of filter for this model,
+# to enable an MPI parallel version of filter for this model,
# call this script with the -mpi argument, or if you are going to build
# with MPI all the time, remove or comment out the entire section above.
#----------------------------------------------------------------------
@@ -108,7 +108,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/forced_barot/work/quickbuild.csh b/models/forced_barot/work/quickbuild.csh
index e0d19f2137..9238ae1d7e 100755
--- a/models/forced_barot/work/quickbuild.csh
+++ b/models/forced_barot/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -58,13 +58,13 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
@@ -79,7 +79,7 @@ else
endif
#----------------------------------------------------------------------
-# to enable an MPI parallel version of filter for this model,
+# to enable an MPI parallel version of filter for this model,
# call this script with the -mpi argument, or if you are going to build
# with MPI all the time, remove or comment out the entire section above.
#----------------------------------------------------------------------
@@ -108,7 +108,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/forced_lorenz_96/work/quickbuild.csh b/models/forced_lorenz_96/work/quickbuild.csh
index 0877e98632..d564920515 100755
--- a/models/forced_lorenz_96/work/quickbuild.csh
+++ b/models/forced_lorenz_96/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/gitm/work/quickbuild.csh b/models/gitm/work/quickbuild.csh
index 883ed728d6..4e0df16155 100755
--- a/models/gitm/work/quickbuild.csh
+++ b/models/gitm/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -58,18 +58,18 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -78,13 +78,13 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
\rm -f filter wakeup_filter
@@ -111,7 +111,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/ikeda/work/mkmf_perfect_model_obs b/models/ikeda/work/mkmf_perfect_model_obs
index 115a465825..551b7098d4 100755
--- a/models/ikeda/work/mkmf_perfect_model_obs
+++ b/models/ikeda/work/mkmf_perfect_model_obs
@@ -5,9 +5,65 @@
# http://www.image.ucar.edu/DAReS/DART/DART_download
#
# DART $Id$
+#
+# usage: mkmf_perfect_model_obs [ -mpi | -nompi ]
+#
+# without any args, builds perfect_model_obs without mpi libraries, and it will run
+# as a normal executable. if -mpi is given, it will be compiled with the mpi
+# libraries and can run with multiple cooperating processes.
+
+if ( $#argv > 0 ) then
+ if ("$argv[1]" == "-mpi") then
+ setenv usingmpi 1
+ else if ("$argv[1]" == "-nompi") then
+ setenv usingmpi 0
+ else
+ echo "Unrecognized argument to mkmf_perfect_model_obs: $argv[1]"
+ echo "Usage: mkmf_perfect_model_obs [ -mpi | -nompi ]"
+ echo " default is to generate a Makefile without MPI support."
+ exit -1
+ endif
+else
+ setenv usingmpi 0
+endif
+
+
+# make a backup copy of the path_names file, and then use
+# sed to make sure it includes either the non-mpi subroutines,
+# or the subroutines which really call mpi.
+cp -f path_names_perfect_model_obs path_names_perfect_model_obs.back
+
+if ( $usingmpi ) then
+
+ echo "Making Makefile with MPI"
+ touch using_mpi_for_perfect_model_obs
+ sed -e 's#/null_mpi_util#/mpi_util#' \
+ -e 's#/null_win_mod#/no_cray_win_mod#' path_names_perfect_model_obs.back >! path_names_perfect_model_obs
+
+ setenv wrapper_arg -w
+
+else
+
+ echo "Making Makefile without MPI"
+ rm -f using_mpi_for_perfect_model_obs
+ sed -e 's#/mpi_util#/null_mpi_util#' \
+ -e '\#no_cray_win_mod.f90#d' \
+ -e '\#cray_win_mod.f90#d' path_names_perfect_model_obs.back >! path_names_perfect_model_obs
+
+ set p=`grep null_win_mod.f90 path_names_perfect_model_obs | wc -w`
+ if ( $p == 0) then
+ echo assimilation_code/modules/utilities/null_win_mod.f90 >> path_names_perfect_model_obs
+ endif
+
+ setenv wrapper_arg ""
+
+endif
+
+# remove temp file and now really call mkmf to generate makefile
+rm -f path_names_perfect_model_obs.back
../../../build_templates/mkmf -p perfect_model_obs -t ../../../build_templates/mkmf.template \
- -a "../../.." path_names_perfect_model_obs
+ -a "../../.." ${wrapper_arg} path_names_perfect_model_obs
exit $status
diff --git a/models/ikeda/work/quickbuild.csh b/models/ikeda/work/quickbuild.csh
index c9a0771740..6be58490fd 100755
--- a/models/ikeda/work/quickbuild.csh
+++ b/models/ikeda/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -77,18 +77,18 @@ if ( $has_cdl > 0 ) then
endif
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -114,14 +114,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -135,15 +135,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -152,10 +152,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -165,26 +165,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/lorenz_04/work/quickbuild.csh b/models/lorenz_04/work/quickbuild.csh
index c221ebbbd8..1467315214 100755
--- a/models/lorenz_04/work/quickbuild.csh
+++ b/models/lorenz_04/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/lorenz_63/work/quickbuild.csh b/models/lorenz_63/work/quickbuild.csh
index 6507b6f4cb..9003c11163 100755
--- a/models/lorenz_63/work/quickbuild.csh
+++ b/models/lorenz_63/work/quickbuild.csh
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/lorenz_84/work/quickbuild.csh b/models/lorenz_84/work/quickbuild.csh
index c50892b6dc..d2ca45b0c9 100755
--- a/models/lorenz_84/work/quickbuild.csh
+++ b/models/lorenz_84/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/lorenz_96/jeff_netcdf.f90 b/models/lorenz_96/jeff_netcdf.f90
index e14b86e41f..4266d9b98c 100644
--- a/models/lorenz_96/jeff_netcdf.f90
+++ b/models/lorenz_96/jeff_netcdf.f90
@@ -12,11 +12,13 @@ program jeff_netcdf
use types_mod, only : r8
-use utilities_mod, only : initialize_utilities, finalize_utilities, nc_check, &
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
open_file, close_file, find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_nml_file, do_nml_term, &
E_ERR, error_handler, get_unit
+use netcdf_utilities_mod, only : nc_check
+
use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
read_time, get_time, set_time, &
print_date, get_date, &
diff --git a/models/lorenz_96/model_mod.f90 b/models/lorenz_96/model_mod.f90
index 99675f526f..8afc554a1d 100644
--- a/models/lorenz_96/model_mod.f90
+++ b/models/lorenz_96/model_mod.f90
@@ -135,15 +135,18 @@ subroutine comp_dt(x, dt)
real(r8), intent(in) :: x(:)
real(r8), intent(out) :: dt(:)
-integer :: j, jp1, jm1, jm2
+integer :: j, jp1, jm1, jm2, ms
-do j = 1, model_size
+! avoid compiler bugs with long integers
+! being used as loop indices.
+ms = model_size
+do j = 1, ms
jp1 = j + 1
- if(jp1 > model_size) jp1 = 1
+ if(jp1 > ms) jp1 = 1
jm2 = j - 2
- if(jm2 < 1) jm2 = model_size + jm2
+ if(jm2 < 1) jm2 = ms + jm2
jm1 = j - 1
- if(jm1 < 1) jm1 = model_size
+ if(jm1 < 1) jm1 = ms
dt(j) = (x(jp1) - x(jm2)) * x(jm1) - x(j) + forcing
end do
diff --git a/models/lorenz_96/work/path_names_jeff_netcdf b/models/lorenz_96/work/path_names_jeff_netcdf
index 0db99bc5d4..44551198e8 100644
--- a/models/lorenz_96/work/path_names_jeff_netcdf
+++ b/models/lorenz_96/work/path_names_jeff_netcdf
@@ -2,4 +2,5 @@ assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
models/lorenz_96/jeff_netcdf.f90
diff --git a/models/lorenz_96/work/quickbuild.csh b/models/lorenz_96/work/quickbuild.csh
index f231dad702..3f9784f9d1 100755
--- a/models/lorenz_96/work/quickbuild.csh
+++ b/models/lorenz_96/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,16 +15,20 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
+#
+# to pass any flags to the 'make' program, set DART_MFLAGS in your environment.
+# e.g. to build faster by running 4 (or your choice) compiles at once:
+# "setenv DART_MFLAGS '-j 4' " (csh) or "export DART_MFLAGS='-j 4' " (bash)
#----------------------------------------------------------------------
# this model name:
set BUILDING = "Lorenz 96"
# programs which have the option of building with MPI:
-set MPI_TARGETS = "filter perfect_model_obs model_mod_check"
+set MPI_TARGETS = "filter perfect_model_obs model_mod_check closest_member_tool"
# set default (override with -mpi or -nompi):
# 0 = build without MPI, 1 = build with MPI
@@ -36,7 +40,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -48,15 +52,21 @@ endif
set preprocess_done = 0
set tdebug = 0
set cdebug = 0
+set mflags = ''
+# environment vars this script looks for
if ( $?CODE_DEBUG ) then
set cdebug = $CODE_DEBUG
endif
if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
+if ( $?DART_MFLAGS ) then
+ set mflags = "$DART_MFLAGS"
+endif
-\rm -f *.o *.mod
+
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +78,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +115,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
- csh $TARGET || exit $n
- make || exit $n
+ csh $TARGET || exit $n
+ make $mflags || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +136,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +153,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +166,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
- make || exit $n
+ make $mflags || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/lorenz_96_2scale/model_mod.f90 b/models/lorenz_96_2scale/model_mod.f90
index a5e38f170f..6a8f867002 100644
--- a/models/lorenz_96_2scale/model_mod.f90
+++ b/models/lorenz_96_2scale/model_mod.f90
@@ -81,7 +81,6 @@ module model_mod
real(r8) :: coupling_b = 10.0_r8
real(r8) :: coupling_c = 10.0_r8
real(r8) :: coupling_h = 1.0_r8
-logical :: output_state_vector = .false.
logical :: local_y = .false. ! default Lorenz' approach
integer :: time_step_days = 0
integer :: time_step_seconds = 3600
@@ -438,8 +437,6 @@ subroutine nc_write_model_atts(ncid, domain_id)
integer(i8) :: indx
type(location_type) :: lctn
real(r8) :: loc
-character(len=128) :: filename
-
call nc_begin_define_mode(ncid)
diff --git a/models/lorenz_96_2scale/work/quickbuild.csh b/models/lorenz_96_2scale/work/quickbuild.csh
index a3388bb140..47a9041388 100755
--- a/models/lorenz_96_2scale/work/quickbuild.csh
+++ b/models/lorenz_96_2scale/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/model_mod_tools/model_check_utilities_mod.f90 b/models/model_mod_tools/model_check_utilities_mod.f90
index 1339a42cbb..6414b488f3 100644
--- a/models/model_mod_tools/model_check_utilities_mod.f90
+++ b/models/model_mod_tools/model_check_utilities_mod.f90
@@ -10,7 +10,7 @@ module model_check_utilities_mod
! support routines for interpolation tests
!-------------------------------------------------------------------------------
-use types_mod, only : r8, i8, metadatalength
+use types_mod, only : r8, i8, metadatalength, missing_r8
use utilities_mod, only : error_handler, E_MSG, do_output
@@ -28,14 +28,13 @@ module model_check_utilities_mod
get_state_meta_data, &
model_interpolate
-use netcdf
-
implicit none
private
public :: test_single_interpolation, &
find_closest_gridpoint, &
- count_error_codes
+ count_error_codes, &
+ verify_consistent_istatus
! version controlled file description for error handling, do not edit
character(len=*), parameter :: source = &
@@ -233,6 +232,40 @@ subroutine find_closest_gridpoint(loc_of_interest, vertcoord_string, quantity_st
end subroutine find_closest_gridpoint
+!-------------------------------------------------------------------------------
+
+subroutine verify_consistent_istatus(ens_size, field, ios_out)
+ integer, intent(in) :: ens_size
+ real(r8), intent(in) :: field(ens_size)
+ integer, intent(in) :: ios_out(ens_size)
+
+character(len=*), parameter :: routine = '' ! name not important in context
+integer :: i
+
+do i = 1, ens_size
+ if (ios_out(i) < 0) then
+ write(string1, *) 'ensemble member ', i, &
+ ' inconsistent return: istatus cannot be a negative value.'
+ call error_handler(E_MSG, routine, string1)
+ endif
+
+ if (ios_out(i) == 0 .and. field(i) == missing_r8) then
+ write(string1, *) 'ensemble member ', i, &
+ ' inconsistent return: istatus = ok but interpolation value = missing data.'
+ call error_handler(E_MSG, routine, string1)
+ endif
+
+ if (ios_out(i) > 0 .and. field(i) /= missing_r8) then
+ write(string1, *) 'ensemble member ', i, &
+ ' inconsistent return: istatus = error but interpolation value /= missing data.'
+ write(string2, *) ' istatus, interp_val = ', ios_out(i), field(i)
+ call error_handler(E_MSG, routine, string1, text2=string2)
+ endif
+enddo
+
+end subroutine verify_consistent_istatus
+
+
!-------------------------------------------------------------------------------
! End of model_check_utilities_mod
!-------------------------------------------------------------------------------
diff --git a/models/model_mod_tools/test_interpolate_oned.f90 b/models/model_mod_tools/test_interpolate_oned.f90
index 28a1ce8a17..4b8c6cef84 100644
--- a/models/model_mod_tools/test_interpolate_oned.f90
+++ b/models/model_mod_tools/test_interpolate_oned.f90
@@ -15,7 +15,9 @@ module test_interpolate_mod
use utilities_mod, only : register_module, error_handler, E_MSG, E_ERR, &
initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
- nc_check, E_MSG, open_file, close_file, do_output
+ E_MSG, open_file, close_file, do_output
+
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : location_type, set_location, write_location, &
get_dist, get_location, LocationDims
@@ -26,7 +28,8 @@ module test_interpolate_mod
use model_check_utilities_mod, only : test_single_interpolation, &
find_closest_gridpoint, &
- count_error_codes
+ count_error_codes, &
+ verify_consistent_istatus
use model_mod, only : get_model_size, &
get_state_meta_data, &
@@ -140,6 +143,8 @@ function test_interpolate_range( ens_handle, &
call model_interpolate(ens_handle, ens_size, loc, quantity_index, field(i,:), ios_out)
+ call verify_consistent_istatus(ens_size, field(i,:), ios_out)
+
write(iunit,*) field(i,:)
if (any(ios_out /= 0)) then
diff --git a/models/model_mod_tools/test_interpolate_threed_cartesian.f90 b/models/model_mod_tools/test_interpolate_threed_cartesian.f90
index c81fb03021..120ddc82e7 100644
--- a/models/model_mod_tools/test_interpolate_threed_cartesian.f90
+++ b/models/model_mod_tools/test_interpolate_threed_cartesian.f90
@@ -15,7 +15,9 @@ module test_interpolate_mod
use utilities_mod, only : register_module, error_handler, E_MSG, E_ERR, &
initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
- nc_check, E_MSG, open_file, close_file, do_output
+ E_MSG, open_file, close_file, do_output
+
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : location_type, set_location, write_location, &
get_dist, get_location, LocationDims
@@ -26,7 +28,8 @@ module test_interpolate_mod
use model_check_utilities_mod, only : test_single_interpolation, &
find_closest_gridpoint, &
- count_error_codes
+ count_error_codes, &
+ verify_consistent_istatus
use model_mod, only : get_model_size, &
get_state_meta_data, &
@@ -145,6 +148,8 @@ function test_interpolate_range( ens_handle, &
call model_interpolate(ens_handle, ens_size, loc, quantity_index, &
field(i,j,k,:), ios_out)
+ call verify_consistent_istatus(ens_size, field(i,j,k,:), ios_out)
+
write(iunit,*) field(i,j,k,:)
if (any(ios_out(:) /= 0)) then
diff --git a/models/model_mod_tools/test_interpolate_threed_sphere.f90 b/models/model_mod_tools/test_interpolate_threed_sphere.f90
index eb3b559d22..1d786ed925 100644
--- a/models/model_mod_tools/test_interpolate_threed_sphere.f90
+++ b/models/model_mod_tools/test_interpolate_threed_sphere.f90
@@ -10,12 +10,14 @@ module test_interpolate_mod
! interpolation test routines for threed sphere locations.
!-------------------------------------------------------------------------------
-use types_mod, only : r8, i8, missing_r8, metadatalength
+use types_mod, only : r8, i8, MISSING_R8, metadatalength
use utilities_mod, only : register_module, error_handler, E_MSG, E_ERR, &
initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
- nc_check, E_MSG, open_file, close_file, do_output
+ E_MSG, open_file, close_file, do_output
+
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : location_type, set_location, write_location, &
get_dist, get_location, LocationDims, &
@@ -28,7 +30,8 @@ module test_interpolate_mod
use ensemble_manager_mod, only : ensemble_type
use model_check_utilities_mod, only : test_single_interpolation, &
- count_error_codes
+ count_error_codes, &
+ verify_consistent_istatus
use model_mod, only : get_model_size, &
get_state_meta_data, &
@@ -167,6 +170,9 @@ function test_interpolate_range( ens_handle, &
call model_interpolate(ens_handle, ens_size, loc, quantity_index, &
field(ilon,jlat,kvert,:), ios_out)
+
+ call verify_consistent_istatus(ens_size, field(ilon,jlat,kvert,:), ios_out)
+
write(iunit,*) field(ilon,jlat,kvert,:)
if (any(ios_out /= 0)) then
diff --git a/models/model_mod_tools/test_interpolate_twod.f90 b/models/model_mod_tools/test_interpolate_twod.f90
index 7140cadc8b..e360b3b97f 100644
--- a/models/model_mod_tools/test_interpolate_twod.f90
+++ b/models/model_mod_tools/test_interpolate_twod.f90
@@ -15,7 +15,9 @@ module test_interpolate_mod
use utilities_mod, only : register_module, error_handler, E_MSG, E_ERR, &
initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
- nc_check, E_MSG, open_file, close_file, do_output
+ E_MSG, open_file, close_file, do_output
+
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : location_type, set_location, write_location, &
get_dist, get_location, LocationDims
@@ -26,7 +28,8 @@ module test_interpolate_mod
use model_check_utilities_mod, only : test_single_interpolation, &
find_closest_gridpoint, &
- count_error_codes
+ count_error_codes, &
+ verify_consistent_istatus
use model_mod, only : get_model_size, &
get_state_meta_data, &
@@ -144,6 +147,8 @@ function test_interpolate_range( ens_handle, &
call model_interpolate(ens_handle, ens_size, loc, mykindindex, field(i,j,:), ios_out)
+ call verify_consistent_istatus(ens_size, field(i,j,:), ios_out)
+
write(iunit,*) field(i,j,:)
if (any(ios_out /= 0)) then
diff --git a/models/model_mod_tools/test_quad_irreg_interp.f90 b/models/model_mod_tools/test_quad_irreg_interp.f90
new file mode 100644
index 0000000000..29b828c235
--- /dev/null
+++ b/models/model_mod_tools/test_quad_irreg_interp.f90
@@ -0,0 +1,310 @@
+! 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
+!
+! DART $Id$
+
+program test_quad_irreg_interp
+
+! intended to show how the state structure and quad code can be used
+! together. start with a simple regional grid and work out from there.
+
+! Modules that are absolutely required for use are listed
+use types_mod, only : r8, i8, MISSING_R8, deg2rad, rad2deg
+use utilities_mod, only : error_handler, initialize_utilities, finalize_utilities
+use random_seq_mod, only : init_random_seq, random_seq_type, &
+ random_uniform, random_gaussian
+
+use quad_utils_mod, only : quad_interp_handle, init_quad_interp, finalize_quad_interp, set_quad_coords, &
+ quad_lon_lat_locate, quad_lon_lat_evaluate, GRID_QUAD_FULLY_REGULAR, &
+ GRID_QUAD_IRREG_SPACED_REGULAR, GRID_QUAD_FULLY_IRREGULAR, GRID_QUAD_UNKNOWN_TYPE, &
+ QUAD_LOCATED_UNKNOWN, QUAD_LOCATED_CELL_CENTERS, QUAD_LOCATED_LON_EDGES, &
+ QUAD_LOCATED_LAT_EDGES, QUAD_LOCATED_CELL_CORNERS
+
+
+implicit none
+
+integer :: debug = 0
+
+type(quad_interp_handle) :: h
+
+! data grid size
+integer, parameter :: nx = 9
+integer, parameter :: ny = 5
+
+! locations of data grid corners
+real(r8) :: data_lons(nx, ny) = MISSING_R8
+real(r8) :: data_lats(nx, ny) = MISSING_R8
+
+! extents of the data grid (these mimic a regional model's grid)
+real(r8) :: start_lon = 100.0_r8
+real(r8) :: end_lon = 150.5_r8
+real(r8) :: start_lat = -11.4_r8
+real(r8) :: end_lat = 34.1_r8
+
+! angle to rotate data grid in degrees
+! positive is counterclockwise; will rotate
+! around lower left grid point (start lon/lat).
+ real(r8) :: angle = 10.0_r8
+!real(r8) :: angle = 45.0_r8
+!real(r8) :: angle = 30.0_r8
+!real(r8) :: angle = 90.0_r8
+!real(r8) :: angle = -30.0_r8
+!real(r8) :: angle = -10.0_r8
+!real(r8) :: angle = 0.0_r8
+
+! deform grid by this fraction of the deltas
+real(r8) :: lon_def = 0.25_r8
+real(r8) :: lat_def = 0.25_r8
+
+! data values on the grid
+real(r8) :: grid_data(nx, ny) = MISSING_R8
+integer :: data_choice = 0 ! see code for selection values
+
+! percent of data values that should be marked 'missing data'
+!real(r8) :: miss_percent = 0.0_r8 ! none
+ real(r8) :: miss_percent = 3.0_r8 ! 3%
+!real(r8) :: miss_percent = 100.0_r8 ! all
+
+! sampling grid size
+integer, parameter :: nrx = 210
+integer, parameter :: nry = 150
+
+! locations of sampling grid
+real(r8) :: sample_lons(nrx) = MISSING_R8
+real(r8) :: sample_lats(nry) = MISSING_R8
+
+! extents of the sampling grid
+real(r8) :: sample_start_lon = 110.0_r8
+real(r8) :: sample_end_lon = 140.0_r8
+real(r8) :: sample_start_lat = -20.0_r8
+real(r8) :: sample_end_lat = 30.0_r8
+
+! where interpolated values are stored on reg grid
+real(r8) :: interp_data(nrx, nry) = MISSING_R8
+
+
+type(random_seq_type) :: ran
+
+integer :: i, j, k
+real(r8) :: lon_del, lat_del, sample_lon_del, sample_lat_del
+integer :: lon_bot, lat_bot, lon_top, lat_top
+integer :: four_lons(4), four_lats(4)
+integer :: istatus
+real(r8) :: invals(4), outval
+integer :: iunit_orig, iunit_interp
+
+call initialize_utilities('test_quad_irreg_interp')
+call init_random_seq(ran)
+
+lon_del = (end_lon - start_lon) / (nx-1)
+lat_del = (end_lat - start_lat) / (ny-1)
+
+! "data grid" corners and data vals
+do i=1, nx
+ do j=1, ny
+ ! generate locations of the corners of all the quads
+ data_lons(i, j) = start_lon + (i-1)*lon_del + deform(lon_del, lon_def, ran)
+ data_lats(i, j) = start_lat + (j-1)*lat_del + deform(lat_del, lat_def, ran)
+ if (angle /= 0.0_r8) &
+ call rotate(data_lons(i, j), data_lats(i, j), angle, start_lon, start_lat)
+
+ ! generate the data values on the corners. pick one:
+ select case (data_choice)
+ case (1)
+ ! increasing monotonically
+ grid_data(i, j) = (j-1)*nx + i
+ case (2)
+ ! constant by row
+ grid_data(i, j) = j
+ case (3)
+ ! constant by column
+ grid_data(i, j) = i
+ case (4)
+ ! based on lon only
+ grid_data(i, j) = data_lons(i, j)
+ case (5)
+ ! based on lat only
+ grid_data(i, j) = data_lats(i, j)
+ case (6)
+ ! random between (0-10)
+ grid_data(i, j) = random_uniform(ran) * 10.0_r8
+ case default
+ ! gaussian with mean 0 and stddev 1
+ grid_data(i, j) = random_gaussian(ran, 0.0_r8, 1.0_r8)
+ end select
+
+ if (miss_percent > 0.0_r8) then
+ if (random_uniform(ran) * 100.0_r8 < miss_percent) grid_data(i, j) = MISSING_R8
+ endif
+
+ enddo
+enddo
+
+sample_lon_del = (sample_end_lon - sample_start_lon) / nrx
+sample_lat_del = (sample_end_lat - sample_start_lat) / nry
+
+! "sampled grid" spacing along each axis
+do i=1, nrx
+ sample_lons(i) = sample_start_lon + (i-1)*sample_lon_del
+enddo
+do j=1, nry
+ sample_lats(j) = sample_start_lat + (j-1)*sample_lat_del
+enddo
+
+! end of data setup - now call interp routines
+
+call init_quad_interp(GRID_QUAD_FULLY_IRREGULAR, nx, ny, QUAD_LOCATED_CELL_CENTERS, .false., .false., .false., h)
+call set_quad_coords(h, data_lons, data_lats)
+
+! for each location in the sampling grid, interpolate a data value
+do i=1, nrx
+ do j=1, nry
+ call quad_lon_lat_locate(h, sample_lons(i), sample_lats(j), four_lons, four_lats, istatus)
+ if (istatus /= 0) then
+ !print *, 'location outside of grid: ', sample_lons(i), sample_lats(j)
+ interp_data(i, j) = MISSING_R8
+ cycle
+ endif
+ if (debug > 0) print *, i, j, four_lons(1), four_lons(3), four_lats(1), four_lats(3), sample_lons(i), sample_lats(j)
+
+ ! get values of data at lon/lat bot/top indices, counterclockwise around quad
+ do k=1, 4
+ invals(k) = grid_data(four_lons(k), four_lats(k))
+ enddo
+
+ call quad_lon_lat_evaluate(h, sample_lons(i), sample_lats(j), four_lons, four_lats, &
+ invals, outval, istatus)
+
+ interp_data(i, j) = outval
+
+ enddo
+enddo
+
+! this program doesn't currently have any missing locations - but i'll test that next.
+if (debug > 0) print *, 'number of missing values in input data: ', count(grid_data(:,:) == MISSING_R8)
+if (debug > 0) print *, 'number of missing values in output data: ', count(interp_data(:,:) == MISSING_R8)
+
+call writeit_2d('data_lons_2d_irreg_test.txt', nx, ny, data_lons)
+call writeit_2d('data_lats_2d_irreg_test.txt', nx, ny, data_lats)
+call writeit_2d('data_data_2d_irreg_test.txt', nx, ny, grid_data)
+
+call writeit_1d('sample_lons_1d_irreg_test.txt', nrx, sample_lons)
+call writeit_1d('sample_lats_1d_irreg_test.txt', nry, sample_lats)
+call writeit_2d('sample_data_2d_irreg_test.txt', nrx, nry, interp_data)
+
+call finalize_quad_interp(h)
+call finalize_utilities('test_quad_irreg_interp')
+
+if (debug > 0) print *, 'closed files and finalized interp handle'
+
+contains
+
+!------------------------------------------------------------
+! rotate vector a counterclockwise by angle theta, relative
+! to the given origin point.
+
+subroutine rotate(x, y, theta, x0, y0)
+ real(r8), intent(inout) :: x, y
+ real(r8), intent(in) :: theta
+ real(r8), intent(in) :: x0, y0
+
+real(r8) :: a(2), b(2)
+real(r8) :: r(2,2)
+real(r8) :: rads
+
+a(1) = x - x0
+a(2) = y - y0
+
+rads = theta * deg2rad
+
+r(1,1) = cos(rads)
+r(1,2) = sin(rads)
+r(2,1) = sin(-rads)
+r(2,2) = cos(rads)
+
+b(1) = r(1,1)*a(1) + r(1,2)*a(2)
+b(2) = r(2,1)*a(1) + r(2,2)*a(2)
+
+x = b(1) + x0
+y = b(2) + y0
+
+end subroutine rotate
+
+!------------------------------------------------------------
+! compute +/- a random value based on a width and percentage
+! of that width
+
+function deform(width, fraction, seq)
+
+use random_seq_mod
+
+ real(r8), intent(in) :: width
+ real(r8), intent(in) :: fraction
+ type(random_seq_type), intent(inout) :: seq
+ real(r8) :: deform
+
+real(r8) :: val
+
+! random val between -1 and 1
+val = (random_uniform(seq) * 2.0_r8) - 1.0_r8
+
+deform = val * width * fraction
+
+end function deform
+
+!------------------------------------------------------------
+
+subroutine writeit_1d(fname, nx, dataarray)
+
+use utilities_mod
+
+ character(len=*), intent(in) :: fname
+ integer, intent(in) :: nx
+ real(r8), intent(in) :: dataarray(:)
+
+integer :: i, j, iunit
+
+iunit = open_file(fname, action='write')
+
+do i=1, nx
+ write(iunit, *) dataarray(i)
+enddo
+
+call close_file(iunit)
+
+end subroutine writeit_1d
+
+!------------------------------------------------------------
+
+subroutine writeit_2d(fname, nx, ny, dataarray)
+
+use utilities_mod
+
+ character(len=*), intent(in) :: fname
+ integer, intent(in) :: nx, ny
+ real(r8), intent(in) :: dataarray(nx, ny)
+
+integer :: i, j, iunit
+
+iunit = open_file(fname, action='write')
+
+do i=1, nx
+ do j=1, ny
+ write(iunit, *) dataarray(i, j)
+ enddo
+enddo
+
+call close_file(iunit)
+
+end subroutine writeit_2d
+
+!------------------------------------------------------------
+
+end program test_quad_irreg_interp
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/models/model_mod_tools/test_quad_reg_interp.f90 b/models/model_mod_tools/test_quad_reg_interp.f90
new file mode 100644
index 0000000000..73b769fb75
--- /dev/null
+++ b/models/model_mod_tools/test_quad_reg_interp.f90
@@ -0,0 +1,353 @@
+! 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
+!
+! DART $Id$
+
+program test_quad_reg_interp
+
+! example of how to use the quad interpolate code on a fully regular grid.
+
+!>@todo FIXME include the state struct or fold this into a version of model_mod_check
+
+! Modules that are absolutely required for use are listed
+use types_mod, only : r8, i8, MISSING_R8, deg2rad, rad2deg
+use utilities_mod, only : error_handler, initialize_utilities, finalize_utilities
+use random_seq_mod, only : init_random_seq, random_seq_type, &
+ random_uniform, random_gaussian
+
+use quad_utils_mod, only : quad_interp_handle, init_quad_interp, finalize_quad_interp, set_quad_coords, &
+ quad_lon_lat_locate, quad_lon_lat_evaluate, GRID_QUAD_FULLY_REGULAR, &
+ GRID_QUAD_IRREG_SPACED_REGULAR, GRID_QUAD_FULLY_IRREGULAR, GRID_QUAD_UNKNOWN_TYPE, &
+ QUAD_LOCATED_UNKNOWN, QUAD_LOCATED_CELL_CENTERS, QUAD_LOCATED_LON_EDGES, &
+ QUAD_LOCATED_LAT_EDGES, QUAD_LOCATED_CELL_CORNERS
+
+
+implicit none
+
+integer :: debug = 0
+
+type(quad_interp_handle) :: h
+
+! data grid. these are the values we will interpolate from.
+
+! data grid size
+! (we compute delta lon, delta lat based on these vals)
+integer, parameter :: ndx = 9
+integer, parameter :: ndy = 5
+
+! extents of the data grid (these mimic a regional model's grid)
+real(r8) :: data_start_lon = 100.0_r8
+real(r8) :: data_end_lon = 150.5_r8
+real(r8) :: data_start_lat = -11.4_r8
+real(r8) :: data_end_lat = 34.1_r8
+
+! these aren't needed for the interpolation, but they're written
+! out for ease of plotting the results
+real(r8) :: grid_lons(ndx)
+real(r8) :: grid_lats(ndy)
+
+! data values on the grid
+real(r8) :: grid_data(ndx, ndy) = MISSING_R8
+integer :: data_choice = 0 ! see code for selection values
+
+! percent of data values that should be marked 'missing data'
+!real(r8) :: miss_percent = 0.0_r8 ! none
+ real(r8) :: miss_percent = 3.0_r8 ! 3%
+!real(r8) :: miss_percent = 100.0_r8 ! all
+
+
+! interpolation test grid. we construct a different grid
+! and call the interpolation code on each corner of this
+! other grid. called 'sampling grid' to differentiate it
+! from the 'data grid'. usually much denser so we can look
+! for discontinuties or errors in the interp code.
+
+! sampling grid size
+integer, parameter :: nsx = 210
+integer, parameter :: nsy = 150
+
+! locations of sampling grid
+real(r8) :: sample_lons(nsx, nsy) = MISSING_R8
+real(r8) :: sample_lats(nsx, nsy) = MISSING_R8
+
+! extents of the sampling grid
+real(r8) :: sample_start_lon = 110.0_r8
+real(r8) :: sample_end_lon = 140.0_r8
+real(r8) :: sample_start_lat = -20.0_r8
+real(r8) :: sample_end_lat = 30.0_r8
+
+! angle to rotate sampling grid in degrees
+! positive is counterclockwise; will rotate
+! around lower left grid point (start lon/lat).
+!real(r8) :: angle = 10.0_r8
+!real(r8) :: angle = 45.0_r8
+ real(r8) :: angle = -65.0_r8
+!real(r8) :: angle = 30.0_r8
+!real(r8) :: angle = 90.0_r8
+!real(r8) :: angle = -30.0_r8
+!real(r8) :: angle = -10.0_r8
+!real(r8) :: angle = 0.0_r8
+
+! deform grid by this fraction of the deltas
+!real(r8) :: lon_def = 0.25_r8
+!real(r8) :: lat_def = 0.25_r8
+ real(r8) :: lon_def = 0.01_r8
+ real(r8) :: lat_def = 0.01_r8
+!real(r8) :: lon_def = 0.0_r8
+!real(r8) :: lat_def = 0.0_r8
+
+! where interpolated values are stored on reg grid
+real(r8) :: interp_data(nsx, nsy) = MISSING_R8
+
+
+type(random_seq_type) :: ran
+
+integer :: i, j
+real(r8) :: data_del_lon, data_del_lat, sample_del_lon, sample_del_lat
+integer :: lon_indices(4), lat_indices(4)
+real(r8) :: lon_fract, lat_fract
+integer :: istatus
+real(r8) :: invals(4), outval
+integer :: iunit_orig, iunit_interp
+
+call initialize_utilities('test_quad_reg_interp')
+call init_random_seq(ran)
+
+
+! "data grid" corners and data vals
+
+data_del_lon = (data_end_lon - data_start_lon) / ndx
+data_del_lat = (data_end_lat - data_start_lat) / ndy
+
+do i=1, ndx
+ do j=1, ndy
+ ! generate the data values on the corners. pick one:
+ select case (data_choice)
+ case (1)
+ ! increasing monotonically
+ grid_data(i, j) = (j-1)*ndx + i
+ case (2)
+ ! constant by row
+ grid_data(i, j) = j
+ case (3)
+ ! constant by column
+ grid_data(i, j) = i
+ case (4)
+ ! based on lon only
+ grid_data(i, j) = data_start_lon + (data_del_lon * (i-1))
+ case (5)
+ ! based on lat only
+ grid_data(i, j) = data_start_lat + (data_del_lat * (j-1))
+ case (6)
+ ! random between (0-10)
+ grid_data(i, j) = random_uniform(ran) * 10.0_r8
+ case default
+ ! gaussian with mean 0 and stddev 1
+ grid_data(i, j) = random_gaussian(ran, 0.0_r8, 1.0_r8)
+ end select
+
+ if (miss_percent > 0.0_r8) then
+ if (random_uniform(ran) * 100.0_r8 < miss_percent) grid_data(i, j) = MISSING_R8
+ endif
+
+ enddo
+enddo
+
+sample_del_lon = (sample_end_lon - sample_start_lon) / nsx
+sample_del_lat = (sample_end_lat - sample_start_lat) / nsy
+
+! "sampled grid" spacing along each axis
+do i=1, nsx
+ do j=1, nsy
+ sample_lons(i, j) = sample_start_lon + (i-1)*sample_del_lon + deform(sample_del_lon, lon_def, ran)
+ sample_lats(i, j) = sample_start_lat + (j-1)*sample_del_lat + deform(sample_del_lat, lat_def, ran)
+
+ ! generate locations of the corners of all the quads
+ if (angle /= 0.0_r8) &
+ call rotate(sample_lons(i, j), sample_lats(i, j), angle, sample_start_lon, sample_start_lat)
+enddo
+enddo
+
+! end of data setup - now call interp routines
+
+
+call init_quad_interp(GRID_QUAD_FULLY_REGULAR, ndx, ndy, QUAD_LOCATED_CELL_CENTERS, .false., .false., .false., h)
+call set_quad_coords(h, data_start_lon, data_del_lon, data_start_lat, data_del_lat)
+
+do i=1, nsx
+ do j=1, nsy
+
+ !>this interface now returns an array of 4 index combinations
+ !>so the calling code can do loops from 1 to 4 instead of making
+ !>combinations of lat/lon bot/top in the right order for eval.
+
+ call quad_lon_lat_locate(h, sample_lons(i,j), sample_lats(i,j), lon_indices, lat_indices, &
+ lon_fract, lat_fract, istatus)
+ if (istatus /= 0) then
+ !print *, 'location outside of grid: ', sample_lons(i,j), sample_lats(i,j)
+ interp_data(i, j) = MISSING_R8
+ cycle
+ endif
+ if(debug > 0)print *, i, j, lon_indices, lat_indices, lon_fract, lat_fract, sample_lons(i,j), sample_lats(i,j)
+
+ ! get values of data at lon/lat bot/top indices, counterclockwise around quad
+ invals(1) = grid_data(lon_indices(1), lat_indices(1))
+ invals(2) = grid_data(lon_indices(2), lat_indices(2))
+ invals(3) = grid_data(lon_indices(3), lat_indices(3))
+ invals(4) = grid_data(lon_indices(4), lat_indices(4))
+
+ ! where does this go? inside quad_lon_lat_evaluate() or here?
+ if (any(invals == MISSING_R8)) then
+ interp_data(i, j) = MISSING_R8
+ cycle
+ endif
+
+ call quad_lon_lat_evaluate(h, lon_fract, lat_fract, invals, outval, istatus)
+
+ if (istatus == 0) then
+ interp_data(i, j) = outval
+ else
+ interp_data(i, j) = MISSING_R8
+ endif
+
+ enddo
+enddo
+
+! this program doesn't currently have any missing locations - but i'll test that next.
+if (debug > 0) print *, 'number of missing values in input data: ', count(grid_data(:,:) == MISSING_R8)
+if (debug > 0) print *, 'number of missing values in output data: ', count(interp_data(:,:) == MISSING_R8)
+
+! generate these only for output for plotting the results
+! these aren't needed for the interpolation.
+do i=1,ndx
+ grid_lons(i) = data_start_lon + (data_del_lon * (i-1))
+enddo
+do j=1,ndy
+ grid_lats(j) = data_start_lat + (data_del_lat * (j-1))
+enddo
+
+call writeit_1d('data_lons_1d_reg_test.txt', ndx, grid_lons)
+call writeit_1d('data_lats_1d_reg_test.txt', ndy, grid_lats)
+call writeit_2d('data_data_2d_reg_test.txt', ndx, ndy, grid_data)
+
+call writeit_2d('sample_lons_2d_reg_test.txt', nsx, nsy, sample_lons)
+call writeit_2d('sample_lats_2d_reg_test.txt', nsx, nsy, sample_lats)
+call writeit_2d('sample_data_2d_reg_test.txt', nsx, nsy, interp_data)
+
+call finalize_quad_interp(h)
+if (debug > 0) print *, 'closed files and finalized interp handle'
+
+call finalize_utilities('test_quad_reg_interp')
+
+
+contains
+
+!------------------------------------------------------------
+! rotate vector a counterclockwise by angle theta, relative
+! to the given origin point.
+
+subroutine rotate(x, y, theta, x0, y0)
+ real(r8), intent(inout) :: x, y
+ real(r8), intent(in) :: theta
+ real(r8), intent(in) :: x0, y0
+
+real(r8) :: a(2), b(2)
+real(r8) :: r(2,2)
+real(r8) :: rads
+
+a(1) = x - x0
+a(2) = y - y0
+
+rads = theta * deg2rad
+
+r(1,1) = cos(rads)
+r(1,2) = sin(rads)
+r(2,1) = sin(-rads)
+r(2,2) = cos(rads)
+
+b(1) = r(1,1)*a(1) + r(1,2)*a(2)
+b(2) = r(2,1)*a(1) + r(2,2)*a(2)
+
+x = b(1) + x0
+y = b(2) + y0
+
+end subroutine rotate
+
+!------------------------------------------------------------
+! compute +/- a random value based on a width and percentage
+! of that width
+
+function deform(width, fraction, seq)
+
+use random_seq_mod
+
+ real(r8), intent(in) :: width
+ real(r8), intent(in) :: fraction
+ type(random_seq_type), intent(inout) :: seq
+ real(r8) :: deform
+
+real(r8) :: val
+
+! random val between -1 and 1
+val = (random_uniform(seq) * 2.0_r8) - 1.0_r8
+
+deform = val * width * fraction
+
+end function deform
+
+!------------------------------------------------------------
+
+subroutine writeit_1d(fname, nx, dataarray)
+
+use utilities_mod
+
+ character(len=*), intent(in) :: fname
+ integer, intent(in) :: nx
+ real(r8), intent(in) :: dataarray(:)
+
+integer :: i, j, iunit
+
+iunit = open_file(fname, action='write')
+
+do i=1, nx
+ write(iunit, *) dataarray(i)
+enddo
+
+call close_file(iunit)
+
+end subroutine writeit_1d
+
+!------------------------------------------------------------
+
+subroutine writeit_2d(fname, nx, ny, dataarray)
+
+use utilities_mod
+
+ character(len=*), intent(in) :: fname
+ integer, intent(in) :: nx, ny
+ real(r8), intent(in) :: dataarray(nx, ny)
+
+integer :: i, j, iunit
+
+iunit = open_file(fname, action='write')
+
+do i=1, nx
+ do j=1, ny
+ write(iunit, *) dataarray(i, j)
+ enddo
+enddo
+
+call close_file(iunit)
+
+end subroutine writeit_2d
+
+!------------------------------------------------------------
+
+end program test_quad_reg_interp
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/models/model_mod_tools/work/input.nml b/models/model_mod_tools/work/input.nml
new file mode 100644
index 0000000000..36caa186b4
--- /dev/null
+++ b/models/model_mod_tools/work/input.nml
@@ -0,0 +1,79 @@
+
+&state_vector_io_nml
+ buffer_state_io = .false.
+ single_precision_output = .false.
+ /
+
+&ensemble_manager_nml
+ layout = 2
+ tasks_per_node = 16
+ /
+
+&assim_tools_nml
+ filter_kind = 1,
+ cutoff = 0.15,
+ sort_obs_inc = .false.,
+ spread_restoration = .false.,
+ sampling_error_correction = .false.,
+ adaptive_localization_threshold = -1,
+ output_localization_diagnostics = .false.,
+ localization_diagnostics_file = 'localization_diagnostics',
+ print_every_nth_obs = 10000,
+ distribute_mean = .false.,
+ /
+
+&cov_cutoff_nml
+ select_localization = 1
+ /
+
+®_factor_nml
+ select_regression = 1,
+ input_reg_file = 'time_mean_reg'
+ save_reg_diagnostics = .false.
+ reg_diagnostics_file = 'reg_diagnostics'
+ /
+
+&obs_sequence_nml
+ write_binary_obs_sequence = .false.
+ /
+
+&quality_control_nml
+ input_qc_threshold = 3.0
+ outlier_threshold = 3.0
+ enable_special_outlier_code = .false.
+ /
+
+&location_nml
+ /
+
+&preprocess_nml
+ input_obs_kind_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90',
+ output_obs_kind_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90',
+ input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90',
+ output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90',
+ input_files = '../../../observations/forward_operators/obs_def_gps_mod.f90',
+ '../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90',
+ '../../../observations/forward_operators/obs_def_altimeter_mod.f90',
+ /
+
+&obs_kind_nml
+ /
+
+&utilities_nml
+ TERMLEVEL = 2
+ module_details = .false.
+ logfilename = 'dart_log.out'
+ nmlfilename = 'dart_log.nml'
+ /
+
+&mpi_utilities_nml
+ /
+
+&obs_def_gps_nml
+ max_gpsro_obs = 15000000
+ /
+
+&quad_interpolate_nml
+ debug = 0
+ /
+
diff --git a/models/model_mod_tools/work/mkmf_preprocess b/models/model_mod_tools/work/mkmf_preprocess
new file mode 100755
index 0000000000..5dc98fe480
--- /dev/null
+++ b/models/model_mod_tools/work/mkmf_preprocess
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id: mkmf_preprocess 11289 2017-03-10 21:56:06Z hendric@ucar.edu $
+
+../../../build_templates/mkmf -p preprocess -t ../../../build_templates/mkmf.template \
+ -a "../../.." path_names_preprocess
+
+exit $status
+
+#
+# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/models/cam-fv/work/mkmf_preprocess $
+# $Revision: 11289 $
+# $Date: 2017-03-10 14:56:06 -0700 (Fri, 10 Mar 2017) $
+
diff --git a/models/model_mod_tools/work/mkmf_test_quad_irreg_interp b/models/model_mod_tools/work/mkmf_test_quad_irreg_interp
new file mode 100755
index 0000000000..e94848c7f9
--- /dev/null
+++ b/models/model_mod_tools/work/mkmf_test_quad_irreg_interp
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id: mkmf_test_quad_irreg_interp 11289 2017-03-10 21:56:06Z hendric@ucar.edu $
+
+../../../build_templates/mkmf -p test_quad_irreg_interp -t ../../../build_templates/mkmf.template \
+ -a "../../.." path_names_test_quad_irreg_interp
+
+exit $status
+
+#
+# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/models/cam-fv/work/mkmf_test_quad_irreg_interp $
+# $Revision: 11289 $
+# $Date: 2017-03-10 14:56:06 -0700 (Fri, 10 Mar 2017) $
+
diff --git a/models/model_mod_tools/work/mkmf_test_quad_reg_interp b/models/model_mod_tools/work/mkmf_test_quad_reg_interp
new file mode 100755
index 0000000000..4ef7d962fa
--- /dev/null
+++ b/models/model_mod_tools/work/mkmf_test_quad_reg_interp
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id: mkmf_test_quad_reg_interp 11289 2017-03-10 21:56:06Z hendric@ucar.edu $
+
+../../../build_templates/mkmf -p test_quad_reg_interp -t ../../../build_templates/mkmf.template \
+ -a "../../.." path_names_test_quad_reg_interp
+
+exit $status
+
+#
+# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/models/cam-fv/work/mkmf_test_quad_irreg_interp $
+# $Revision: 11289 $
+# $Date: 2017-03-10 14:56:06 -0700 (Fri, 10 Mar 2017) $
+
diff --git a/models/model_mod_tools/work/path_names_preprocess b/models/model_mod_tools/work/path_names_preprocess
new file mode 100644
index 0000000000..ae8022dafe
--- /dev/null
+++ b/models/model_mod_tools/work/path_names_preprocess
@@ -0,0 +1,5 @@
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/preprocess/preprocess.f90
diff --git a/models/model_mod_tools/work/path_names_test_quad_irreg_interp b/models/model_mod_tools/work/path_names_test_quad_irreg_interp
new file mode 100644
index 0000000000..01f577ac8f
--- /dev/null
+++ b/models/model_mod_tools/work/path_names_test_quad_irreg_interp
@@ -0,0 +1,20 @@
+assimilation_code/location/threed_sphere/location_mod.f90
+assimilation_code/modules/assimilation/assim_model_mod.f90
+assimilation_code/modules/io/dart_time_io_mod.f90
+assimilation_code/modules/io/state_structure_mod.f90
+assimilation_code/modules/observations/obs_kind_mod.f90
+assimilation_code/modules/utilities/ensemble_manager_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/parse_args_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+models/model_mod_tools/test_quad_irreg_interp.f90
+models/template/model_mod.f90
+models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
+observations/forward_operators/obs_def_mod.f90
+observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/model_mod_tools/work/path_names_test_quad_reg_interp b/models/model_mod_tools/work/path_names_test_quad_reg_interp
new file mode 100644
index 0000000000..f502b6c4e2
--- /dev/null
+++ b/models/model_mod_tools/work/path_names_test_quad_reg_interp
@@ -0,0 +1,20 @@
+assimilation_code/location/threed_sphere/location_mod.f90
+assimilation_code/modules/assimilation/assim_model_mod.f90
+assimilation_code/modules/io/dart_time_io_mod.f90
+assimilation_code/modules/io/state_structure_mod.f90
+assimilation_code/modules/observations/obs_kind_mod.f90
+assimilation_code/modules/utilities/ensemble_manager_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/parse_args_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+models/model_mod_tools/test_quad_reg_interp.f90
+models/template/model_mod.f90
+models/utilities/default_model_mod.f90
+models/utilities/quad_utils_mod.f90
+observations/forward_operators/obs_def_mod.f90
+observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/model_mod_tools/work/quickbuild.csh b/models/model_mod_tools/work/quickbuild.csh
new file mode 100755
index 0000000000..41d29d1246
--- /dev/null
+++ b/models/model_mod_tools/work/quickbuild.csh
@@ -0,0 +1,186 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id: quickbuild.csh 11612 2017-05-08 22:18:42Z nancy@ucar.edu $
+
+#----------------------------------------------------------------------
+# compile all programs in the current directory that have a mkmf_xxx file.
+#
+# usage: [ -mpi | -nompi ]
+#
+#
+# environment variable options:
+# before running this script, do:
+# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
+# and these files are required by most debuggers.
+#----------------------------------------------------------------------
+
+# this model name:
+set BUILDING = "quad interpolate tests"
+
+# programs which have the option of building with MPI:
+set MPI_TARGETS = ""
+
+# set default (override with -mpi or -nompi):
+# 0 = build without MPI, 1 = build with MPI
+set with_mpi = 0
+
+
+# ---------------
+# shouldn't have to modify this script below here.
+
+if ( $#argv >= 1 ) then
+ if ( "$1" == "-mpi" ) then
+ set with_mpi = 1
+ else if ( "$1" == "-nompi" ) then
+ set with_mpi = 0
+ else
+ echo usage: $0 '[ -mpi | -nompi ]'
+ exit 0
+ endif
+endif
+
+set preprocess_done = 0
+set tdebug = 0
+set cdebug = 0
+
+if ( $?CODE_DEBUG ) then
+ set cdebug = $CODE_DEBUG
+endif
+if ( $?DART_TEST ) then
+ set tdebug = $DART_TEST
+endif
+
+\rm -f *.o *.mod Makefile .cppdefs
+
+#----------------------------------------------------------------------
+# Build any NetCDF files from .cdl files
+#----------------------------------------------------------------------
+
+@ n = 0
+
+@ has_cdl = `ls *.cdl | wc -l` >& /dev/null
+
+if ( $has_cdl > 0 ) then
+ foreach DATAFILE ( *.cdl )
+
+ set OUTNAME = `basename $DATAFILE .cdl`.nc
+
+ if ( ! -f $OUTNAME ) then
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
+ ncgen -o $OUTNAME $DATAFILE || exit $n
+ endif
+
+ end
+endif
+
+
+#----------------------------------------------------------------------
+# Build all the single-threaded targets
+#----------------------------------------------------------------------
+
+@ n = 0
+
+foreach TARGET ( mkmf_preprocess mkmf_* )
+
+ set PROG = `echo $TARGET | sed -e 's/mkmf_//'`
+
+ if ( $PROG == "preprocess" && $preprocess_done ) goto skip
+
+ if ( $with_mpi ) then
+ foreach i ( $MPI_TARGETS )
+ if ( $PROG == $i ) goto skip
+ end
+ endif
+
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "$BUILDING build number $n is $PROG"
+ \rm -f $PROG
+ csh $TARGET || exit $n
+ make || exit $n
+
+ if ( $tdebug ) then
+ echo 'removing all files between builds'
+ \rm -f *.o *.mod Makefile .cppdefs
+ endif
+
+ # preprocess creates module files that are required by
+ # the rest of the executables, so it must be run in addition
+ # to being built.
+ if ( $PROG == "preprocess" ) then
+ ./preprocess || exit $n
+ set preprocess_done = 1
+ endif
+
+skip:
+end
+
+if ( $cdebug ) then
+ echo 'preserving .o and .mod files for debugging'
+else
+ \rm -f *.o *.mod Makefile .cppdefs
+endif
+
+\rm -f input.nml*_default
+
+echo "Success: All single task DART programs compiled."
+
+if ( $with_mpi ) then
+ echo "Script now compiling MPI parallel versions of the DART programs."
+else
+ echo "Script is exiting after building the serial versions of the DART programs."
+ exit 0
+endif
+
+\rm -f *.o *.mod Makefile .cppdefs
+
+#----------------------------------------------------------------------
+# Build the MPI-enabled target(s)
+#----------------------------------------------------------------------
+
+foreach PROG ( $MPI_TARGETS )
+
+ set TARGET = `echo $PROG | sed -e 's/^/mkmf_/'`
+
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "$BUILDING with MPI build number $n is $PROG"
+ \rm -f $PROG
+ csh $TARGET -mpi || exit $n
+ make || exit $n
+
+ if ( $tdebug ) then
+ echo 'removing all files between builds'
+ \rm -f *.o *.mod Makefile .cppdefs
+ endif
+
+end
+
+if ( $cdebug ) then
+ echo 'preserving .o and .mod files for debugging'
+else
+ \rm -f *.o *.mod Makefile .cppdefs
+endif
+\rm -f input.nml*_default
+
+echo "Success: All MPI parallel DART programs compiled."
+
+exit 0
+
+#
+# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/models/cam-fv/work/quickbuild.csh $
+# $Revision: 11612 $
+# $Date: 2017-05-08 16:18:42 -0600 (Mon, 08 May 2017) $
+
diff --git a/models/mpas_atm/model_mod.f90 b/models/mpas_atm/model_mod.f90
index 3af2c43d80..9506ae7be1 100644
--- a/models/mpas_atm/model_mod.f90
+++ b/models/mpas_atm/model_mod.f90
@@ -41,12 +41,12 @@ module model_mod
use location_io_mod, only : nc_write_location_atts, nc_write_location
-use default_model_mod, only : nc_write_model_vars, init_time, init_conditions, &
- adv_1step
+use default_model_mod, only : nc_write_model_vars, adv_1step, &
+ init_time => fail_init_time, &
+ init_conditions => fail_init_conditions
-use xyz_location_mod, only : xyz_location_type, xyz_get_close_maxdist_init, &
- xyz_get_close_type, xyz_set_location, xyz_get_location, &
- xyz_get_close_obs_init, xyz_get_close_obs_destroy, &
+use xyz_location_mod, only : xyz_location_type, xyz_set_location, xyz_get_location, &
+ xyz_get_close_type, xyz_get_close_init, xyz_get_close_destroy, &
xyz_find_nearest
use utilities_mod, only : register_module, error_handler, &
@@ -83,7 +83,7 @@ module model_mod
QTY_GEOPOTENTIAL_HEIGHT, &
QTY_PRECIPITABLE_WATER
-use mpi_utilities_mod, only: my_task_id, all_reduce_min_max, task_count
+use mpi_utilities_mod, only: my_task_id, broadcast_minmax, task_count
use random_seq_mod, only: random_seq_type, init_random_seq, random_gaussian
@@ -1730,7 +1730,7 @@ subroutine pert_model_copies(ens_handle, ens_size, pert_amp, interf_provided)
enddo
! get global min/max for each variable
-call all_reduce_min_max(min_var, max_var, num_variables)
+call broadcast_minmax(min_var, max_var, num_variables)
deallocate(within_range)
call init_random_seq(random_seq, my_task_id()+1)
@@ -5767,10 +5767,8 @@ subroutine init_closest_center()
cell_locs(i) = xyz_set_location(lonCell(i), latCell(i), 0.0_r8, radius)
enddo
-! the width really isn't used anymore, but it's part of the
-! interface so we have to pass some number in.
-call xyz_get_close_maxdist_init(cc_gc, 1.0_r8)
-call xyz_get_close_obs_init(cc_gc, nCells, cell_locs)
+! get 2nd arg from max dcEdge or a namelist item where it's precomputed
+call xyz_get_close_init(cc_gc, 33000.0_r8, nCells, cell_locs)
end subroutine init_closest_center
@@ -5817,7 +5815,7 @@ subroutine finalize_closest_center()
! get rid of storage associated with GC for cell centers if
! they were used.
-if (search_initialized) call xyz_get_close_obs_destroy(cc_gc)
+if (search_initialized) call xyz_get_close_destroy(cc_gc)
end subroutine finalize_closest_center
diff --git a/models/mpas_atm/model_mod.html b/models/mpas_atm/model_mod.html
index cab4bccce8..9398ba143e 100644
--- a/models/mpas_atm/model_mod.html
+++ b/models/mpas_atm/model_mod.html
@@ -1,6 +1,5 @@
-
-
+
module model_mod (MPAS ATM)
@@ -116,9 +115,7 @@
The name of the MPAS analysis file to be read and/or written
by the DART programs for the state data.
-
grid_definition_filename
-
character(len=256)
- [default: 'mpas_init.nc']
-
The name of the MPAS file to be read
- by the DART programs for the grid information. Generally
- this is the same as the model_analysis_filename.
- However, the grid information is large and if the grid is static
- that information could be omitted from the analysis files to
- save space. A single grid file could be supplied once and
- not change during the assimilation run.
-
-
highest_obs_pressure_mb
real(r8) [default: 100.0]
@@ -182,17 +167,6 @@
NAMELIST
-
output_state_vector
-
logical [default: .false.]
-
The switch to determine the form of the state vector in the
- output netCDF files. If .true.
- the state vector will be output exactly as DART uses it;
- as one long array. If .false.,
- the state vector is parsed into prognostic variables and
- output that way -- much easier to use with 'ncview', for
- example. [Recommended]
-
-
assimilation_period_days
integer [default: 0]
The number of days to advance the model for each assimilation.
@@ -211,7 +185,7 @@
NAMELIST
vert_localization_coord
integer [default: 3]
-
Vertical coordinate for vertical localization.
+
Vertical coordinate for vertical localization.
1 = model level
2 = pressure (in pascals)
@@ -222,7 +196,7 @@
NAMELIST
sfc_elev_max_diff
real(r8)[default: -1.0]
-
If > 0, the maximum difference, in meters, between an observation marked
+
If > 0, the maximum difference, in meters, between an observation marked
as a 'surface obs' as the vertical type (with the surface elevation, in
meters, as the numerical vertical location), and the surface elevation as
defined by the model. Observations further away from the surface than this
@@ -427,10 +401,9 @@
nc_write_model_atts
-writes model-specific attributes to an opened netCDF file:
+writes model-specific attributes to a created netCDF file:
In the MPAS case, this includes information like the
coordinate variables (the grid arrays: lonCell, latCell, xCell, lonVertex, zgrid, etc.),
information from some of the namelists, and the variable attributes of either the 1D state
@@ -1187,8 +1159,8 @@
Required Interface Routines
ncFileID
Integer file descriptor to previously-opened netCDF file.
-
ierr
-
Returns a 0 for successful completion.
+
domainID
+
Integer descriptor specifying the domain whose metadata should be written.
-nc_write_model_vars
-writes a copy of the state variables to a NetCDF file. Multiple copies of the
-state for a given time are supported, allowing, for instance, a single file to
-include multiple ensemble estimates of the state. Whether the state vector is
-parsed into prognostic variables (potential temperature, dry density, vertical velocity, etc.) or simply written as a 1D array is controlled by
-input.nml&model_mod_nml:output_state_vector.
-If output_state_vector = .true. the state vector is
-written as a 1D array (the simplest case, but hard to explore with the diagnostics).
-If output_state_vector = .false. the state vector is
-parsed into prognostic variables before being written.
-
diff --git a/models/mpas_atm/mpas_dart_obs_preprocess.f90 b/models/mpas_atm/mpas_dart_obs_preprocess.f90
index 0b764c105b..aaea4edadd 100644
--- a/models/mpas_atm/mpas_dart_obs_preprocess.f90
+++ b/models/mpas_atm/mpas_dart_obs_preprocess.f90
@@ -34,7 +34,7 @@ program mpas_dart_obs_preprocess
use types_mod, only : r8, missing_r8, earth_radius, RAD2DEG, DEG2RAD, i8
use utilities_mod, only : error_handler, E_MSG, find_namelist_in_file, &
- check_namelist_read, nc_check
+ check_namelist_read
use time_manager_mod, only : time_type, operator(>=), operator(<), operator(>), operator(<=), &
increment_time, decrement_time, operator(-), operator(+), &
set_calendar_type, GREGORIAN, set_time, get_time
@@ -758,10 +758,10 @@ function isManLevel(plevel)
integer, parameter :: nman = 16
integer :: kk
logical :: isManLevel
-real (r8) raw_man_levels(nman) &
- / 100000.0_r8, 92500.0_r8, 85000.0_r8, 70000.0_r8, 50000.0_r8, 40000.0_r8, &
+real(r8) :: raw_man_levels(nman) = (/ 100000.0_r8, &
+ 92500.0_r8, 85000.0_r8, 70000.0_r8, 50000.0_r8, 40000.0_r8, &
30000.0_r8, 25000.0_r8, 20000.0_r8, 15000.0_r8, 10000.0_r8, 7000.0_r8, &
- 5000.0_r8, 3000.0_r8, 2000.0_r8, 1000.0_r8 /
+ 5000.0_r8, 3000.0_r8, 2000.0_r8, 1000.0_r8 /)
isManLevel = .false.
do kk = 1, nman
diff --git a/models/mpas_atm/work/input.nml b/models/mpas_atm/work/input.nml
index 0c499a48b5..377831dc91 100644
--- a/models/mpas_atm/work/input.nml
+++ b/models/mpas_atm/work/input.nml
@@ -46,6 +46,8 @@
num_output_obs_members = 96
output_interval = 1
num_groups = 1
+ distributed_state = .true.
+ compute_posterior = .true.
output_forward_op_errors = .false.
output_timestamps = .false.
trace_execution = .false.
@@ -168,10 +170,10 @@
&model_nml
model_analysis_filename = 'mpas_init.nc'
grid_definition_filename = 'mpas_init.nc'
+ vert_localization_coord = 3
assimilation_period_days = 0
assimilation_period_seconds = 43200
model_perturbation_amplitude = 0.0001
- vert_localization_coord = 3
calendar = 'Gregorian'
debug = 0
use_u_for_wind = .false.
diff --git a/models/mpas_atm/work/quickbuild.csh b/models/mpas_atm/work/quickbuild.csh
index c2bfdcce77..1786e1aca1 100755
--- a/models/mpas_atm/work/quickbuild.csh
+++ b/models/mpas_atm/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 1
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/mpas_ocn/work/quickbuild.csh b/models/mpas_ocn/work/quickbuild.csh
index b7db759f7e..db06969707 100755
--- a/models/mpas_ocn/work/quickbuild.csh
+++ b/models/mpas_ocn/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -63,10 +63,10 @@ end
\rm -f input.nml*_default
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
@@ -81,7 +81,7 @@ else
endif
#----------------------------------------------------------------------
-# to enable an MPI parallel version of filter for this model,
+# to enable an MPI parallel version of filter for this model,
# call this script with the -mpi argument, or if you are going to build
# with MPI all the time, remove or comment out the entire section above.
#----------------------------------------------------------------------
@@ -110,7 +110,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/noah/work/quickbuild.csh b/models/noah/work/quickbuild.csh
index f33d5a18d8..e0ba00f833 100755
--- a/models/noah/work/quickbuild.csh
+++ b/models/noah/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -58,13 +58,13 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
@@ -79,7 +79,7 @@ else
endif
#----------------------------------------------------------------------
-# to enable an MPI parallel version of filter for this model,
+# to enable an MPI parallel version of filter for this model,
# call this script with the -mpi argument, or if you are going to build
# with MPI all the time, remove or comment out the entire section above.
#----------------------------------------------------------------------
@@ -108,7 +108,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/null_model/work/input.nml b/models/null_model/work/input.nml
index 3736c37cee..9e5e94c837 100644
--- a/models/null_model/work/input.nml
+++ b/models/null_model/work/input.nml
@@ -1,36 +1,38 @@
&perfect_model_obs_nml
- read_input_state_from_file = .false.,
+ read_input_state_from_file = .true.,
single_file_in = .true.
input_state_files = "perfect_input.nc"
+ init_time_days = 0,
+ init_time_seconds = 0,
write_output_state_to_file = .true.,
single_file_out = .true.
output_state_files = "perfect_output.nc"
output_interval = 1,
- async = 0,
+ async = 0,
adv_ens_command = "./advance_model.csh",
obs_seq_in_file_name = "obs_seq.in",
obs_seq_out_file_name = "obs_seq.out",
- init_time_days = 0,
- init_time_seconds = 0,
- first_obs_days = -1,
- first_obs_seconds = -1,
- last_obs_days = -1,
- last_obs_seconds = -1,
-
- trace_execution = .false.,
+ first_obs_days = -1,
+ first_obs_seconds = -1,
+ last_obs_days = -1,
+ last_obs_seconds = -1,
+
+ trace_execution = .false.,
output_timestamps = .false.,
- print_every_nth_obs = -1,
+ print_every_nth_obs = -1,
output_forward_op_errors = .false.,
- silence = .false.,
+ silence = .false.,
/
&filter_nml
single_file_in = .true.,
input_state_files = 'filter_input.nc'
input_state_file_list = ''
+ init_time_days = 0,
+ init_time_seconds = 0,
stages_to_write = 'preassim', 'analysis', 'output'
@@ -55,9 +57,7 @@
obs_sequence_in_name = "obs_seq.out",
obs_sequence_out_name = "obs_seq.final",
- num_output_obs_members = 20,
- init_time_days = 0,
- init_time_seconds = 0,
+ num_output_obs_members = 20,
first_obs_days = -1,
first_obs_seconds = -1,
last_obs_days = -1,
@@ -81,15 +81,19 @@
silence = .false.,
/
-&smoother_nml
- num_lags = 0,
- start_from_restart = .false.,
- output_restart = .false.,
- restart_in_file_name = 'smoother_ics',
- restart_out_file_name = 'smoother_restart'
+&model_nml
+ model_size = 2,
+ delta_t = 0.05,
+ time_step_days = 0,
+ time_step_seconds = 3600
+ noise_amplitude = 0.0
+ advance_method = 'simple'
+ interpolation_method = 'standard'
/
-&ensemble_manager_nml
+&obs_kind_nml
+ assimilate_these_obs_types = 'RAW_STATE_VARIABLE'
+ evaluate_these_obs_types = ''
/
&assim_tools_nml
@@ -105,6 +109,11 @@
print_every_nth_obs = 0
/
+&quality_control_nml
+ input_qc_threshold = 3.0,
+ outlier_threshold = -1.0,
+ /
+
&cov_cutoff_nml
select_localization = 1
/
@@ -125,17 +134,6 @@
evaluate_these_obs_types = ''
/
-&model_nml
- model_size = 2,
- delta_t = 0.05,
- time_step_days = 0,
- time_step_seconds = 3600
- noise_amplitude = 0.0
- advance_method = 'simple'
- interpolation_method = 'rk'
- /
-
-
&utilities_nml
TERMLEVEL = 1,
module_details = .false.,
@@ -180,11 +178,22 @@
verbose = .false.
/
+&smoother_nml
+ /
+
&state_vector_io_nml
/
-&quality_control_nml
- input_qc_threshold = 3.0,
- outlier_threshold = -1.0,
-/
+&ensemble_manager_nml
+ /
+&model_mod_check_nml
+ verbose = .false.
+ test1thru = 5
+ x_ind = 3
+ kind_of_interest = 'QTY_RAW_STATE_VARIABLE'
+ loc_of_interest = 0.4
+ interp_test_xrange = 0.0, 1.0
+ interp_test_dx = 0.1
+ /
+
diff --git a/models/null_model/work/mkmf_perfect_model_obs b/models/null_model/work/mkmf_perfect_model_obs
index 115a465825..551b7098d4 100755
--- a/models/null_model/work/mkmf_perfect_model_obs
+++ b/models/null_model/work/mkmf_perfect_model_obs
@@ -5,9 +5,65 @@
# http://www.image.ucar.edu/DAReS/DART/DART_download
#
# DART $Id$
+#
+# usage: mkmf_perfect_model_obs [ -mpi | -nompi ]
+#
+# without any args, builds perfect_model_obs without mpi libraries, and it will run
+# as a normal executable. if -mpi is given, it will be compiled with the mpi
+# libraries and can run with multiple cooperating processes.
+
+if ( $#argv > 0 ) then
+ if ("$argv[1]" == "-mpi") then
+ setenv usingmpi 1
+ else if ("$argv[1]" == "-nompi") then
+ setenv usingmpi 0
+ else
+ echo "Unrecognized argument to mkmf_perfect_model_obs: $argv[1]"
+ echo "Usage: mkmf_perfect_model_obs [ -mpi | -nompi ]"
+ echo " default is to generate a Makefile without MPI support."
+ exit -1
+ endif
+else
+ setenv usingmpi 0
+endif
+
+
+# make a backup copy of the path_names file, and then use
+# sed to make sure it includes either the non-mpi subroutines,
+# or the subroutines which really call mpi.
+cp -f path_names_perfect_model_obs path_names_perfect_model_obs.back
+
+if ( $usingmpi ) then
+
+ echo "Making Makefile with MPI"
+ touch using_mpi_for_perfect_model_obs
+ sed -e 's#/null_mpi_util#/mpi_util#' \
+ -e 's#/null_win_mod#/no_cray_win_mod#' path_names_perfect_model_obs.back >! path_names_perfect_model_obs
+
+ setenv wrapper_arg -w
+
+else
+
+ echo "Making Makefile without MPI"
+ rm -f using_mpi_for_perfect_model_obs
+ sed -e 's#/mpi_util#/null_mpi_util#' \
+ -e '\#no_cray_win_mod.f90#d' \
+ -e '\#cray_win_mod.f90#d' path_names_perfect_model_obs.back >! path_names_perfect_model_obs
+
+ set p=`grep null_win_mod.f90 path_names_perfect_model_obs | wc -w`
+ if ( $p == 0) then
+ echo assimilation_code/modules/utilities/null_win_mod.f90 >> path_names_perfect_model_obs
+ endif
+
+ setenv wrapper_arg ""
+
+endif
+
+# remove temp file and now really call mkmf to generate makefile
+rm -f path_names_perfect_model_obs.back
../../../build_templates/mkmf -p perfect_model_obs -t ../../../build_templates/mkmf.template \
- -a "../../.." path_names_perfect_model_obs
+ -a "../../.." ${wrapper_arg} path_names_perfect_model_obs
exit $status
diff --git a/models/null_model/work/quickbuild.csh b/models/null_model/work/quickbuild.csh
index cb40ad0c94..49c490286c 100755
--- a/models/null_model/work/quickbuild.csh
+++ b/models/null_model/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/pe2lyr/work/quickbuild.csh b/models/pe2lyr/work/quickbuild.csh
index 51febb73a7..74f7fe2318 100755
--- a/models/pe2lyr/work/quickbuild.csh
+++ b/models/pe2lyr/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -58,13 +58,13 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
@@ -79,7 +79,7 @@ else
endif
#----------------------------------------------------------------------
-# to enable an MPI parallel version of filter for this model,
+# to enable an MPI parallel version of filter for this model,
# call this script with the -mpi argument, or if you are going to build
# with MPI all the time, remove or comment out the entire section above.
#----------------------------------------------------------------------
@@ -108,7 +108,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/rose/work/quickbuild.csh b/models/rose/work/quickbuild.csh
index 2810aed791..960d76c1d0 100755
--- a/models/rose/work/quickbuild.csh
+++ b/models/rose/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -64,7 +64,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -72,18 +72,18 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -92,7 +92,7 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
@@ -121,7 +121,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/buildall.csh b/models/run_tests.csh
similarity index 55%
rename from models/buildall.csh
rename to models/run_tests.csh
index 9e2d782576..bcfe6f9775 100755
--- a/models/buildall.csh
+++ b/models/run_tests.csh
@@ -7,39 +7,52 @@
# DART $Id$
#
# build and test all the models given in the list.
-# usage: [ -mpi | -nompi | -default ]
+#
+# usage: [ -mpi | -nompi ] [ -mpicmd name_of_mpi_launch_command ]
#
#----------------------------------------------------------------------
set usingmpi=no
+set MPICMD=""
+set LOGDIR=`pwd`/testing_logs
if ( $#argv > 0 ) then
if ( "$argv[1]" == "-mpi" ) then
set usingmpi=yes
- else if ( "$argv[1]" == "-default" ) then
- set usingmpi=default
else if ( "$argv[1]" == "-nompi" ) then
set usingmpi=no
else
echo "Unrecognized argument to $0: $argv[1]"
- echo "Usage: $0 [ -mpi | -nompi | -default ]"
+ echo "Usage: $0 [ -mpi | -nompi ] [ -mpicmd name_of_mpi_launch_command ]"
echo " default is to run tests without MPI"
exit -1
endif
+ shift
endif
-# set the environment variable MPI to anything in order to enable the
-# MPI builds and tests. set the argument to the build scripts so it
-# knows which ones to build.
+if ( $#argv > 1 ) then
+ if ( "$argv[1]" == "-mpicmd" ) then
+ set MPICMD = "$argv[2]"
+ else
+ echo "Unrecognized argument to $0: $argv[1]"
+ echo "Usage: $0 [ -mpi | -nompi ] [ -mpicmd name_of_mpi_launch_command ]"
+ echo " default is to run tests without MPI"
+ exit -1
+ endif
+ shift
+endif
+
+# set the quickbuild argument
if ( "$usingmpi" == "yes" ) then
- echo "Will be building with MPI enabled"
+ echo "Building with MPI support."
set QUICKBUILD_ARG='-mpi'
-else if ( "$usingmpi" == "default" ) then
- echo "Will be building with the default MPI settings"
- set QUICKBUILD_ARG=''
+ if ( ! $?MPICMD) then
+ set MPICMD='mpirun -n 2'
+ endif
else if ( "$usingmpi" == "no" ) then
- echo "Will NOT be building with MPI enabled"
+ echo "Building WITHOUT MPI support."
set QUICKBUILD_ARG='-nompi'
+ set MPICMD=""
else
echo "Internal error: unrecognized value of usingmpi; should not happen"
exit -1
@@ -50,6 +63,15 @@ endif
if ( ! $?REMOVE) then
setenv REMOVE 'rm -f'
endif
+if ( ! $?REMOVE_DIR) then
+ setenv REMOVE_DIR 'rmdir'
+endif
+if ( ! $?COPY) then
+ setenv COPY 'cp -f'
+endif
+if ( ! $?MOVE) then
+ setenv MOVE 'mv -f'
+endif
if ( ! $?host) then
setenv host `uname -n`
@@ -86,83 +108,62 @@ set DO_THESE_MODELS = ( \
wrf \
)
-# needed soon: null_model
-
-#----------------------------------------------------------------------
-# Compile all executables for each model.
#----------------------------------------------------------------------
+# either run the workshop setup or quickbuild/run then clean
+#---------------------------------------------------------------------
-@ modelnum = 1
-
-foreach MODEL ( $DO_THESE_MODELS )
-
- echo
- echo
- echo "=================================================================="
- echo "=================================================================="
- echo "Compiling $MODEL starting at "`date`
- echo "=================================================================="
- echo "=================================================================="
- echo
- echo
-
- cd ${modeldir}/${MODEL}/work
- set FAILURE = 0
-
- ./quickbuild.csh ${QUICKBUILD_ARG} || set FAILURE = 1
-
- @ modelnum = $modelnum + 1
-
- echo
- echo
- echo "=================================================================="
- echo "=================================================================="
- if ( $FAILURE ) then
- echo "ERROR - unsuccessful build of $MODEL at "`date`
- else
- echo "End of successful build of $MODEL at "`date`
- endif
- echo "=================================================================="
- echo "=================================================================="
- echo
- echo
-
-end
+echo
+echo
+echo "=================================================================="
+echo "Starting tests of model directory at "`date`
+echo "=================================================================="
+echo
+echo
-#----------------------------------------------------------------------
-# Run PMO and filter if possible. Save and restore the original input.nml.
-#----------------------------------------------------------------------
+${REMOVE} ${LOGDIR}/buildlog.*.out ${LOGDIR}/runlog.*.out
+mkdir -p ${LOGDIR}
+echo putting build and run logs in $LOGDIR
-@ modelnum = 1
+@ modelnum = 0
foreach MODEL ( $DO_THESE_MODELS )
- if ($MODEL == 'bgrid_solo') then
- echo 'skipping bgrid run for now'
- continue
- endif
-
echo
echo
echo "=================================================================="
- echo "=================================================================="
echo "Testing $MODEL starting at "`date`
echo "=================================================================="
- echo "=================================================================="
echo
echo
cd ${modeldir}/${MODEL}/work
set FAILURE = 0
+ echo "Current directory is " `pwd`
@ ncdlfiles = `ls *.cdl | wc -l`
+ if ( "$MODEL" == "template" ) then
+ echo skipping tests of the template directory
+ continue
+ endif
+
+ # save original input.nml & obs seq files here
+ set SAVEDIR = saveme.test_dart
+ mkdir -p ${SAVEDIR}
+ ${COPY} input.nml obs_seq.* ${SAVEDIR}
+
if ( -f workshop_setup.csh ) then
+
echo "Trying to run workshop_setup.csh for model $MODEL as a test"
- ./workshop_setup.csh || set FAILURE = 1
+ ( ./workshop_setup.csh > ${LOGDIR}/buildlog.${MODEL}.out ) || set FAILURE = 1
echo "Re-running workshop_setup.csh to test overwriting files for model $MODEL"
- ./workshop_setup.csh || set FAILURE = 1
+ ( ./workshop_setup.csh >> ${LOGDIR}/buildlog.${MODEL}.out ) || set FAILURE = 1
+
else
+ echo building executables for $MODEL
+
+ ( ./quickbuild.csh ${QUICKBUILD_ARG} > ${LOGDIR}/buildlog.${MODEL}.out ) || set FAILURE = 1
+
echo "Trying to run pmo for model $MODEL as a test"
echo "Will generate NetCDF files from any .cdl files first."
# try not to error out if no .cdl files found
@@ -173,40 +174,48 @@ foreach MODEL ( $DO_THESE_MODELS )
ncgen -o ${base}.nc $i
end
endif
- # assumes the executables from the first pass are still here
- ./perfect_model_obs || set FAILURE = 1
- echo "Rerunning PMO to test for file overwrite"
- ./perfect_model_obs || set FAILURE = 1
+ # assumes the executables from quickbuild are here
+ ( $MPICMD ./perfect_model_obs > ${LOGDIR}/runlog.${MODEL}.out ) || set FAILURE = 1
+ echo "Rerunning PMO to test for output file overwrite"
+ ( $MPICMD ./perfect_model_obs >> ${LOGDIR}/runlog.${MODEL}.out ) || set FAILURE = 1
+ # FIXME: if possible, try running filter here as well?
endif
- echo "Removing the newly-built objects and restoring original input.nml"
+ if ( -f model_mod_check ) then
+ echo "Trying to run model_mod_check for model $MODEL as a test"
+ ( $MPICMD ./model_mod_check >> ${LOGDIR}/runlog.${MODEL}.out ) || set FAILURE = 1
+ endif
+
+ echo "Removing the newly-built objects and executables"
${REMOVE} *.o *.mod
${REMOVE} Makefile input.nml.*_default .cppdefs
foreach TARGET ( mkmf_* )
set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
${REMOVE} $PROG
end
+
+ echo "Restoring original input.nml and obs_seq files"
+ ${MOVE} ${SAVEDIR}/* .
+ ${REMOVE_DIR} ${SAVEDIR}
+
if ( $ncdlfiles > 0 ) then
foreach i ( *.cdl )
set base = `basename $i .cdl`
if ( -f ${base}.nc ) rm ${base}.nc
end
endif
- svn revert input.nml obs_seq.*
@ modelnum = $modelnum + 1
echo
echo
echo "=================================================================="
- echo "=================================================================="
if ( $FAILURE ) then
echo "ERROR - unsuccessful test of $MODEL at "`date`
else
echo "End of succesful test of $MODEL at "`date`
endif
echo "=================================================================="
- echo "=================================================================="
echo
echo
@@ -216,6 +225,13 @@ echo
echo $modelnum models tested.
echo
+echo
+echo
+echo "=================================================================="
+echo "Ending tests of model directory at "`date`
+echo "=================================================================="
+echo
+echo
exit 0
#
diff --git a/models/simple_advection/model_mod.f90 b/models/simple_advection/model_mod.f90
index b505d928d8..c270ed2cba 100644
--- a/models/simple_advection/model_mod.f90
+++ b/models/simple_advection/model_mod.f90
@@ -4,6 +4,48 @@
!
! $Id$
+!> @brief Simple Advection model
+!>
+!> This model is on a periodic one-dimensional domain. A wind field is
+!> modeled using Burger's Equation with an upstream semi-lagrangian
+!> differencing. This diffusive numerical scheme is stable and forcing
+!> is provided by adding in random gaussian noise to each wind grid
+!> variable independently at each timestep. The domain mean value of the
+!> wind is relaxed to a constant fixed value set by the namelist parameter
+!> mean_wind. The random forcing magnitude is set by namelist parameter
+!> wind_random_amp and the damping of the mean wind is controlled by
+!> parameter wind_damping_rate. An Eulerian option with centered in
+!> space differencing is also provided and can be used by setting namelist
+!> parameter lagrangian_for_wind to .false. The Eulerian differencing is
+!> both numerically unstable and subject to shock formation. However, it
+!> can sometimes be made stable in assimilation mode (see recent work by
+!> Majda and collaborators).
+!>
+!> The model state includes a single passive tracer that is advected by
+!> the wind field using semi-lagrangian upstream differencing. The state
+!> also includes a tracer source value at each gridpoint. At each time
+!> step, the source is added into the concentration at each gridpoint.
+!> There is also a constant global destruction of tracer that is controlled
+!> by the namelist parameter destruction_rate. The appropriate percentage
+!> of tracer is destroyed at each gridpoint at each timestep.
+!>
+!> The model also includes an associated model for the tracer source rate.
+!> At each gridpoint, there is a value of the time mean source rate and
+!> a value of the phase offset for a diurnal component of the source rate.
+!> The diurnal source rate has an amplitude that is proportional to the
+!> source rate (this proportion is controlled by namelist parameter
+!> source_diurnal_rel_amp). At each grid point, the source is the sum
+!> of the source rate plus the appropriate diurnally varying component.
+!> The phase_offset at the gridpoint controls the diurnal phase. The
+!> namelist parameter source_phase_noise controls the amplitude of
+!> random gaussian noise that is added into the source phase at each
+!> time step. If source_phase_noise is zero then the phase offset is
+!> fixed. Finally, the time mean source rate is constant in time in the
+!> present model version. The time mean source rate controls the
+!> amplitude of the diurnal cycle of the tracer source.
+!>
+!>
+
module model_mod
use types_mod, only : r8, PI, i4, i8
@@ -15,6 +57,8 @@ module model_mod
check_namelist_read, do_output, &
do_nml_file, do_nml_term
+use mpi_utilities_mod, only : sum_across_tasks, my_task_id
+
use location_mod, only : location_type, set_location, get_location, &
get_close_obs, get_close_state, &
convert_vertical_obs, convert_vertical_state
@@ -29,13 +73,13 @@ module model_mod
use default_model_mod, only : end_model, nc_write_model_vars, init_time
use obs_kind_mod, only : QTY_VELOCITY, QTY_TRACER_CONCENTRATION, &
- QTY_TRACER_SOURCE, QTY_MEAN_SOURCE, QTY_SOURCE_PHASE
+ QTY_TRACER_SOURCE, QTY_MEAN_SOURCE, QTY_SOURCE_PHASE, &
+ get_name_for_quantity
use random_seq_mod, only : random_seq_type, init_random_seq, random_gaussian
-use ensemble_manager_mod, only : ensemble_type, get_allow_transpose, &
- all_vars_to_all_copies, all_copies_to_all_vars, &
- init_ensemble_manager, end_ensemble_manager
+use ensemble_manager_mod, only : ensemble_type, init_ensemble_manager, end_ensemble_manager, &
+ get_my_num_vars, get_my_vars
use distributed_state_mod, only : get_state
@@ -136,8 +180,18 @@ module model_mod
real(r8) :: source_diurnal_rel_amp = 0.05_r8
real(r8) :: source_phase_noise = 0.0_r8
+! if you change NVARS or the order of any of
+! these, you must change the 'add_domain()' call
+! in static_init_model() below.
integer, parameter :: NVARS = 5
-integer :: my_ens_size = 1
+integer, parameter :: CONC = 1
+integer, parameter :: TSOURCE = 2
+integer, parameter :: WIND = 3
+integer, parameter :: MEAN_SRC = 4
+integer, parameter :: SRC_PHASE = 5
+integer :: conc_offset, source_offset, wind_offset
+integer :: mean_src_offset, src_phase_offset
+integer :: model_size
namelist /model_nml/ num_grid_points, grid_spacing_meters, &
time_step_days, time_step_seconds, &
@@ -175,14 +229,17 @@ subroutine static_init_model()
if (do_nml_file()) write(nmlfileunit, nml=model_nml)
if (do_nml_term()) write( * , nml=model_nml)
+! NVARS items at each grid location
+model_size = NVARS * num_grid_points
+
! Create storage for locations
-allocate(state_loc(NVARS*num_grid_points))
+allocate(state_loc(model_size))
! Define the locations of the model state variables
do i = 1, num_grid_points
x_loc = (i - 1.0_r8) / num_grid_points
- do j = 0, NVARS - 1
- state_loc(num_grid_points * j + i) = set_location(x_loc)
+ do j = 1, NVARS
+ state_loc(num_grid_points * (j-1) + i) = set_location(x_loc)
enddo
enddo
@@ -217,7 +274,7 @@ subroutine static_init_model()
! For any routines that want to use the random number
! generator later on, initialize it.
if(.not. random_seq_init) then
- call init_random_seq(random_seq, 1)
+ call init_random_seq(random_seq, my_task_id()+1)
random_seq_init = .true.
endif
@@ -244,13 +301,22 @@ subroutine static_init_model()
do var_id=1, NVARS
call add_dimension_to_variable(dom_id, var_id, 'time', 1)
- call add_dimension_to_variable(dom_id, var_id, 'member', my_ens_size)
+ call add_dimension_to_variable(dom_id, var_id, 'member', 1)
call add_dimension_to_variable(dom_id, var_id, 'location', int(num_grid_points, i4))
enddo
call finished_adding_domain(dom_id)
endif
+! set the offsets to the start of each variable
+! in the state vector. the indices for each variable
+! quantity are x(offset+1 : offset+num_grid_points).
+
+conc_offset = (CONC-1) * num_grid_points
+source_offset = (TSOURCE-1) * num_grid_points
+wind_offset = (WIND-1) * num_grid_points
+mean_src_offset = (MEAN_SRC-1) * num_grid_points
+src_phase_offset = (SRC_PHASE-1) * num_grid_points
end subroutine static_init_model
@@ -265,20 +331,20 @@ subroutine init_conditions(x)
! Start by zeroing all
x = 0.0_r8
-! First set of variables is the concentration; Everybody starts at 0.0
-x(1:num_grid_points) = 0.0_r8
+! Tracer concentration
+x(conc_offset +1 : conc_offset +num_grid_points) = 0.0_r8
-! Set initial source to mean_source
-x(num_grid_points + 1 : 2*num_grid_points) = mean_source
+! Initial source
+x(source_offset +1 : source_offset +num_grid_points) = mean_source
-! Third set of variables is the u wind; its units are meters/second
-x(2*num_grid_points + 1: 3*num_grid_points) = mean_wind
+! U wind velocity; units are meters/second
+x(wind_offset +1 : wind_offset +num_grid_points) = mean_wind
-! Fourth set of variables is the time mean source
-x(3*num_grid_points + 1 : 4*num_grid_points) = mean_source
+! Time mean source
+x(mean_src_offset +1 : mean_src_offset +num_grid_points) = mean_source
-! Fifth set of variables is the source phase offset
-x(4*num_grid_points + 1 : 5*num_grid_points) = source_phase_offset
+! Source phase offset
+x(src_phase_offset+1 : src_phase_offset+num_grid_points) = source_phase_offset
end subroutine init_conditions
@@ -292,28 +358,27 @@ subroutine adv_1step(x, time)
real(r8), intent(inout) :: x(:)
type(time_type), intent(in) :: time
-integer :: next, prev, seconds, days, ens_size
+integer :: next, prev, seconds, days
+integer, parameter :: ens_size = 1
type(location_type) :: source_loc
real(r8) :: lctn, source_location, old_u_mean, new_u_mean
real(r8) :: du_dx, dt_seconds, t_phase, phase, random_src
type(ensemble_type) :: temp_handle
integer(i8) :: i
-integer :: istatus(1)
-real(r8) :: new_x(size(x),1)
+integer :: istatus(ens_size)
+real(r8) :: new_x(size(x),ens_size)
-!>@todo model_interpolate requires an ensemble handle as one of the
+!> model_interpolate requires an ensemble handle as one of the
!> parameters to the call. create a dummy one here.
-
-ens_size = 1
-call init_ensemble_manager(temp_handle, ens_size, int(NVARS*num_grid_points,i8))
-temp_handle%copies(1,:) = x(:)
+! the data in this handle is never used. the data passed in as
+! the final optional "x" argument is used instead.
+call init_ensemble_manager(temp_handle, ens_size, int(model_size,i8))
! State is concentrations (num_grid_points), source(num_grid_points), u(num_grid_points),
! mean_source(num_grid_points), and source_phase_offset(num_grid_points)
! all dimensioned num_grid_points.
-
! For the concentration do a linear interpolated upstream distance
! Also have an option to do upstream for wind (controlled by namelist; see below).
! Velocity is in meters/second. Need time_step in seconds
@@ -327,7 +392,7 @@ subroutine adv_1step(x, time)
! Find source point location: Velocity is in meters/second
! Figure out meters to move and then convert to fraction of domain
- source_location = lctn - x(2*num_grid_points + i) * dt_seconds / &
+ source_location = lctn - x(wind_offset + i) * dt_seconds / &
domain_width_meters
if(source_location > 1.0_r8) &
@@ -337,12 +402,12 @@ subroutine adv_1step(x, time)
source_location = source_location - int(source_location) + 1.0_r8
source_loc = set_location(source_location)
- call model_interpolate(temp_handle, ens_size, source_loc, QTY_TRACER_CONCENTRATION, new_x(i,:), istatus, x)
+ call model_interpolate(temp_handle, ens_size, source_loc, QTY_TRACER_CONCENTRATION, new_x(conc_offset + i,:), istatus, x)
! Following line does lagangian du
if(lagrangian_for_wind) &
- call model_interpolate(temp_handle, ens_size, source_loc, QTY_VELOCITY, new_x(2*num_grid_points + i,:), istatus, x)
+ call model_interpolate(temp_handle, ens_size, source_loc, QTY_VELOCITY, new_x(wind_offset + i,:), istatus, x)
enddo
@@ -355,10 +420,10 @@ subroutine adv_1step(x, time)
if(next > num_grid_points) next = 1
prev = i - 1
if(prev < 1) prev = num_grid_points
- du_dx = (x(2*num_grid_points + next) - x(2*num_grid_points + prev)) / &
+ du_dx = (x(wind_offset + next) - x(wind_offset + prev)) / &
(2.0_r8 * grid_spacing_meters)
- new_x(2*num_grid_points + i,1) = x(2*num_grid_points + i) + &
- x(2*num_grid_points + i) * du_dx * dt_seconds
+ new_x(wind_offset + i,1) = x(wind_offset + i) + &
+ x(wind_offset + i) * du_dx * dt_seconds
enddo
endif
!---- End Eulerian block
@@ -367,23 +432,23 @@ subroutine adv_1step(x, time)
! Now add in the source contribution and put concentration and wind back into inout x
! Source is in units of .../second
do i = 1, num_grid_points
- x(i) = new_x(i,1) + x(num_grid_points + i) * dt_seconds
+ x(conc_offset + i) = new_x(conc_offset + i,1) + x(source_offset + i) * dt_seconds
! Also copy over the new velocity
- x(2*num_grid_points + i) = new_x(2*num_grid_points + i,1)
+ x(wind_offset + i) = new_x(wind_offset + i,1)
enddo
! Now do the destruction rate: Units are fraction destroyed per second
do i = 1, num_grid_points
if(destruction_rate * dt_seconds > 1.0_r8) then
- x(i) = 0.0_r8
+ x(conc_offset + i) = 0.0_r8
else
- x(i) = x(i) * (1.0_r8 - destruction_rate*dt_seconds)
+ x(conc_offset + i) = x(conc_offset + i) * (1.0_r8 - destruction_rate*dt_seconds)
endif
enddo
!----- Following block is random walk plus damping to mean for wind
! Random walk for the spatial mean velocity
-old_u_mean = sum(x(2*num_grid_points + 1 : 3*num_grid_points)) / num_grid_points
+old_u_mean = sum(x(wind_offset + 1 : wind_offset + num_grid_points)) / num_grid_points
! Add in a random walk to the mean
new_u_mean = random_gaussian(random_seq, old_u_mean, wind_random_amp * dt_seconds)
@@ -394,13 +459,13 @@ subroutine adv_1step(x, time)
new_u_mean = new_u_mean - wind_damping_rate * dt_seconds * (new_u_mean - mean_wind)
! Substitute the new mean wind
-x(2*num_grid_points + 1 : 3*num_grid_points) = &
- x(2*num_grid_points + 1 : 3*num_grid_points) - old_u_mean + new_u_mean
+x(wind_offset + 1 : wind_offset + num_grid_points) = &
+ x(wind_offset + 1 : wind_offset + num_grid_points) - old_u_mean + new_u_mean
! Add some noise into each wind element
do i = 1, num_grid_points
- x(2*num_grid_points + i) = random_gaussian(random_seq, x(2*num_grid_points + i), &
- wind_random_amp * dt_seconds)
+ x(wind_offset + i) = random_gaussian(random_seq, x(wind_offset + i), &
+ wind_random_amp * dt_seconds)
enddo
!----- End forced damped wind section
@@ -411,19 +476,19 @@ subroutine adv_1step(x, time)
call get_time(time, seconds, days)
t_phase = (2.0_r8 * PI * seconds / 86400.0_r8)
do i = 1, num_grid_points
- phase = t_phase + x(4*num_grid_points + i)
- x(num_grid_points + i) = x(num_grid_points + i) &
- + x(3*num_grid_points + i) * source_diurnal_rel_amp * cos(phase)
- !!!+ x(3*num_grid_points + i) * source_diurnal_rel_amp * cos(phase) * dt_seconds
+ phase = t_phase + x(src_phase_offset + i)
+ x(source_offset + i) = x(source_offset + i) &
+ + x(mean_src_offset + i) * source_diurnal_rel_amp * cos(phase)
+ !!!+ x(mean_src_offset + i) * source_diurnal_rel_amp * cos(phase) * dt_seconds
! Also add in some random walk
random_src = random_gaussian(random_seq, 0.0_r8, source_random_amp(i))
- x(num_grid_points + i) = x(num_grid_points + i) + random_src * dt_seconds
- if(x(num_grid_points + i) < 0.0_r8) x(num_grid_points + i) = 0.0_r8
+ x(source_offset + i) = x(source_offset + i) + random_src * dt_seconds
+ if(x(source_offset + i) < 0.0_r8) x(source_offset + i) = 0.0_r8
! Finally, damp back towards the base value
! Need an error handler call here
if(source_damping_rate*dt_seconds > 1.0_r8) stop
- x(num_grid_points + i) = x(num_grid_points + i) - &
- source_damping_rate*dt_seconds * (x(num_grid_points + i) - x(3*num_grid_points + i))
+ x(source_offset + i) = x(source_offset + i) - &
+ source_damping_rate*dt_seconds * (x(source_offset + i) - x(mean_src_offset + i))
enddo
!----- End sources time tendency -----
@@ -433,7 +498,7 @@ subroutine adv_1step(x, time)
! Process noise test for source_phase_offset
do i = 1, num_grid_points
- x(4*num_grid_points + i) = random_gaussian(random_seq, x(4*num_grid_points + i), &
+ x(src_phase_offset + i) = random_gaussian(random_seq, x(src_phase_offset + i), &
source_phase_noise*dt_seconds)
enddo
@@ -450,7 +515,7 @@ function get_model_size()
integer(i8) :: get_model_size
-get_model_size = NVARS*num_grid_points
+get_model_size = model_size
end function get_model_size
@@ -467,12 +532,12 @@ end function get_model_size
!> If x is present, Interpolates from state vector x to the location.
!> This code supports three obs types: concentration, source, and u
-subroutine model_interpolate(state_handle, ens_size, location, itype, expected_val, istatus, x)
+subroutine model_interpolate(state_handle, ens_size, location, iqty, expected_val, istatus, x)
type(ensemble_type), intent(in) :: state_handle
integer, intent(in) :: ens_size
type(location_type), intent(in) :: location
-integer, intent(in) :: itype
+integer, intent(in) :: iqty
real(r8), intent(out) :: expected_val(ens_size)
integer, intent(out) :: istatus(ens_size)
real(r8), optional, intent(in) :: x(:) ! old format state vector, not distributed
@@ -498,14 +563,19 @@ subroutine model_interpolate(state_handle, ens_size, location, itype, expected_v
lctnfrac = lctn - int(lctn)
! Now figure out which type
-if(itype == QTY_TRACER_CONCENTRATION) then
- offset = 0
-else if(itype == QTY_TRACER_SOURCE) then
- offset = num_grid_points
-else if(itype == QTY_VELOCITY) then
- offset = 2*num_grid_points
+if(iqty == QTY_TRACER_CONCENTRATION) then
+ offset = conc_offset
+else if(iqty == QTY_TRACER_SOURCE) then
+ offset = source_offset
+else if(iqty == QTY_VELOCITY) then
+ offset = wind_offset
else
- write(string1, *) 'itype is not supported in model_interpolate', itype
+ ! technically this should just set istatus to a positive value and return
+ ! because it shouldn't be a fatal error to try to interpolate a quantity
+ ! that is not in the state vector. however for this model we only expect
+ ! to get observations of types in the state, so end the program if not.
+ write(string1, *) 'quantity ', iqty, ' ('//trim(get_name_for_quantity(iqty))// &
+ ') is not supported in model_interpolate'
call error_handler(E_ERR,'model_interpolate',string1, source, revision, revdate)
endif
@@ -542,31 +612,31 @@ end function shortest_time_between_assimilations
!------------------------------------------------------------------
!> Given an integer index into the state vector structure, returns the
-!> assoicated location and optionally the state quantity.
+!> associated location and optionally the state quantity.
-subroutine get_state_meta_data(index_in, location, var_type)
+subroutine get_state_meta_data(index_in, location, var_qty)
integer(i8), intent(in) :: index_in
type(location_type), intent(out) :: location
-integer, intent(out), optional :: var_type
-
-integer :: var_type_index, var_loc_index
-
-! Three variable types
-var_type_index = (index_in - 1) / num_grid_points + 1
-var_loc_index = index_in - (var_type_index - 1)*num_grid_points
-
-if(present(var_type)) then
- if(var_type_index == 1) then
- var_type = QTY_TRACER_CONCENTRATION
- else if(var_type_index == 2) then
- var_type = QTY_TRACER_SOURCE
- else if(var_type_index == 3) then
- var_type = QTY_VELOCITY
- else if(var_type_index == 4) then
- var_type = QTY_MEAN_SOURCE
- else if(var_type_index == 5) then
- var_type = QTY_SOURCE_PHASE
+integer, intent(out), optional :: var_qty
+
+integer :: var_qty_index, var_loc_index
+
+! Variable types
+var_qty_index = (index_in - 1) / num_grid_points + 1
+var_loc_index = index_in - (var_qty_index - 1)*num_grid_points
+
+if(present(var_qty)) then
+ if(var_qty_index == CONC) then
+ var_qty = QTY_TRACER_CONCENTRATION
+ else if(var_qty_index == TSOURCE) then
+ var_qty = QTY_TRACER_SOURCE
+ else if(var_qty_index == WIND) then
+ var_qty = QTY_VELOCITY
+ else if(var_qty_index == MEAN_SRC) then
+ var_qty = QTY_MEAN_SOURCE
+ else if(var_qty_index == SRC_PHASE) then
+ var_qty = QTY_SOURCE_PHASE
endif
endif
@@ -623,69 +693,113 @@ end subroutine nc_write_model_atts
!------------------------------------------------------------------
-!> Perturbs a model state for generating initial ensembles
-!> Returning interf_provided means go ahead and do this with uniform
-!> small independent perturbations.
+!> Perturbs a model state for generating initial ensembles.
+!> Returning interf_provided .true. means this code has
+!> added uniform small independent perturbations to a
+!> single ensemble member to generate the full ensemble.
subroutine pert_model_copies(state_ens_handle, ens_size, pert_amp, interf_provided)
type(ensemble_type), intent(inout) :: state_ens_handle
integer, intent(in) :: ens_size
-real(r8), intent(in) :: pert_amp
+real(r8), intent(in) :: pert_amp
logical, intent(out) :: interf_provided
-integer :: i,j
-real(r8) :: avg_wind
+integer :: i,j, num_my_grid_points, my_qty
+integer(i8), allocatable :: my_grid_points(:)
+real(r8) :: avg_wind, localsum
interf_provided = .true.
-! allocating storage space in ensemble manager
-if(.not. allocated(state_ens_handle%vars)) &
- allocate(state_ens_handle%vars(state_ens_handle%num_vars, state_ens_handle%my_num_copies))
-call all_copies_to_all_vars(state_ens_handle)
+! if we are running with more than 1 task, then
+! we have all the ensemble members for a subset of
+! the model state. which variables we have are determined
+! by looking at the global index number into the state vector.
-do i=1,num_grid_points
+! how many grid points does my task have to work on?
+! and what are their indices into the full state vector?
+num_my_grid_points = get_my_num_vars(state_ens_handle)
+allocate(my_grid_points(num_my_grid_points))
+call get_my_vars(state_ens_handle, my_grid_points)
- ! Perturb the tracer concentration
- do j=1,state_ens_handle%my_num_copies
- state_ens_handle%vars(i,j) = random_gaussian(random_seq, state_ens_handle%vars(i,j), state_ens_handle%vars(i,j))
- enddo
- where(state_ens_handle%vars(i,:) < 0.0_r8) state_ens_handle%vars(i,:) = 0.0_r8
-
- ! Perturb the source
- do j=1,state_ens_handle%my_num_copies
- state_ens_handle%vars(num_grid_points + i,j) = random_gaussian(random_seq, &
- state_ens_handle%vars(num_grid_points + i,j), &
- state_ens_handle%vars(num_grid_points + i,j))
- enddo
- where(state_ens_handle%vars(num_grid_points + i,:) < 0.0_r8) state_ens_handle%vars(num_grid_points + i,:) = 0.0_r8
+! we also want to compute the average wind field before we start.
+! find all the wind values on our task and then sum
+! them with wind values on other tasks.
- ! Perturb the u field
- do j=1,state_ens_handle%my_num_copies
-
- ! Find the average value of the wind field for the base
- avg_wind = sum(state_ens_handle%vars(2*num_grid_points + i:3*num_grid_points,j)) / num_grid_points
- ! Get a random draw to get
- state_ens_handle%vars(2*num_grid_points + i,j) = random_gaussian(random_seq, 0.05_r8, avg_wind)
- enddo
- where(state_ens_handle%vars(2*num_grid_points + i,:) < 0.0_r8) state_ens_handle%vars(2*num_grid_points + i,:) = 0.0_r8
+localsum = 0.0_r8
+do i=1,num_my_grid_points
+ ! Variable quantities
+ my_qty = (my_grid_points(i) - 1) / num_grid_points + 1
- ! NOT Perturbing the mean_source field
- ! OLD pert_state(3*num_grid_points + i) = random_gaussian(random_seq, state(3*num_grid_points + i), 0.2_r8)
- ! NEW state_ens_handle%vars(3*num_grid_points + i,j) = &
- ! random_gaussian(random_seq, state_ens_handle%vars(3*num_grid_points + i,j), 0.2_r8)
+ if(my_qty == WIND) then
+ localsum = localsum + state_ens_handle%copies(1, i)
+ endif
+enddo
+call sum_across_tasks(localsum, avg_wind)
+avg_wind = avg_wind / num_grid_points
+
+! and now we're ready to perturb the ensemble members
+! use the global index into the state vector to see what
+! quantities we have.
+do i=1,num_my_grid_points
+
+ ! Variable quantities
+ my_qty = (my_grid_points(i) - 1) / num_grid_points + 1
+
+ if(my_qty == CONC) then
+ ! Perturb the tracer concentration
+ do j=1,ens_size
+ state_ens_handle%copies(j, i) = random_gaussian(random_seq, &
+ state_ens_handle%copies(j, i), &
+ state_ens_handle%copies(j, i))
+ enddo
+ where(state_ens_handle%copies(1:ens_size, i) < 0.0_r8) &
+ state_ens_handle%copies(1:ens_size, i) = 0.0_r8
+
+ else if(my_qty == TSOURCE) then
+ ! Perturb the source
+ do j=1,ens_size
+ state_ens_handle%copies(j, i) = random_gaussian(random_seq, &
+ state_ens_handle%copies(j, i), &
+ state_ens_handle%copies(j, i))
+ enddo
+ where(state_ens_handle%copies(1:ens_size, i) < 0.0_r8) &
+ state_ens_handle%copies(1:ens_size, i) = 0.0_r8
+
+ else if(my_qty == WIND) then
+ ! Perturb the u field using the average wind computed above
+ do j=1,ens_size
+ state_ens_handle%copies(j, i) = random_gaussian(random_seq, 0.05_r8, avg_wind)
+ enddo
+ where(state_ens_handle%copies(1:ens_size, i) < 0.0_r8) &
+ state_ens_handle%copies(1:ens_size, i) = 0.0_r8
+
+ else if(my_qty == MEAN_SRC) then
+ ! NOT Perturbing the mean_source field.
+ ! comment in the following lines to perturb the source mean.
+ ! do j=1,ens_size
+ ! state_ens_handle%copies(j, i) = random_gaussian(random_seq, &
+ ! state_ens_handle%copies(j, i), 0.2_r8)
+ ! enddo
+
+ else if(my_qty == SRC_PHASE) then
+
+ ! NOT Perturbing the source_phase_offset field
+ ! even if commented in, only perturb if the mean_source is non-zero
+ ! if (state_ens_handle%copies(j, i) /= 0.0_r8) then
+ ! do j=1,ens_size
+ ! state_ens_handle%copies(j, i) = random_gaussian(random_seq, &
+ ! state_ens_handle%copies(j, i), 0.4_r8)
+ ! enddo
+ ! endif
- ! NOT Perturbing the source_phase_offset field ONLY if the mean_source is non-zero
- ! OLD if(mean_source(i) /= 0.0_r8) pert_state(4*num_grid_points + i) = &
- ! random_gaussian(random_seq, state(4*num_grid_points + i), 0.4_r8)
+ endif
enddo
-call all_vars_to_all_copies(state_ens_handle)
-! deallocate whole state storage
-if(.not. get_allow_transpose(state_ens_handle)) deallocate(state_ens_handle%vars)
+deallocate(my_grid_points)
end subroutine pert_model_copies
diff --git a/models/simple_advection/work/quickbuild.csh b/models/simple_advection/work/quickbuild.csh
index 1b37490cdd..c6eb86cb5f 100755
--- a/models/simple_advection/work/quickbuild.csh
+++ b/models/simple_advection/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@ set with_mpi = 0
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -56,7 +56,7 @@ if ( $?DART_TEST ) then
set tdebug = $DART_TEST
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -68,18 +68,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $BUILDING data file $n named $OUTNAME"
-
+ echo "constructing $BUILDING data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -105,14 +105,14 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING build number $n is $PROG"
+ echo "$BUILDING build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
# preprocess creates module files that are required by
@@ -126,15 +126,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -143,10 +143,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -156,26 +156,26 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$BUILDING with MPI build number $n is $PROG"
+ echo "$BUILDING with MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
if ( $tdebug ) then
echo 'removing all files between builds'
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/models/sqg/work/quickbuild.csh b/models/sqg/work/quickbuild.csh
index 69c217f3eb..ddebf633c8 100755
--- a/models/sqg/work/quickbuild.csh
+++ b/models/sqg/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -58,13 +58,13 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
@@ -79,7 +79,7 @@ else
endif
#----------------------------------------------------------------------
-# to enable an MPI parallel version of filter for this model,
+# to enable an MPI parallel version of filter for this model,
# call this script with the -mpi argument, or if you are going to build
# with MPI all the time, remove or comment out the entire section above.
#----------------------------------------------------------------------
@@ -108,7 +108,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/template/work/quickbuild.csh b/models/template/work/quickbuild.csh
index 1ee6f2a95a..07ef57782c 100755
--- a/models/template/work/quickbuild.csh
+++ b/models/template/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -58,13 +58,13 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
@@ -79,7 +79,7 @@ else
endif
#----------------------------------------------------------------------
-# to enable an MPI parallel version of filter for this model,
+# to enable an MPI parallel version of filter for this model,
# call this script with the -mpi argument, or if you are going to build
# with MPI all the time, remove or comment out the entire section above.
#----------------------------------------------------------------------
@@ -108,7 +108,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/tiegcm/work/input.nml b/models/tiegcm/work/input.nml
index 319c78baa5..5e6d8a50ee 100644
--- a/models/tiegcm/work/input.nml
+++ b/models/tiegcm/work/input.nml
@@ -43,6 +43,8 @@
num_groups = 1
input_qc_threshold = 3.0
outlier_threshold = 3.0
+ distributed_state = .true.
+ compute_posterior = .true.
output_forward_op_errors = .false.
output_timestamps = .false.
output_inflation = .true.
diff --git a/models/tiegcm/work/quickbuild.csh b/models/tiegcm/work/quickbuild.csh
index 9d5c1697f8..6ad6ab3c86 100755
--- a/models/tiegcm/work/quickbuild.csh
+++ b/models/tiegcm/work/quickbuild.csh
@@ -17,7 +17,7 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+\rm -f preprocess *.o *.mod Makefile .cppdefs
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -50,7 +50,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -58,18 +58,18 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
if ( $#argv == 1 && "$1" == "-mpi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
else if ( $#argv == 1 && "$1" == "-nompi" ) then
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script is exiting without building the MPI version of the DART programs."
exit 0
else
echo ""
- echo "Success: All single task DART programs compiled."
+ echo "Success: All single task DART programs compiled."
echo "Script now compiling MPI parallel versions of the DART programs."
echo "Run the quickbuild.csh script with a -nompi argument or"
echo "edit the quickbuild.csh script and add an exit line"
@@ -78,7 +78,7 @@ else
endif
#----------------------------------------------------------------------
-# to disable an MPI parallel version of filter for this model,
+# to disable an MPI parallel version of filter for this model,
# call this script with the -nompi argument, or if you are never going to
# build with MPI, add an exit before the entire section above.
#----------------------------------------------------------------------
@@ -107,7 +107,7 @@ echo "build number $n is mkmf_wakeup_filter"
csh mkmf_wakeup_filter -mpi
make || exit $n
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
echo
echo 'time to run filter here:'
diff --git a/models/utilities/default_model_mod.f90 b/models/utilities/default_model_mod.f90
index f8f7448f61..fdec7def6b 100644
--- a/models/utilities/default_model_mod.f90
+++ b/models/utilities/default_model_mod.f90
@@ -19,7 +19,9 @@ module default_model_mod
use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, nmlfileunit, &
do_output, find_namelist_in_file, check_namelist_read, &
- do_nml_file, do_nml_term, nc_check
+ do_nml_file, do_nml_term
+
+use netcdf_utilities_mod, only : nc_check
use ensemble_manager_mod, only : ensemble_type
@@ -79,7 +81,7 @@ end subroutine init_conditions
subroutine fail_init_conditions(x)
real(r8), intent(out) :: x(:)
-call error_handler(E_ERR, 'init_conditions', 'this model cannot start from scratch', &
+call error_handler(E_ERR, 'init_conditions', 'this model cannot provide initial conditions', &
source, revision, revdate)
! default
@@ -121,7 +123,7 @@ end subroutine init_time
subroutine fail_init_time(time)
type(time_type), intent(out) :: time
-call error_handler(E_ERR, 'init_time', 'this model cannot start from scratch', &
+call error_handler(E_ERR, 'init_time', 'this model cannot provide an initial time', &
source, revision, revdate)
time = set_time(0, 0)
diff --git a/models/utilities/quad_utils_mod.f90 b/models/utilities/quad_utils_mod.f90
new file mode 100644
index 0000000000..9a2e9715e3
--- /dev/null
+++ b/models/utilities/quad_utils_mod.f90
@@ -0,0 +1,2491 @@
+! 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
+!
+! DART $Id$
+
+!> Search and interpolation routines for grids which are logically rectangular
+!> but may have irregular spacings along each axis, or may be warped so that
+!> the corners of each grid location must be specified.
+!>
+!> This module includes the generic quad-location code, with required initialization,
+!> search, and finalization routines. It also includes interpolation within a quad
+!> where the inputs include the data values at the 4 corners of interest.
+!>
+!> There are a set of companion routines which understand the ensemble data type
+!> and the state vector data type, which calls the locate routine, then finds the
+!> ensemble-size arrays of data values at the quad corners and then calls the
+!> interpolation routines to get the final values. It also includes a vertical
+!> option if the two height indices are passed in. FIXME: what about different
+!> verts in different ens members? might need to be an ens_size array. also,
+!> might need to know which quad first, then build a height column, then do
+!> the interpolation. so maybe it can't be a completely generic interp routine
+!> but it could be a simple skeleton and call the same routines as much as possible.
+!>
+!> The basic flow is this ... create a coarse regular rectangular grid and create
+!> a list of (irregular) quads for each grid cell. We use that regular grid
+!> to quickly search the subset of quads. Any variable names with "reg_box"
+!> refers to the regular rectangular grid. Only _valid_ quads get put in
+!> the regular box list of quads (i.e. if one corner of a quad is masked,
+!> it is not a valid quad).
+
+module quad_utils_mod
+
+! This code will interpolate in a logically rectangular but deformed lat/lon grid.
+
+use types_mod, only : r8, i8, MISSING_R8, PI, deg2rad
+
+use location_mod, only : location_type, get_location
+
+use utilities_mod, only : register_module, error_handler, &
+ E_ERR, E_WARN, E_MSG, nmlfileunit, &
+ do_output, do_nml_file, do_nml_term, &
+ find_namelist_in_file, check_namelist_read, &
+ log_it, array_dump
+
+implicit none
+private
+
+public :: quad_interp_handle, & ! type - will need one for T grid, one for V grid
+ init_quad_interp, & ! pass in grid type and counts here
+ finalize_quad_interp, & ! release storage and reset vals
+ set_quad_coords, & ! overload these 3: set_reg_xx, set_1d_xx, set_2d_xx
+ quad_lon_lat_locate, & ! given lat,lon return above and below Is and Js
+ quad_lon_lat_evaluate, & !given i,j and all 4 corner values, return interp val
+ GRID_QUAD_FULLY_REGULAR, &
+ GRID_QUAD_IRREG_SPACED_REGULAR, &
+ GRID_QUAD_FULLY_IRREGULAR, &
+ GRID_QUAD_UNKNOWN_TYPE, &
+ QUAD_LOCATED_UNKNOWN, &
+ QUAD_LOCATED_CELL_CENTERS, &
+ QUAD_LOCATED_LON_EDGES, &
+ QUAD_LOCATED_LAT_EDGES, &
+ QUAD_LOCATED_CELL_CORNERS, &
+ get_quad_grid_size, &
+ get_quad_global, &
+ print_quad_handle ! debug
+
+
+! version controlled file description for error handling, do not edit
+character(len=*), parameter :: source = &
+ "$URL$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
+
+! message strings
+character(len=512) :: string1, string2, string3
+
+logical, save :: module_initialized = .false.
+
+integer :: debug = 0 ! turn up for more and more debug messages
+integer :: interpolation_type = 1 ! add cases for different strategies
+logical :: do_rotate = .false. ! rotate edge from pts 1,2 to horizontal before interp
+
+namelist /quad_interpolate_nml/ do_rotate, debug
+
+!> @todo FIXME internal routines should use h for the handle; externally callable
+!> routines should use interp_handle for clarity in the interface.
+
+! the grid must always be logically rectangular, so knowing the i and j of a
+! quad corner, the next quad starts at index i+1 and j+1.
+
+! 2d grid types:
+! can lats/lons be defined by giving only start, delta? type 1
+! are they each 1d arrays and the grid is defined by the cross product? type 2
+! are lat and lon both full 2d arrays, so completely irregular? type 3
+integer, parameter :: GRID_QUAD_FULLY_REGULAR = 1
+integer, parameter :: GRID_QUAD_IRREG_SPACED_REGULAR = 2
+integer, parameter :: GRID_QUAD_FULLY_IRREGULAR = 3
+integer, parameter :: GRID_QUAD_UNKNOWN_TYPE = -1
+
+! where the locations are relative to each grid cell
+integer, parameter :: QUAD_LOCATED_UNKNOWN = -1
+integer, parameter :: QUAD_LOCATED_CELL_CENTERS = 1
+integer, parameter :: QUAD_LOCATED_LON_EDGES = 2
+integer, parameter :: QUAD_LOCATED_LAT_EDGES = 3
+integer, parameter :: QUAD_LOCATED_CELL_CORNERS = 4
+
+! data struct question - does this go directly into handle?
+! right now it's in each option.
+type quad_grid_options
+ private
+
+ ! not sure if this is a good idea or not
+ ! if any part of the mask is false, fail to find the location.
+ logical :: uses_mask = .false.
+ logical, allocatable :: grid_mask(:,:)
+
+ ! global grid? if yes, both spans_lon_zero and pole_wrap are true as well.
+ ! if not, either or both could still be true but we can't assume.
+ logical :: global_grid = .false.
+
+ ! does the grid cross the 360 -> 0 boundary?
+ logical :: spans_lon_zero = .false. ! true if any lon(:,1) > lon(:,nlons)
+
+ ! do we handle wrap over the poles?
+ logical :: pole_wrap = .false.
+
+ ! i don't want to know this, but apparently we might
+ ! have to know if the points given are cell-centered or
+ ! on the edges. (god forbid we need to know U stagger vs V stagger!)
+ ! (for detecting if we are at the poles, for example)
+ integer :: cell_relative = QUAD_LOCATED_CELL_CENTERS
+ ! or should default be UNKNOWN, or CORNERS ?
+
+end type quad_grid_options
+
+
+! fully regular grid, evenly spaced and fully orthogonal
+type quad_reg_grid_coords
+ private
+
+ real(r8) :: lat_start = MISSING_R8
+ real(r8) :: lat_delta = MISSING_R8
+ real(r8) :: lon_start = MISSING_R8
+ real(r8) :: lon_delta = MISSING_R8
+
+end type quad_reg_grid_coords
+
+! fully orthorgonal but irregularly spaced along the axis
+type quad_irregspaced_grid_coords
+ private
+
+ real(r8), allocatable :: lats_1D(:)
+ real(r8), allocatable :: lons_1D(:)
+
+end type quad_irregspaced_grid_coords
+
+! logically rectangular but corners of quads are fully irregular
+type quad_irreg_grid_coords
+ private
+
+ ! These arrays store the longitude and latitude of the lower left corner of
+ ! each of the quadrilaterals and must be set by the user.
+
+ real(r8), allocatable :: lats_2D(:,:)
+ real(r8), allocatable :: lons_2D(:,:)
+
+ ! the sizes of these depend on the grid size. these are good defaults for ?
+ integer :: num_reg_x = 180
+ integer :: num_reg_y = 180
+ integer :: max_reg_list_num = 800
+ real(r8) :: min_lon = 0.0_r8
+ real(r8) :: max_lon = 360.0_r8
+ real(r8) :: lon_width = 360.0_r8
+ real(r8) :: min_lat = -90.0_r8
+ real(r8) :: max_lat = 90.0_r8
+ real(r8) :: lat_width = 180.0_r8
+
+ ! these next 2 should be allocated num_reg_x, num_reg_y
+ integer, allocatable :: grid_start(:,:)
+ integer, allocatable :: grid_num (:,:)
+ integer, allocatable :: grid_lon_list(:)
+ integer, allocatable :: grid_lat_list(:)
+ ! these replace u_dipole_xxx and t_dipole_xxx
+
+end type quad_irreg_grid_coords
+
+
+! public type -- derived type to hold search and interp info
+type quad_interp_handle
+ private
+
+ integer :: grid_type = GRID_QUAD_UNKNOWN_TYPE
+
+ integer :: nlat = -1 ! grid sizes in each dim
+ integer :: nlon = -1
+
+ ! which ones of these are allocated/used depends on the grid type
+
+ type(quad_reg_grid_coords) :: rr
+ type(quad_irregspaced_grid_coords) :: ir
+ type(quad_irreg_grid_coords) :: ii
+
+ type(quad_grid_options) :: opt
+
+end type quad_interp_handle
+
+interface quad_lon_lat_locate
+ module procedure quad_lon_lat_locate_ii
+ module procedure quad_lon_lat_locate_ir ! handles both ir and rr
+end interface
+
+interface quad_lon_lat_evaluate
+ module procedure quad_lon_lat_evaluate_ii_single
+ module procedure quad_lon_lat_evaluate_ii_array
+ module procedure quad_lon_lat_evaluate_ir_single ! handles both ir and rr
+ module procedure quad_lon_lat_evaluate_ir_array ! handles both ir and rr
+end interface
+
+interface set_quad_coords
+ module procedure set_reg_quad_coords
+ module procedure set_irregspaced_quad_coords
+ module procedure set_irreg_quad_coords
+end interface
+
+
+!------------------------------------------------
+
+! NOTE (dipole/tripole grids): since both of the dipole and tripole
+! grids are logically rectangular we can use the same interpolation
+! scheme originally implemented for the dipole grid. Here we can
+! interchange dipole and tripole when reading the code.
+
+! The regular grid used for dipole interpolation divides the sphere into
+! a set of regularly spaced lon-lat boxes. The number of boxes in
+! longitude and latitude are set by num_reg_x and num_reg_y. Making the
+! number of regular boxes smaller decreases the computation required for
+! doing each interpolation but increases the static storage requirements
+! and the initialization computation (which seems to be pretty small).
+! FIX ME: to account for various grid sizes we should dynamically
+! allocate these numbers. To keep max_reg_list_num < 100 we can use:
+! tx0.1v2 num_reg_x = num_reg_y = 900
+! tx0.5v1 num_reg_x = num_reg_y = 180
+! gx1v6 num_reg_x = num_reg_y = 90
+! Larger num_reg_(x,y) values require more temporary storage in
+! ureg_list_lon, ureg_list_lat, treg_list_lon, treg_list_lat. For now
+! we can use num_reg_(x,y) = 180 and max_reg_list_num = 800 to account
+! for all of the currently implemented grid types.
+!integer, parameter :: num_reg_x = 180, num_reg_y = 180
+
+! The max_reg_list_num controls the size of temporary storage used for
+! initializing the regular grid. Four arrays
+! of size num_reg_x*num_reg_y*max_reg_list_num are needed. The initialization
+! fails and returns an error if max_reg_list_num is too small. With 180 regular
+! lat lon boxes a value of 30 is sufficient for the gx3 POP grid, 80 for the
+! gx1 grid, 180 for the tx0.5 grid and 800 for the tx0.1 grid.
+! FIX ME: we should declare this at runtime depending on the grid size.
+!integer, parameter :: max_reg_list_num = 800
+
+! The dipole interpolation keeps a list of how many and which dipole quads
+! overlap each regular lon-lat box. The number for the u and t grids are
+! stored in u_dipole_num and t_dipole_num. The allocatable arrays
+! u_dipole_lon(lat)_list and t_dipole_lon(lat)_list list the longitude
+! and latitude indices for the overlapping dipole quads. The entry in
+! u_dipole_start and t_dipole_start for a given regular lon-lat box indicates
+! where the list of dipole quads begins in the u_dipole_lon(lat)_list and
+! t_dipole_lon(lat)_list arrays.
+
+! Need to check for pole quads: for now we are not interpolating in them
+integer :: pole_x, t_pole_y, u_pole_y
+
+! Have a global variable saying whether this is dipole or regular lon-lat grid
+! This should be initialized static_init_model. Code to do this is below.
+
+! FIXME: remove this - it becomes part of the interp handle
+!logical :: dipole_grid
+
+
+contains
+
+!------------------------------------------------------------------
+!------------------------------------------------------------------
+
+!> Called to do one time initialization of the module.
+
+subroutine initialize_module()
+
+integer :: iunit, io
+
+if (module_initialized) return
+
+module_initialized = .true.
+
+! Read the DART namelist for this model
+call find_namelist_in_file('input.nml', 'quad_interpolate_nml', iunit)
+read(iunit, nml = quad_interpolate_nml, iostat = io)
+call check_namelist_read(iunit, io, 'quad_interpolate_nml')
+
+if (do_nml_file()) write(nmlfileunit, nml=quad_interpolate_nml)
+if (do_nml_term()) write( * , nml=quad_interpolate_nml)
+
+end subroutine initialize_module
+
+!------------------------------------------------------------------
+
+!> initialize a grid handle with the grid type and the sizes of each axis.
+!> after this other routines are called based on the grid type to specify
+!> the actual lat/lon arrays.
+
+!>@todo FIXME cell_relative matters for poles and longitude wrap - should
+!> it be optional since regional areas not near 0 lon don't care? maybe it
+!> is better to be explicit and just say CELL_CENTERS is a good default.
+
+subroutine init_quad_interp(grid_type, num_lons, num_lats, cell_relative, &
+ global, spans_lon_zero, pole_wrap, interp_handle)
+
+integer, intent(in) :: grid_type
+integer, intent(in) :: num_lons
+integer, intent(in) :: num_lats
+integer, intent(in) :: cell_relative
+logical, intent(in) :: global, spans_lon_zero, pole_wrap
+type(quad_interp_handle), intent(out) :: interp_handle
+
+if (.not. module_initialized) call initialize_module()
+
+interp_handle%nlat = num_lats
+interp_handle%nlon = num_lons
+
+!>@todo : add sanity checking between global, spans_lon_zero, pole_wrap settings
+
+if (global) then
+ interp_handle%opt%global_grid = .true.
+ interp_handle%opt%spans_lon_zero = .true.
+ interp_handle%opt%pole_wrap = .true.
+else
+ if (spans_lon_zero) interp_handle%opt%spans_lon_zero = .true.
+ if (pole_wrap) interp_handle%opt%pole_wrap = .true.
+endif
+
+interp_handle%grid_type = grid_type
+
+select case (grid_type)
+ case(GRID_QUAD_FULLY_REGULAR)
+ ! nothing to do for this case
+
+ case(GRID_QUAD_IRREG_SPACED_REGULAR)
+ allocate(interp_handle%ir%lats_1D(num_lats), &
+ interp_handle%ir%lons_1D(num_lons))
+ interp_handle%ir%lats_1D(num_lats) = MISSING_R8
+ interp_handle%ir%lons_1D(num_lons) = MISSING_R8
+
+ case(GRID_QUAD_FULLY_IRREGULAR)
+ allocate(interp_handle%ii%lats_2D(num_lons, num_lats), &
+ interp_handle%ii%lons_2D(num_lons, num_lats))
+ interp_handle%ii%lats_2D(num_lons, num_lats) = MISSING_R8
+ interp_handle%ii%lons_2D(num_lons, num_lats) = MISSING_R8
+
+ ! tx0.1v2 num_reg_x = num_reg_y = 900
+ ! tx0.5v1 num_reg_x = num_reg_y = 180
+ ! gx1v6 num_reg_x = num_reg_y = 90
+ ! max_reg_list_num = 800
+
+ ! adjust num_regs here based on numlons, numlats
+ if (num_lats * num_lons > 6 * 1000 * 1000) then ! ~1/10th degree
+ interp_handle%ii%num_reg_x = 900
+ interp_handle%ii%num_reg_y = 900
+ interp_handle%ii%max_reg_list_num = 800 !>@todo what is good val?
+ if(debug > 10) then
+ write(string1, *) 'case 1: ', interp_handle%ii%num_reg_x, interp_handle%ii%num_reg_y, &
+ interp_handle%ii%max_reg_list_num
+ call log_it(string1)
+ endif
+
+ else if (num_lats * num_lons > 250 * 1000) then ! ~1/2th degree
+ interp_handle%ii%num_reg_x = 180
+ interp_handle%ii%num_reg_y = 180
+ interp_handle%ii%max_reg_list_num = 800
+ if(debug > 10) then
+ write(string1, *) 'case 2: ', interp_handle%ii%num_reg_x, interp_handle%ii%num_reg_y, &
+ interp_handle%ii%max_reg_list_num
+ call log_it(string1)
+ endif
+
+ else
+ interp_handle%ii%num_reg_x = 90
+ interp_handle%ii%num_reg_y = 90
+ interp_handle%ii%max_reg_list_num = 800
+ if(debug > 10) then
+ write(string1, *) 'case 3: ', interp_handle%ii%num_reg_x, interp_handle%ii%num_reg_y, &
+ interp_handle%ii%max_reg_list_num
+ call log_it(string1)
+ endif
+
+ endif
+
+ allocate(interp_handle%ii%grid_start(interp_handle%ii%num_reg_x, &
+ interp_handle%ii%num_reg_y))
+ allocate(interp_handle%ii%grid_num( interp_handle%ii%num_reg_x, &
+ interp_handle%ii%num_reg_y))
+
+ interp_handle%ii%grid_num = 0
+
+ case default
+ write(string1, *) 'unrecognized grid type: ', grid_type
+ write(string2, *) 'should be one of: GRID_QUAD_FULLY_REGULAR, ', &
+ 'GRID_QUAD_IRREG_SPACED_REGULAR, GRID_QUAD_FULLY_IRREGULAR'
+ call error_handler(E_ERR, 'init_quad_interp', string1, &
+ source, revision, revdate, text2=string2)
+
+end select
+
+select case (cell_relative)
+ case (QUAD_LOCATED_CELL_CENTERS, QUAD_LOCATED_LON_EDGES, QUAD_LOCATED_LAT_EDGES, &
+ QUAD_LOCATED_CELL_CORNERS)
+ interp_handle%opt%cell_relative = cell_relative
+
+ case default
+ write(string1, *) 'unrecognized cell_relative type: ', cell_relative
+ write(string2, *) 'should be one of: QUAD_LOCATED_CELL_CENTERS, ', &
+ 'QUAD_LOCATED_LON_EDGES, QUAD_LOCATED_LAT_EDGES, QUAD_LOCATED_CELL_CORNERS'
+ write(string3, *) 'important if handling poles and/or longitude wrap across prime meridian'
+ call error_handler(E_ERR, 'init_quad_interp', string1, &
+ source, revision, revdate, text2=string2, text3=string3)
+
+end select
+
+if (debug > 2) then
+ write(string1, *) 'calling init for nlons/nlats/type = ', num_lons, num_lats, grid_type
+ call log_it(string1)
+endif
+
+end subroutine init_quad_interp
+
+!------------------------------------------------------------------
+
+subroutine print_quad_handle(interp_handle)
+type(quad_interp_handle), intent(in) :: interp_handle
+
+if (debug > 10) then
+ write(string1, *) 'nlat, nlon, grid type: ', interp_handle%nlat, interp_handle%nlon, &
+ interp_handle%grid_type
+ call log_it(string1)
+endif
+
+select case (interp_handle%grid_type)
+ case(GRID_QUAD_FULLY_REGULAR)
+ call log_it('fully regular quad grid')
+ write(string1, *) 'lon start, delta, count: ', interp_handle%rr%lon_start, &
+ interp_handle%rr%lon_delta, interp_handle%nlon
+ call log_it(string1)
+ write(string1, *) 'lat start, delta, count: ', interp_handle%rr%lat_start, &
+ interp_handle%rr%lat_delta, interp_handle%nlat
+ call log_it(string1)
+
+ case(GRID_QUAD_IRREG_SPACED_REGULAR)
+ call log_it('irregularly spaced but orthogonal quad grid')
+ write(string1, *) 'nlons: ', interp_handle%nlon
+ call log_it(string1)
+ call array_dump(interp_handle%ir%lons_1D, label = 'lon values')
+ write(string1, *) 'nlats: ', interp_handle%nlat
+ call log_it(string1)
+ call array_dump(interp_handle%ir%lats_1D, label = 'lat values')
+
+ case(GRID_QUAD_FULLY_IRREGULAR)
+ call log_it('fully irregular quad grid')
+ write(string1, *) 'nlons: ', interp_handle%nlon
+ call log_it(string1)
+ call array_dump(interp_handle%ii%lons_2D, label = 'lon values')
+ write(string1, *) 'nlats: ', interp_handle%nlat
+ call log_it(string1)
+ call array_dump(interp_handle%ii%lats_2D, label = 'lat values')
+
+ case default
+ write(string1, *) 'unrecognized grid type: ', interp_handle%grid_type
+ write(string2, *) 'should be one of: GRID_QUAD_FULLY_REGULAR, '&
+ &'GRID_QUAD_IRREG_SPACED_REGULAR, GRID_QUAD_FULLY_IRREGULAR'
+ call error_handler(E_ERR, 'print_quad_handle', string1, &
+ source, revision, revdate, text2=string2)
+
+end select
+
+if (debug > 10) then
+ write(string1, *) 'cell relative flag: ', interp_handle%opt%cell_relative
+ call log_it(string1)
+endif
+
+end subroutine print_quad_handle
+
+!------------------------------------------------------------------
+
+subroutine finalize_quad_interp(interp_handle)
+
+type(quad_interp_handle), intent(inout) :: interp_handle
+
+! reset vals and deallocate storage
+
+!>@todo FIXME: make this call individual subtype destructors?
+
+interp_handle%nlat = -1
+interp_handle%nlon = -1
+
+interp_handle%grid_type = GRID_QUAD_UNKNOWN_TYPE
+
+if (allocated(interp_handle%ir%lats_1D)) deallocate(interp_handle%ir%lats_1D)
+if (allocated(interp_handle%ir%lons_1D)) deallocate(interp_handle%ir%lons_1D)
+
+if (allocated(interp_handle%ii%lats_2D)) deallocate(interp_handle%ii%lats_2D)
+if (allocated(interp_handle%ii%lons_2D)) deallocate(interp_handle%ii%lons_2D)
+if (allocated(interp_handle%ii%grid_start)) deallocate(interp_handle%ii%grid_start)
+if (allocated(interp_handle%ii%grid_num)) deallocate(interp_handle%ii%grid_num)
+if (allocated(interp_handle%ii%grid_lon_list)) deallocate(interp_handle%ii%grid_lon_list)
+if (allocated(interp_handle%ii%grid_lat_list)) deallocate(interp_handle%ii%grid_lat_list)
+
+interp_handle%opt%cell_relative = QUAD_LOCATED_UNKNOWN
+
+end subroutine finalize_quad_interp
+
+!------------------------------------------------------------
+
+subroutine set_reg_quad_coords(interp_handle, lon_start, lon_delta, &
+ lat_start, lat_delta)
+
+type(quad_interp_handle), intent(inout) :: interp_handle
+real(r8), intent(in) :: lon_start, lon_delta
+real(r8), intent(in) :: lat_start, lat_delta
+
+interp_handle%rr%lon_start = lon_start
+interp_handle%rr%lon_delta = lon_delta
+interp_handle%rr%lat_start = lat_start
+interp_handle%rr%lat_delta = lat_delta
+
+if (lon_delta == 0.0_r8 .or. lat_delta == 0.0_r8) then
+ write(string1, *) 'neither lon_delta nor lat_delta can equal 0'
+ write(string2, *) 'lon_delta: ', lon_delta, ' lat_delta: ', lat_delta
+ call error_handler(E_ERR, 'set_quad_coords', string1, &
+ source, revision, revdate, text2=string2)
+endif
+
+end subroutine set_reg_quad_coords
+
+!------------------------------------------------------------
+
+subroutine set_irregspaced_quad_coords(interp_handle, lons, lats)
+
+type(quad_interp_handle), intent(inout) :: interp_handle
+real(r8), intent(in) :: lons(:)
+real(r8), intent(in) :: lats(:)
+
+if (size(lons) /= interp_handle%nlon) then
+ write(string1, *) 'longitude count in handle: ', interp_handle%nlon, &
+ ' must match length of 1D lons array: ', size(lons)
+ call error_handler(E_ERR, 'set_irregspaced_quad_coords', string1, &
+ source, revision, revdate)
+endif
+
+if (size(lats) /= interp_handle%nlat) then
+ write(string1, *) 'latitude count in handle: ', interp_handle%nlat, &
+ ' must match length of 1D lats array: ', size(lats)
+ call error_handler(E_ERR, 'set_irregspaced_quad_coords', string1, &
+ source, revision, revdate)
+endif
+
+interp_handle%ir%lons_1D(:) = lons
+interp_handle%ir%lats_1D(:) = lats
+
+!>@todo FIXME i would like to put something like this to check
+!>for degenerate grids, but i don't know how to avoid throwing
+!>an error at the poles, for example. i'm leaving this here
+!>but commented out to remind me to try to add some way of
+!>catching bad values at init time.
+!do i=1, nlons-1
+! lon_delta = interp_handle%ir%lons_1d(i+1) - interp_handle%ir%lons_1d(i)
+! if (lon_delta == 0.0_r8) then
+! write(string1, *) 'no lon_deltas can equal 0'
+! write(string2, *) 'i, lons_1d(i), lons_1d(i+1): ', i, lons_1d(i), lons_1d(i+1)
+! call error_handler(E_ERR, 'set_quad_coords', string1, &
+! source, revision, revdate, text2=string2)
+! endif
+!enddo
+!do j=1, nlats-1
+! lat_delta = interp_handle%ir%lats_1d(j+1) - interp_handle%ir%lats_1d(j)
+! if (lat_delta == 0.0_r8) then
+! write(string1, *) 'no lat_deltas can equal 0'
+! wrjte(string2, *) 'j, lats_1d(j), lats_1d(j+1): ', j, lats_1d(j), lats_1d(j+1)
+! call error_handler(E_ERR, 'set_quad_coords', string1, &
+! source, revision, revdate, text2=string2)
+! endif
+!enddo
+
+end subroutine set_irregspaced_quad_coords
+
+!------------------------------------------------------------
+
+subroutine set_irreg_quad_coords(interp_handle, lons, lats, mask)
+
+type(quad_interp_handle), intent(inout) :: interp_handle
+real(r8), intent(in) :: lons(:,:)
+real(r8), intent(in) :: lats(:,:)
+logical, optional, intent(in) :: mask(:,:)
+
+integer :: gridsize(2)
+
+gridsize = shape(lons)
+call shapecheck(interp_handle, gridsize, 'longitude')
+
+gridsize = shape(lats)
+call shapecheck(interp_handle, gridsize, 'latitude')
+
+interp_handle%ii%lons_2D(:,:) = lons(:,:)
+interp_handle%ii%lats_2D(:,:) = lats(:,:)
+
+if (present(mask)) then
+ interp_handle%opt%uses_mask = .true.
+ gridsize = shape(mask)
+ call shapecheck(interp_handle, gridsize, 'mask')
+
+ allocate(interp_handle%opt%grid_mask(gridsize(1), gridsize(2)))
+ interp_handle%opt%grid_mask(:,:) = mask(:,:)
+endif
+
+! Initialize the interpolation routines
+call init_irreg_interp(interp_handle)
+
+end subroutine set_irreg_quad_coords
+
+!------------------------------------------------------------
+
+subroutine shapecheck(h, gridsize, name)
+
+type(quad_interp_handle), intent(in) :: h
+integer, intent(in) :: gridsize(2)
+character(len=*), intent(in) :: name
+
+if (gridsize(1) /= h%nlon .or. gridsize(2) /= h%nlat) then
+ write(string1, *) 'longitude/latitude counts in handle: ', h%nlon, h%nlat, &
+ ' must match shape of 2D '//trim(name)//' array: ', gridsize
+ call error_handler(E_ERR, 'shapecheck', string1, source, revision, revdate)
+endif
+
+end subroutine shapecheck
+
+!------------------------------------------------------------
+!> Build the data structure for interpolation for an irregular quad grid
+
+subroutine init_irreg_interp(h)
+
+type(quad_interp_handle), intent(inout) :: h
+
+character(len=*), parameter :: routine = 'init_irreg_interp'
+
+! Need a temporary data structure to build this.
+! These arrays keep a list of the x and y indices of dipole quads
+! that potentially overlap the regular boxes.
+integer, allocatable :: reg_list_lon(:,:,:)
+integer, allocatable :: reg_list_lat(:,:,:)
+
+real(r8) :: u_c_lons(4), u_c_lats(4), pole_row_lon
+integer :: i, j, k, pindex, nx, ny, nrx, nry, istatus
+integer :: reg_lon_ind(2), reg_lat_ind(2), u_total, u_index
+logical :: cyclic
+integer :: xlim
+
+allocate(reg_list_lon(h%ii%num_reg_x, h%ii%num_reg_y, h%ii%max_reg_list_num))
+allocate(reg_list_lat(h%ii%num_reg_x, h%ii%num_reg_y, h%ii%max_reg_list_num))
+
+! poles? span?
+cyclic = h%opt%spans_lon_zero
+nx = h%nlon
+ny = h%nlat
+nrx = h%ii%num_reg_x
+nry = h%ii%num_reg_y
+
+reg_list_lon(:, :, :) = 0
+reg_list_lat(:, :, :) = 0
+
+! for a global grid, the initial values have already been set in
+! the derived type. otherwise, find the min/max of lons and lats.
+if (.not. h%opt%global_grid) then
+ h%ii%min_lon = minval(h%ii%lons_2d)
+ h%ii%max_lon = maxval(h%ii%lons_2d)
+ h%ii%lon_width = h%ii%max_lon - h%ii%min_lon ! FIXME: wrap?
+
+ if (h%ii%lon_width < 0) then
+ if(h%opt%spans_lon_zero) then
+ h%ii%lon_width = h%ii%lon_width + 360.0_r8
+ else
+ write(string1,*)'min_lon, max_lon, lon_width, spans_lon_zero: ', &
+ h%ii%min_lon, h%ii%max_lon, h%ii%lon_width, h%opt%spans_lon_zero
+ call error_handler(E_ERR,routine,'regional grid with bad longitudes', &
+ source, revision, revdate, text2=string1)
+ endif
+ endif
+
+ h%ii%min_lat = minval(h%ii%lats_2d)
+ h%ii%max_lat = maxval(h%ii%lats_2d)
+ h%ii%lat_width = h%ii%max_lat - h%ii%min_lat
+endif
+
+if (cyclic) then
+ ! Begin by finding the quad that contains the pole for the dipole t_grid.
+ ! To do this locate the u quad with the pole on its right boundary. This is on
+ ! the row that is opposite the shifted pole and exactly follows a lon circle.
+ pole_x = nx / 2;
+ ! Search for the row at which the longitude flips over the pole
+ pole_row_lon = h%ii%lons_2d(pole_x, 1);
+ do i = 1, ny
+ pindex = i
+ if(h%ii%lons_2d(pole_x, i) /= pole_row_lon) exit
+ enddo
+
+ ! Pole boxes for u have indices pole_x or pole_x-1 and index - 1;
+ ! (it's right before the flip).
+ u_pole_y = pindex - 1;
+
+ ! Locate the T dipole quad that contains the pole.
+ ! We know it is in either the same lat quad as the u pole edge or one higher.
+ ! Figure out if the pole is more or less than halfway along
+ ! the u quad edge to find the right one.
+ if(h%ii%lats_2d(pole_x, u_pole_y) > h%ii%lats_2d(pole_x, u_pole_y + 1)) then
+ t_pole_y = u_pole_y;
+ else
+ t_pole_y = u_pole_y + 1;
+ endif
+endif
+
+! Loop through each of the dipole grid quads
+if (cyclic) then
+ xlim = nx
+else
+ xlim = nx - 1
+endif
+
+do i = 1, xlim
+ ! There's no wraparound in y, one box less than grid boundaries
+ do j = 1, ny - 1
+
+ if( all_corners_valid(h%opt, i,j, nx) ) then
+
+ !>@todo is istatus /= 0 a failure condition
+
+ ! Set up array of lons and lats for the corners of these u quads
+ call get_quad_corners(h%ii%lons_2d, i, j, cyclic, nx, ny, u_c_lons, istatus)
+ if (istatus /= 0) print *, 'get_quad_corners for lons returns failure'
+
+ call get_quad_corners(h%ii%lats_2d, i, j, cyclic, nx, ny, u_c_lats, istatus)
+ if (istatus /= 0) print *, 'get_quad_corners for lats returns failure'
+
+ !print *, 'get_quad_corners returns ', u_c_lons, u_c_lats, ' for ', &
+ ! h%ii%lons_2d(i,j), h%ii%lats_2d(i,j), ' index ', i, j
+
+ ! Get list of regular boxes that cover this u dipole quad
+ ! false indicates that for the u grid there's nothing special about pole
+ call reg_box_overlap(h, u_c_lons, u_c_lats, .false., reg_lon_ind, reg_lat_ind)
+ ! Update the temporary data structures for the u quad
+ call update_reg_list(h%ii%grid_num, reg_list_lon, reg_list_lat, &
+ reg_lon_ind, reg_lat_ind, nrx, nry, h%ii%max_reg_list_num, i, j)
+ endif
+
+ enddo
+enddo
+
+write(string1,*)'to determine (minimum) max_reg_list_num values for new grids ...'
+write(string2,*)'interp_handle%ii%grid_num is ',maxval(h%ii%grid_num)
+call error_handler(E_MSG, routine, string1, text2=string2)
+
+! Invert the temporary data structure. The total number of entries will be
+! the sum of the number of dipole cells for each regular cell.
+u_total = sum(h%ii%grid_num)
+
+! Allocate storage for the final structures in module storage
+allocate(h%ii%grid_lon_list(u_total), h%ii%grid_lat_list(u_total))
+
+! Fill up the long list by traversing the temporary structure. Need indices
+! to keep track of where to put the next entry.
+u_index = 1
+! Loop through each regular grid box
+do i = 1, h%ii%num_reg_x
+ do j = 1, h%ii%num_reg_y
+
+ ! The list for this regular box starts at the current indices.
+ h%ii%grid_start(i, j) = u_index
+
+ ! Copy all the close dipole quads for regular u box(i, j)
+ do k = 1, h%ii%grid_num(i, j)
+ h%ii%grid_lon_list(u_index) = reg_list_lon(i, j, k)
+ h%ii%grid_lat_list(u_index) = reg_list_lat(i, j, k)
+ u_index = u_index + 1
+ enddo
+
+ enddo
+enddo
+
+! Confirm that the indices come out okay as debug
+if(u_index /= u_total + 1) then
+ string1 = 'Storage indices did not balance for U grid: : contact DART developers'
+ call error_handler(E_ERR, routine, string1, source, revision, revdate)
+endif
+
+deallocate(reg_list_lon, reg_list_lat)
+
+end subroutine init_irreg_interp
+
+!------------------------------------------------------------
+
+!> @todo FIXME: this is the original code, for reference.
+!> the init_irreg_interp() routine above should replace it.
+
+!%! subroutine init_dipole_interp()
+!%!
+!%! ! Build the data structure for interpolation for a dipole grid.
+!%!
+!%! ! Need a temporary data structure to build this.
+!%! ! These arrays keep a list of the x and y indices of dipole quads
+!%! ! that potentially overlap the regular boxes. Need one for the u
+!%! ! and one for the t grid.
+!%! integer, allocatable :: ureg_list_lon(:,:,:)
+!%! integer, allocatable :: ureg_list_lat(:,:,:)
+!%! integer, allocatable :: treg_list_lon(:,:,:)
+!%! integer, allocatable :: treg_list_lat(:,:,:)
+!%!
+!%! real(r8) :: u_c_lons(4), u_c_lats(4), t_c_lons(4), t_c_lats(4), pole_row_lon
+!%! integer :: i, j, k, pindex
+!%! integer :: reg_lon_ind(2), reg_lat_ind(2), u_total, t_total, u_index, t_index
+!%! logical :: is_pole
+!%! integer :: surf_index
+!%!
+!%! allocate(ureg_list_lon(num_reg_x, num_reg_y, max_reg_list_num))
+!%! allocate(ureg_list_lat(num_reg_x, num_reg_y, max_reg_list_num))
+!%! allocate(treg_list_lon(num_reg_x, num_reg_y, max_reg_list_num))
+!%! allocate(treg_list_lat(num_reg_x, num_reg_y, max_reg_list_num))
+!%!
+!%! ! this is the level threshold for deciding whether we are over land
+!%! ! or water. to be valid all 4 corners of the quad must have a level
+!%! ! number greater than this index. (so 0 excludes all land points.)
+!%! ! if you wanted to assimilate only in regions where the water depth is
+!%! ! deeper than some threshold, set this index to N and only quads where
+!%! ! all the level numbers are N+1 or deeper will be used.
+!%! surf_index = 1
+!%!
+!%! ! Begin by finding the quad that contains the pole for the dipole t_grid.
+!%! ! To do this locate the u quad with the pole on its right boundary. This is on
+!%! ! the row that is opposite the shifted pole and exactly follows a lon circle.
+!%! pole_x = nx / 2;
+!%! ! Search for the row at which the longitude flips over the pole
+!%! pole_row_lon = ulon(pole_x, 1);
+!%! do i = 1, ny
+!%! pindex = i
+!%! if(ulon(pole_x, i) /= pole_row_lon) exit
+!%! enddo
+!%!
+!%! ! Pole boxes for u have indices pole_x or pole_x-1 and index - 1;
+!%! ! (it's right before the flip).
+!%! u_pole_y = pindex - 1;
+!%!
+!%! ! Locate the T dipole quad that contains the pole.
+!%! ! We know it is in either the same lat quad as the u pole edge or one higher.
+!%! ! Figure out if the pole is more or less than halfway along
+!%! ! the u quad edge to find the right one.
+!%! if(ulat(pole_x, u_pole_y) > ulat(pole_x, u_pole_y + 1)) then
+!%! t_pole_y = u_pole_y;
+!%! else
+!%! t_pole_y = u_pole_y + 1;
+!%! endif
+!%!
+!%! ! Loop through each of the dipole grid quads
+!%! do i = 1, nx
+!%! ! There's no wraparound in y, one box less than grid boundaries
+!%! do j = 1, ny - 1
+!%!
+!%! if( all_corners_valid(i,j) ) then
+!%! ! Set up array of lons and lats for the corners of these u quads
+!%! call get_quad_corners(ulon, i, j, cyclic, u_c_lons)
+!%! call get_quad_corners(ulat, i, j, cyclic, u_c_lats)
+!%!
+!%! ! Get list of regular boxes that cover this u dipole quad
+!%! ! false indicates that for the u grid there's nothing special about pole
+!%! call reg_box_overlap(u_c_lons, u_c_lats, .false., reg_lon_ind, reg_lat_ind)
+!%! ! Update the temporary data structures for the u quad
+!%! call update_reg_list(u_dipole_num, ureg_list_lon, &
+!%! ureg_list_lat, reg_lon_ind, reg_lat_ind, i, j)
+!%! endif
+!%!
+!%! ! Repeat for t dipole quads.
+!%! ! Only update regular boxes that contain all valid corners
+!%! if( all_corners_valid(i,j) ) then
+!%! ! Set up array of lons and lats for the corners of these t quads
+!%! call get_quad_corners(tlon, i, j, cyclic, t_c_lons)
+!%! call get_quad_corners(tlat, i, j, cyclic, t_c_lats)
+!%!
+!%! ! Is this the pole quad for the T grid?
+!%! is_pole = (i == pole_x .and. j == t_pole_y)
+!%!
+!%! call reg_box_overlap(t_c_lons, t_c_lats, is_pole, reg_lon_ind, reg_lat_ind)
+!%! call update_reg_list(t_dipole_num, treg_list_lon, &
+!%! treg_list_lat, reg_lon_ind, reg_lat_ind, i, j)
+!%! endif
+!%! enddo
+!%! enddo
+!%!
+!%! if (do_output()) write(*,*)'to determine (minimum) max_reg_list_num values for new grids ...'
+!%! if (do_output()) write(*,*)'u_dipole_num is ',maxval(u_dipole_num)
+!%! if (do_output()) write(*,*)'t_dipole_num is ',maxval(t_dipole_num)
+!%!
+!%! ! Invert the temporary data structure. The total number of entries will be
+!%! ! the sum of the number of dipole cells for each regular cell.
+!%! u_total = sum(u_dipole_num)
+!%! t_total = sum(t_dipole_num)
+!%!
+!%! ! Allocate storage for the final structures in module storage
+!%! allocate(u_dipole_lon_list(u_total), u_dipole_lat_list(u_total))
+!%! allocate(t_dipole_lon_list(t_total), t_dipole_lat_list(t_total))
+!%!
+!%! ! Fill up the long list by traversing the temporary structure. Need indices
+!%! ! to keep track of where to put the next entry.
+!%! u_index = 1
+!%! t_index = 1
+!%!
+!%! ! Loop through each regular grid box
+!%! do i = 1, num_reg_x
+!%! do j = 1, num_reg_y
+!%!
+!%! ! The list for this regular box starts at the current indices.
+!%! u_dipole_start(i, j) = u_index
+!%! t_dipole_start(i, j) = t_index
+!%!
+!%! ! Copy all the close dipole quads for regular u box(i, j)
+!%! do k = 1, u_dipole_num(i, j)
+!%! u_dipole_lon_list(u_index) = ureg_list_lon(i, j, k)
+!%! u_dipole_lat_list(u_index) = ureg_list_lat(i, j, k)
+!%! u_index = u_index + 1
+!%! enddo
+!%!
+!%! ! Copy all the close dipoles for regular t box (i, j)
+!%! do k = 1, t_dipole_num(i, j)
+!%! t_dipole_lon_list(t_index) = treg_list_lon(i, j, k)
+!%! t_dipole_lat_list(t_index) = treg_list_lat(i, j, k)
+!%! t_index = t_index + 1
+!%! enddo
+!%!
+!%! enddo
+!%! enddo
+!%!
+!%! ! Confirm that the indices come out okay as debug
+!%! if(u_index /= u_total + 1) then
+!%! string1 = 'Storage indices did not balance for U grid: : contact DART developers'
+!%! call error_handler(E_ERR, 'init_dipole_interp', string1, source, revision, revdate)
+!%! endif
+!%! if(t_index /= t_total + 1) then
+!%! string1 = 'Storage indices did not balance for T grid: : contact DART developers'
+!%! call error_handler(E_ERR, 'init_dipole_interp', string1, source, revision, revdate)
+!%! endif
+!%!
+!%! end subroutine init_dipole_interp
+
+!------------------------------------------------------------
+!>@todo FIXME if i'm doing this right, we shouldn't have
+!> to have this routine or the next one.
+
+subroutine get_quad_grid_size(interp_handle, nlon, nlat)
+
+type(quad_interp_handle), intent(in) :: interp_handle
+integer, intent(out) :: nlon, nlat
+
+nlon = interp_handle%nlon
+nlat = interp_handle%nlat
+
+end subroutine get_quad_grid_size
+
+!------------------------------------------------------------
+
+function get_quad_global(interp_handle)
+
+type(quad_interp_handle), intent(in) :: interp_handle
+logical :: get_quad_global
+
+get_quad_global = interp_handle%opt%global_grid
+
+end function get_quad_global
+
+!------------------------------------------------------------
+!> Given a longitude and latitude in degrees returns the index of the regular
+!> lon-lat box that contains the point. if this a global grid it cannot fail.
+!> if this is a regional grid, the given (lon,lat) might be outside of the region.
+!> if istatus=0, good return. istatus=1 bad box numbers.
+
+subroutine get_reg_box_indices(h, lon, lat, x_ind, y_ind, istatus)
+
+type(quad_interp_handle), intent(in) :: h
+real(r8), intent(in) :: lon, lat
+integer, intent(out) :: x_ind, y_ind
+integer, intent(out) :: istatus
+
+istatus = 0
+
+call get_reg_lon_box(h, lon, x_ind)
+call get_reg_lat_box(h, lat, y_ind)
+
+if ( (.not. get_quad_global(h)) .and. &
+ (x_ind < 1 .or. x_ind > h%ii%num_reg_x .or. &
+ y_ind < 1 .or. y_ind > h%ii%num_reg_y)) then
+ istatus = 1
+endif
+
+end subroutine get_reg_box_indices
+
+!------------------------------------------------------------
+!> Determine which regular longitude box contains the longitude of interest
+
+subroutine get_reg_lon_box(h, lon, x_ind)
+
+type(quad_interp_handle), intent(in) :: h
+real(r8), intent(in) :: lon
+integer, intent(out) :: x_ind
+
+!>@todo FIXME: IS THIS RIGHT?
+x_ind = int(h%ii%num_reg_x * (lon - h%ii%min_lon) / h%ii%lon_width) + 1
+!print *, 'get_reg_lon_box: ', h%ii%num_reg_x, lon, h%ii%min_lon, h%ii%lon_width, ((lon - h%ii%min_lon) / h%ii%lon_width), x_ind
+
+! Watch out for exactly at top; assume all lats and lons in legal range
+if(lon == h%ii%max_lon) x_ind = h%ii%num_reg_x
+
+end subroutine get_reg_lon_box
+
+!------------------------------------------------------------
+!> Determine which regular latitude box contains the latitude of interest
+
+subroutine get_reg_lat_box(h, lat, y_ind)
+
+type(quad_interp_handle), intent(in) :: h
+real(r8), intent(in) :: lat
+integer, intent(out) :: y_ind
+
+y_ind = int(h%ii%num_reg_y * (lat - h%ii%min_lat) / h%ii%lat_width) + 1
+!print *, 'get_reg_lat_box: ', h%ii%num_reg_y, lat, h%ii%min_lat, h%ii%lat_width, ((lat - h%ii%min_lat) / h%ii%lat_width), y_ind
+
+! Watch out for exactly at top; assume all lats and lons in legal range
+if(lat == h%ii%max_lat) y_ind = h%ii%num_reg_y
+
+end subroutine get_reg_lat_box
+
+!------------------------------------------------------------
+!> Find a set of regular lat lon boxes that covers all of the area covered by
+!> a dipole grid qaud whose corners are given by the dimension four x_corners
+!> and y_corners arrays.
+
+subroutine reg_box_overlap(h, x_corners, y_corners, is_pole, &
+ reg_lon_ind, reg_lat_ind)
+
+type(quad_interp_handle), intent(in) :: h
+real(r8), intent(in) :: x_corners(4), y_corners(4)
+logical, intent(in) :: is_pole
+integer, intent(out) :: reg_lon_ind(2), reg_lat_ind(2)
+
+! The two dimensional arrays reg_lon_ind and reg_lat_ind
+! return the first and last indices of the regular boxes in latitude and
+! longitude respectively. These indices may wraparound for reg_lon_ind.
+! A special computation is needed for a dipole quad that has the true north
+! pole in its interior. The logical is_pole is set to true if this is the case.
+! This can only happen for the t grid. If the longitude boxes overlap 0
+! degrees, the indices returned are adjusted by adding the total number of
+! boxes to the second index (e.g. the indices might be 88 and 93 for a case
+! with 90 longitude boxes).
+
+real(r8) :: lat_min, lat_max, lon_min, lon_max
+integer :: i, nrx, nry
+
+nrx = h%ii%num_reg_x
+nry = h%ii%num_reg_y
+
+! A quad containing the pole is fundamentally different
+if(is_pole) then
+ ! Need all longitude boxes
+ reg_lon_ind(1) = 1
+ reg_lon_ind(2) = nrx
+ ! Need to cover from lowest latitude to top box
+ lat_min = minval(y_corners)
+ reg_lat_ind(1) = int(nry * (lat_min + 90.0_r8) / 180.0_r8) + 1
+ call get_reg_lat_box(h, lat_min, reg_lat_ind(1))
+ reg_lat_ind(2) = nry
+else
+ ! All other quads do not contain pole (pole could be on edge but no problem)
+ ! This is specific to the dipole POP grids that do not go to the south pole
+ ! Finding the range of latitudes is cake
+ lat_min = minval(y_corners)
+ lat_max = maxval(y_corners)
+
+ ! Figure out the indices of the regular boxes for min and max lats
+ call get_reg_lat_box(h, lat_min, reg_lat_ind(1))
+ call get_reg_lat_box(h, lat_max, reg_lat_ind(2))
+
+ ! Lons are much trickier. Need to make sure to wraparound the
+ ! right way. There is no guarantee on direction of lons in the
+ ! high latitude dipole rows.
+ ! All longitudes for non-pole rows have to be within 180 degrees
+ ! of one another.
+ lon_min = minval(x_corners)
+ lon_max = maxval(x_corners)
+ if((lon_max - lon_min) > 180.0_r8) then
+ ! If the max longitude value is more than 180
+ ! degrees larger than the min, then there must be wraparound.
+ ! Then, find the smallest value > 180 and the largest < 180 to get range.
+ lon_min = 360.0_r8
+ lon_max = 0.0_r8
+ do i=1, 4
+ if(x_corners(i) > 180.0_r8 .and. x_corners(i) < lon_min) lon_min = x_corners(i)
+ if(x_corners(i) < 180.0_r8 .and. x_corners(i) > lon_max) lon_max = x_corners(i)
+ enddo
+ endif
+
+ ! Get the indices for the extreme longitudes
+ call get_reg_lon_box(h, lon_min, reg_lon_ind(1))
+ call get_reg_lon_box(h, lon_max, reg_lon_ind(2))
+
+ ! Watch for wraparound again; make sure that second index is greater than first
+ if(reg_lon_ind(2) < reg_lon_ind(1)) reg_lon_ind(2) = reg_lon_ind(2) + nrx
+endif
+
+end subroutine reg_box_overlap
+
+!------------------------------------------------------------
+!> Grabs the corners for a given quadrilateral from the global array of lower
+!> right corners. Note that corners go counterclockwise around the quad.
+
+!>@todo FIXME: is this part of the default module or the dart state module?
+
+subroutine get_quad_corners(x, i, j, cyclic, nx, ny, corners, istatus)
+
+real(r8), intent(in) :: x(:, :)
+integer, intent(in) :: i, j
+logical, intent(in) :: cyclic
+integer, intent(in) :: nx, ny
+real(r8), intent(out) :: corners(4)
+integer, intent(out) :: istatus
+
+integer :: ip1, jp1
+
+! for global grids have to worry about wrapping.
+! for regional grids you might be at the grid edge.
+istatus = 1
+corners(:) = MISSING_R8
+
+! longitude
+ip1 = i + 1
+if (ip1 > nx) then
+ if (cyclic) then
+ ip1 = 1
+ else
+ print *, 'get_quad_corners: returning early, ip1', i, j, cyclic, nx, i, ip1
+ return
+ endif
+endif
+
+! latitude - FIXME: this is over the poles, sub one
+jp1 = j + 1
+if (jp1 > ny) then
+ if (cyclic) then
+ jp1 = ny - 1
+ else
+ print *, 'get_quad_corners: returning early, jp1', i, j, cyclic, ny, j, jp1
+ return
+ endif
+endif
+
+!print *, 'get_quad_corners: ', i, j, cyclic, nx, i, ip1, ny, j, jp1
+
+corners(1) = x(i, j )
+corners(2) = x(ip1, j )
+corners(3) = x(ip1, jp1)
+corners(4) = x(i, jp1)
+
+istatus = 0
+
+end subroutine get_quad_corners
+
+!------------------------------------------------------------
+!> Updates the data structure listing dipole quads that are in a given regular box
+
+subroutine update_reg_list(reg_list_num, reg_list_lon, reg_list_lat, &
+ reg_lon_ind, reg_lat_ind, nrx, nry, maxlist, &
+ grid_lon_index, grid_lat_index)
+
+integer, intent(inout) :: reg_list_num(:, :)
+integer, intent(inout) :: reg_list_lon(:, :, :)
+integer, intent(inout) :: reg_list_lat(:, :, :)
+integer, intent(inout) :: reg_lon_ind(2)
+integer, intent(inout) :: reg_lat_ind(2)
+integer, intent(in) :: nrx, nry, maxlist
+integer, intent(in) :: grid_lon_index, grid_lat_index
+
+integer :: ind_x, index_x, ind_y, index_y
+
+!print *, 'update_reg_list called for ', grid_lon_index, grid_lat_index
+!print *, 'update_reg_list bins: ', reg_lon_ind(1), reg_lon_ind(2), reg_lat_ind(1), reg_lat_ind(2)
+
+! Loop through indices for each possible regular cell
+! Have to watch for wraparound in longitude
+if(reg_lon_ind(2) < reg_lon_ind(1)) reg_lon_ind(2) = reg_lon_ind(2) + nrx
+
+do ind_x = reg_lon_ind(1), reg_lon_ind(2)
+ ! Inside loop, need to go back to wraparound indices to find right box
+ index_x = ind_x
+ if(index_x > nrx) index_x = index_x - nrx
+
+ do ind_y = reg_lat_ind(1), reg_lat_ind(2)
+ index_y = ind_y
+ if(index_y > nry) index_y = index_y - nry
+
+ if ((index_x < 1 .or. index_x > nrx) .or. (index_y < 1 .or. index_y > nry)) then
+ string1 = 'unable to find right box'
+ write(string2,*) 'index_x may be out-of-range: ', 1, index_x, nrx
+ write(string3,*) 'index_y may be out-of-range: ', 1, index_y, nry
+ call error_handler(E_ERR,'update_reg_list',string1, &
+ source, revision, revdate, text2=string2, text3=string3)
+ endif
+
+ ! Make sure the list storage isn't full
+!print *, 'reg_list_num, x, y = ', reg_list_num, index_x, index_y
+ if(reg_list_num(index_x, index_y) >= maxlist) then
+ write(string1,*) 'max_reg_list_num (',maxlist,') is too small ... increase'
+ write(string2,*) 'adding 1 to bin ', index_x, index_y
+ write(string3,*) 'bins: ', reg_lon_ind(1), reg_lon_ind(2), &
+ reg_lat_ind(1), reg_lat_ind(2)
+ call error_handler(E_ERR, 'update_reg_list', string1, &
+ source, revision, revdate, text2=string2, text3=string3)
+ endif
+
+ ! Increment the count
+ reg_list_num(index_x, index_y) = reg_list_num(index_x, index_y) + 1
+ ! Store this quad in the list for this regular box
+ reg_list_lon(index_x, index_y, reg_list_num(index_x, index_y)) = grid_lon_index
+ reg_list_lat(index_x, index_y, reg_list_num(index_x, index_y)) = grid_lat_index
+ !print *, 'adding 1 to bin ', index_x, index_y, ' for ', grid_lon_index, grid_lat_index, &
+ ! ' now entries = ', reg_list_num(index_x, index_y)
+ enddo
+enddo
+
+end subroutine update_reg_list
+
+!------------------------------------------------------------------
+!> Subroutine to interpolate to a lon lat location given the state vector
+!> for that level, x. This works just on one horizontal slice.
+!> This routine works for either the dipole or a regular lat-lon grid.
+!> Successful interpolation returns istatus=0.
+
+!>@todo FIXME: old comment needs update:
+! Three different types of grids are used here. The POP dipole
+! grid is referred to as a dipole grid and each region is
+! referred to as a quad, short for quadrilateral.
+! The longitude latitude rectangular grid with possibly irregular
+! spacing in latitude used for some POP applications and testing
+! is referred to as the irregular grid and each region is
+! called a box.
+! Finally, a regularly spaced longitude latitude grid is used
+! as a computational tool for interpolating from the dipole
+! grid. This is referred to as the regular grid and each region
+! is called a box.
+! All grids are referenced by the index of the lower left corner
+! of the quad or box.
+
+! The dipole grid is assumed to be global for all applications.
+! The irregular grid is also assumed to be global east
+! west for all applications.
+
+!>@todo FIXME should these args be: four_lon_indices(), four_lat_indices()
+!> or even four_x_indices(), four_y_indices()? they aren't the actual lon/lat
+!> real/float values - they are the array indices.
+
+subroutine quad_lon_lat_locate_ii(interp_handle, lon, lat, &
+ four_lons, four_lats, istatus)
+type(quad_interp_handle), intent(in) :: interp_handle
+real(r8), intent(in) :: lon, lat
+integer, intent(out) :: four_lons(4), four_lats(4)
+integer, intent(out) :: istatus
+
+! NOTE: Using array sections to pass in the x array may be inefficient on some
+! compiler/platform setups. Might want to pass in the entire array with a base
+! offset value instead of the section if this is an issue.
+
+! Local storage
+integer :: num_inds, start_ind
+integer :: x_ind, y_ind, nx, ny
+integer :: lon_bot, lat_bot, lon_top, lat_top
+logical :: cyclic
+real(r8) :: x_corners(4), y_corners(4)
+
+character(len=*), parameter :: routine = 'quad_lon_lat_locate:quad_lon_lat_locate_ii'
+
+! Succesful return has istatus of 0
+istatus = 0
+
+! shorter var names for ease in reading the code
+nx = interp_handle%nlon
+ny = interp_handle%nlat
+cyclic = interp_handle%opt%spans_lon_zero
+
+select case (interp_handle%grid_type)
+
+ case (GRID_QUAD_FULLY_IRREGULAR)
+ ! Figure out which of the regular grid boxes this is in
+ call get_reg_box_indices(interp_handle, lon, lat, x_ind, y_ind, istatus)
+ if (istatus /= 0) return
+
+ num_inds = interp_handle%ii%grid_num (x_ind, y_ind)
+ start_ind = interp_handle%ii%grid_start(x_ind, y_ind)
+
+ ! If there are no quads overlapping, can't do interpolation
+ if(num_inds == 0) then
+ istatus = 1
+ return
+ endif
+
+ ! Search the list of quads to see if (lon, lat) is in one
+ call get_grid_quad(lon, lat, interp_handle%ii%lons_2d, interp_handle%ii%lats_2d, &
+ num_inds, start_ind, interp_handle%ii%grid_lon_list, &
+ interp_handle%ii%grid_lat_list, cyclic, nx, ny, &
+ lon_bot, lat_bot, istatus)
+if (debug > 10) print *, 'get_grid_quad returns lon/lat bot: ', lon_bot, lat_bot
+ if (istatus /= 0) return
+
+ ! Getting corners for accurate interpolation
+ call get_quad_corners(interp_handle%ii%lons_2d, lon_bot, lat_bot, cyclic, &
+ nx, ny, x_corners, istatus)
+if (debug > 10) print *, 'get_quad_corners returns x_corners: ', x_corners
+ if (istatus /= 0) return
+ call get_quad_corners(interp_handle%ii%lats_2d, lon_bot, lat_bot, cyclic, &
+ nx, ny, y_corners, istatus)
+if (debug > 10) print *, 'get_quad_corners returns y_corners: ', y_corners
+ if (istatus /= 0) return
+
+ ! this test shouldn't be needed
+ if ( .not. all_corners_valid(interp_handle%opt, lon_bot, lat_bot, nx)) then
+ string1 = 'got into a quad where at least one of the corners is not valid. should not happen'
+ write(string2,*) 'lon/lat bot, nx, lon/lat', lon_bot, lat_bot, nx, lon, lat
+ call error_handler(E_ERR, routine, string1, &
+ source, revision, revdate, text2=string2)
+ endif
+
+ ! Fail if point is in one of the U boxes that go through the
+ ! pole (this could be fixed up if necessary)
+ if(lat_bot == u_pole_y .and. (lon_bot == pole_x -1 .or. &
+ lon_bot == pole_x)) then
+ istatus = 4
+ return
+ endif
+
+ case (GRID_QUAD_IRREG_SPACED_REGULAR)
+ case (GRID_QUAD_FULLY_REGULAR)
+ string1 = 'this version of the call only work on fully irregular grids'
+ call error_handler(E_ERR, routine, string1, source, revision, revdate)
+
+ case default
+ call error_handler(E_ERR, routine, 'unrecognized grid type', &
+ source, revision, revdate)
+end select
+
+! Find the indices to get the values for interpolating
+lat_top = lat_bot + 1
+if(lat_top > ny) then
+ istatus = 2
+ return
+endif
+
+! Watch for wraparound in longitude
+lon_top = lon_bot + 1
+if(lon_top > nx) then
+ if (cyclic) then
+ lon_top = 1
+ else
+ istatus = 2
+ return
+ endif
+endif
+
+! the 4 return values set here are: lon_bot, lat_bot, lon_top, lat_top
+four_lons(1) = lon_bot
+four_lons(2) = lon_top
+four_lons(3) = lon_top
+four_lons(4) = lon_bot
+
+four_lats(1) = lat_bot
+four_lats(2) = lat_bot
+four_lats(3) = lat_top
+four_lats(4) = lat_top
+
+end subroutine quad_lon_lat_locate_ii
+
+!------------------------------------------------------------------
+!> Subroutine to interpolate to a lon lat location given the state vector
+!> for that level, x. This works just on one horizontal slice.
+!> This routine works for either the dipole or a regular lat-lon grid.
+!> Successful interpolation returns istatus=0.
+
+!>@todo FIXME should this still return lon_fract, lat_fract?
+!>(thinking yes)
+subroutine quad_lon_lat_locate_ir(interp_handle, lon, lat, &
+ four_lons, four_lats, lon_fract, lat_fract, istatus)
+
+type(quad_interp_handle), intent(in) :: interp_handle
+real(r8), intent(in) :: lon, lat
+integer, intent(out) :: four_lons(4), four_lats(4)
+real(r8), intent(out) :: lon_fract, lat_fract
+integer, intent(out) :: istatus
+
+! Local storage
+integer :: nx, ny
+logical :: cyclic
+integer :: lon_bot, lat_bot, lon_top, lat_top
+
+character(len=*), parameter :: routine = 'quad_lon_lat_locate:quad_lon_lat_locate_ir'
+
+! Succesful return has istatus of 0
+istatus = 0
+
+! shorter var names for ease in reading the code
+nx = interp_handle%nlon
+ny = interp_handle%nlat
+cyclic = interp_handle%opt%spans_lon_zero
+
+select case (interp_handle%grid_type)
+
+ case (GRID_QUAD_FULLY_IRREGULAR)
+ string1 = 'this version of the call only work on partially or fully regular grids'
+ call error_handler(E_ERR, routine, string1, source, revision, revdate)
+
+ case (GRID_QUAD_IRREG_SPACED_REGULAR)
+ ! This is an irregular grid (irregular == spacing; still completely orthogonal)
+ call get_semireg_box(lon, lat, nx, ny, &
+ interp_handle%ir%lons_1d, interp_handle%ir%lats_1d, &
+ lon_bot, lat_bot, lon_fract, lat_fract, istatus)
+
+ case (GRID_QUAD_FULLY_REGULAR)
+ ! evenly spaced and orthogonal
+ call get_reg_box(lon, lat, nx, ny, &
+ interp_handle%rr%lon_start, interp_handle%rr%lat_start, &
+ interp_handle%rr%lon_delta, interp_handle%rr%lat_delta, &
+ lon_bot, lat_bot, lon_fract, lat_fract, istatus)
+
+ case default
+ call error_handler(E_ERR, routine, 'unrecognized grid type', &
+ source, revision, revdate)
+end select
+
+if (istatus /= 0) return
+
+! Find the indices to get the values for interpolating
+lat_top = lat_bot + 1
+if(lat_top > ny) then
+ istatus = 2
+ return
+endif
+
+! Watch for wraparound in longitude
+lon_top = lon_bot + 1
+if(lon_top > nx) then
+ if (cyclic) then
+ lon_top = 1
+ else
+ istatus = 2
+ return
+ endif
+endif
+
+! the 6 values set so far in this routine are:
+! lon_bot, lat_bot, lon_top, lat_top, lon_fract, lat_fract
+!
+! now fill arrays so they are easy to process in the calling
+! code in the right order, which is counterclockwise around the quad:
+!
+! (lon_bot, lat_bot), (lon_top, lat_bot), (lon_top, lat_top), (lon_bot, lat_top)
+
+four_lons(1) = lon_bot
+four_lons(2) = lon_top
+four_lons(3) = lon_top
+four_lons(4) = lon_bot
+
+four_lats(1) = lat_bot
+four_lats(2) = lat_bot
+four_lats(3) = lat_top
+four_lats(4) = lat_top
+
+end subroutine quad_lon_lat_locate_ir
+
+!------------------------------------------------------------
+!> Given a longitude and latitude of a point (lon and lat) and the
+!> longitudes and latitudes of the lower left corner of the regular grid
+!> boxes, gets the indices of the grid box that contains the point and
+!> the fractions along each direction for interpolation.
+
+subroutine get_irreg_box(lon, lat, nx, ny, lon_array, lat_array, cyclic, &
+ found_x, found_y, lon_fract, lat_fract, istatus)
+
+real(r8), intent(in) :: lon, lat
+integer, intent(in) :: nx, ny
+real(r8), intent(in) :: lon_array(nx, ny), lat_array(nx, ny)
+logical, intent(in) :: cyclic
+real(r8), intent(out) :: lon_fract, lat_fract
+integer, intent(out) :: found_x, found_y, istatus
+
+! Local storage
+integer :: lat_status, lon_top, lat_top
+
+! Succesful return has istatus of 0
+istatus = 0
+
+! Get latitude box boundaries and fraction
+! FIXME: is .false. for the pole??
+call lat_bounds(lat, ny, lat_array(1,:), .false., &
+ found_y, lat_top, lat_fract, lat_status)
+
+! Check for error on the latitude interpolation
+if(lat_status /= 0) then
+ istatus = 1
+ return
+endif
+
+call lon_bounds(lon, nx, lon_array(1,:), cyclic, &
+ found_x, lon_top, lon_fract, istatus)
+
+end subroutine get_irreg_box
+
+!------------------------------------------------------------
+!> Given a longitude and latitude of a point (lon and lat) and the
+!> start and deltas of the lons and lats, get the lower left indicies
+!> of the grid box that contains the point and
+!> the fractions along each direction for interpolation.
+
+subroutine get_reg_box(lon, lat, nx, ny, lon_min, lat_min, lon_del, lat_del, &
+ found_x, found_y, lon_fract, lat_fract, istatus)
+
+real(r8), intent(in) :: lon, lat
+integer, intent(in) :: nx, ny
+real(r8), intent(in) :: lon_min, lat_min, lon_del, lat_del
+integer, intent(out) :: found_x, found_y
+real(r8), intent(out) :: lon_fract, lat_fract
+integer, intent(out) :: istatus
+
+! Local storage
+integer :: lat_status, lon_top, lat_top, i
+real(r8) :: lon_array(nx), lat_array(ny)
+
+! Succesful return has istatus of 0
+istatus = 0
+
+!>@todo FIXME: hack to get code running. don't expand arrays - slow.
+! search directly in a loop w/ deltas.
+do i=1, nx
+ lon_array(i) = lon_min + (i-1)*lon_del
+enddo
+do i=1, ny
+ lat_array(i) = lat_min + (i-1)*lat_del
+enddo
+
+! Get latitude box boundaries
+call lat_bounds(lat, ny, lat_array, .false., found_y, lat_top, lat_fract, lat_status)
+
+! Check for error on the latitude interpolation
+if(lat_status /= 0) then
+ istatus = 1
+ return
+endif
+
+! Find out what longitude box and fraction - FIXME: cyclic flag
+call lon_bounds(lon, nx, lon_array, .true., found_x, lon_top, lon_fract, istatus)
+
+end subroutine get_reg_box
+
+
+!------------------------------------------------------------
+!> Given a longitude and latitude array for irregular spaced,
+!> orthogonal grids, get the lower left indices of the grid box
+!> that contains the point and the fractions along each direction
+!> for interpolation.
+
+subroutine get_semireg_box(lon, lat, nx, ny, lon_array, lat_array, &
+ found_x, found_y, lon_fract, lat_fract, istatus)
+
+real(r8), intent(in) :: lon, lat
+integer, intent(in) :: nx, ny
+real(r8), intent(in) :: lon_array(:), lat_array(:)
+integer, intent(out) :: found_x, found_y
+real(r8), intent(out) :: lon_fract, lat_fract
+integer, intent(out) :: istatus
+
+! Local storage
+integer :: lat_status, lon_top, lat_top, i
+
+! Succesful return has istatus of 0
+istatus = 0
+
+! Get latitude box boundaries
+!>@todo FIXME check on the pole wrap and cyclic flags
+call lat_bounds(lat, ny, lat_array, .false., found_y, lat_top, lat_fract, lat_status)
+
+! Check for error on the latitude interpolation
+if(lat_status /= 0) then
+ istatus = 1
+ return
+endif
+
+! Find out what longitude box and fraction - FIXME: cyclic flag
+call lon_bounds(lon, nx, lon_array, .true., found_x, lon_top, lon_fract, istatus)
+
+end subroutine get_semireg_box
+
+!------------------------------------------------------------
+!> assumes longitudes can be described by a single 1D array.
+!> Given a longitude lon, the array of longitudes for grid boundaries, and the
+!> number of longitudes in the grid, returns the indices of the longitude
+!> below and above the location longitude and the fraction of the distance
+!> between. if 'cyclic=.true' the longitude wraps around for a global grid.
+!> Algorithm fails for a silly grid that has only two longitudes separated by 180 degrees.
+
+subroutine lon_bounds(lon, nlons, lon_array, cyclic, bot, top, fract, istatus)
+
+real(r8), intent(in) :: lon
+integer, intent(in) :: nlons
+real(r8), intent(in) :: lon_array(nlons)
+logical, intent(in) :: cyclic
+integer, intent(out) :: bot, top
+real(r8), intent(out) :: fract
+integer, intent(out) :: istatus
+
+! Local storage
+integer :: i
+real(r8) :: dist_bot, dist_top
+logical :: span ! FIXME: unneeded?
+
+! Success should return 0, failure a positive number.
+istatus = 0
+
+! If not cyclic, check for too far west or east
+! span is true if the longitude array crosses the prime meridian
+if (.not. cyclic) then
+ if(lon < lon_array(1)) then
+ istatus = 1
+ return
+ else if(lon > lon_array(nlons)) then
+ istatus = 2
+ return
+ endif
+ span = (lon_array(1) > lon_array(nlons))
+else
+ span = .true.
+endif
+
+
+! search through middle
+do i = 2, nlons
+ dist_bot = lon_dist(lon, lon_array(i - 1))
+ dist_top = lon_dist(lon, lon_array(i))
+ if (debug > 3) print *, 'lon: i, bot, top: ', i, dist_bot, dist_top
+ if(dist_bot <= 0.0_r8 .and. dist_top > 0.0_r8) then
+ bot = i - 1
+ top = i
+ if ((abs(dist_bot) + dist_top) == 0.0_r8) then
+ istatus = 2
+ return
+ endif
+ fract = abs(dist_bot) / (abs(dist_bot) + dist_top)
+ if (debug > 3) print *, 'lon: returning bot, top, fract', bot, top, fract
+ return
+ endif
+enddo
+
+
+! Falling off the end means it's in between; wraparound
+if (cyclic) then
+ bot = nlons
+ top = 1
+ dist_bot = lon_dist(lon, lon_array(bot))
+ dist_top = lon_dist(lon, lon_array(top))
+ if ((abs(dist_bot) + dist_top) == 0.0_r8) then
+ istatus = 2
+ return
+ endif
+ fract = abs(dist_bot) / (abs(dist_bot) + dist_top)
+else
+ string1 = 'end reached. internal error, should not happen'
+ write(string2,*)'lon of interest is ',lon
+ call error_handler(E_ERR, 'lon_bounds', string1, &
+ source, revision, revdate, text2=string2)
+endif
+
+
+end subroutine lon_bounds
+
+!-------------------------------------------------------------
+!> assumes latitudes can be described by a single 1D array.
+!> Given a latitude lat, the array of latitudes for grid boundaries, and the
+!> number of latitudes in the grid, returns the indices of the latitude
+!> below and above the location latitude and the fraction of the distance
+!> between. istatus is returned as 0 unless the location latitude is
+!> south of the southernmost grid point (1 returned) or north of the
+!> northernmost (2 returned). If one really had lots of polar obs would
+!> want to worry about interpolating around poles.
+
+subroutine lat_bounds(lat, nlats, lat_array, polar, bot, top, fract, istatus)
+
+real(r8), intent(in) :: lat
+integer, intent(in) :: nlats
+real(r8), intent(in) :: lat_array(nlats)
+logical, intent(in) :: polar
+integer, intent(out) :: bot, top
+real(r8), intent(out) :: fract
+integer, intent(out) :: istatus
+
+! Local storage
+integer :: i
+
+! Success should return 0, failure a positive number.
+istatus = 0
+
+! FIXME: polar is for future expansion, ignored for now
+
+! Check for too far south or north
+if(lat < lat_array(1)) then
+ istatus = 1
+ return
+else if(lat > lat_array(nlats)) then
+ istatus = 2
+ return
+endif
+
+! In the middle, search through
+do i = 2, nlats
+ if (debug > 3) print *, 'lat: i, lat, lat(i): ', i, lat, lat_array(i)
+ if(lat <= lat_array(i)) then
+ bot = i - 1
+ top = i
+ if (lat_array(top) - lat_array(bot) == 0.0_r8) then
+ istatus = 2
+ return
+ endif
+ fract = (lat - lat_array(bot)) / (lat_array(top) - lat_array(bot))
+ if (debug > 3) print *, 'lat: returning bot, top, fract', bot, top, fract
+ return
+ endif
+enddo
+
+string1 = 'end reached. internal error, should not happen'
+write(string2,*)'lat of interest is ',lat
+call error_handler(E_ERR, 'lat_bounds', string1, &
+ source, revision, revdate, text2=string2)
+
+end subroutine lat_bounds
+
+!------------------------------------------------------------------
+!> Returns the smallest signed distance between lon1 and lon2 on the sphere
+
+function lon_dist(lon1, lon2)
+
+real(r8), intent(in) :: lon1, lon2
+real(r8) :: lon_dist
+
+! If lon1 is less than 180 degrees east of lon2 the distance is negative
+! If lon1 is less than 180 degrees west of lon2 the distance is positive
+
+lon_dist = lon2 - lon1
+if(lon_dist >= -180.0_r8 .and. lon_dist <= 180.0_r8) then
+ return
+else if(lon_dist< -180.0_r8) then
+ lon_dist = lon_dist + 360.0_r8
+else
+ lon_dist = lon_dist - 360.0_r8
+endif
+
+end function lon_dist
+
+!------------------------------------------------------------
+!> Given the lon and lat of a point, and a list of the
+!> indices of the quads that might contain a point at (lon, lat), determines
+!> which quad contains the point. istatus is returned as 0 if all went
+!> well and 1 if the point was not found to be in any of the quads.
+
+subroutine get_grid_quad(lon, lat, qlons, qlats, num_inds, start_ind, &
+ x_inds, y_inds, cyclic, nx, ny, found_x, found_y, istatus)
+
+real(r8), intent(in) :: lon, lat, qlons(:, :), qlats(:, :)
+integer, intent(in) :: num_inds, start_ind, x_inds(:), y_inds(:)
+logical, intent(in) :: cyclic
+integer, intent(in) :: nx, ny
+integer, intent(out) :: found_x, found_y, istatus
+
+
+integer :: i, my_index
+real(r8) :: x_corners(4), y_corners(4)
+
+! Loop through all the quads and see if the point is inside
+do i = 1, num_inds
+ my_index = start_ind + i - 1
+ call get_quad_corners(qlons, x_inds(my_index), y_inds(my_index), &
+ cyclic, nx, ny, x_corners, istatus)
+ if (istatus /= 0) return
+
+ call get_quad_corners(qlats, x_inds(my_index), y_inds(my_index), &
+ cyclic, nx, ny, y_corners, istatus)
+ if (istatus /= 0) return
+
+ ! Ssearch in this individual quad
+ if(in_quad(lon, lat, x_corners, y_corners)) then
+ found_x = x_inds(my_index)
+ found_y = y_inds(my_index)
+ return
+ endif
+enddo
+
+! Falling off the end means search failed, return istatus 1
+istatus = 1
+
+end subroutine get_grid_quad
+
+!------------------------------------------------------------
+!> Return in_quad true if the point (lon, lat) is in the quad with
+!> the given corners.
+
+function in_quad(lon, lat, x_corners, y_corners)
+
+real(r8), intent(in) :: lon
+real(r8), intent(in) :: lat
+real(r8), intent(in) :: x_corners(4)
+real(r8), intent(in) :: y_corners(4)
+logical :: in_quad
+
+! Do this by line tracing in latitude for now. For non-pole point, want a vertical
+! line from the lon, lat point to intersect a side of the quad both above
+! and below the point.
+
+real(r8) :: x(2), y(2)
+logical :: cant_be_in_box, in_box
+integer :: intercepts_above(4), intercepts_below(4), i
+integer :: num_above, num_below
+
+! Default answer is point is not in quad
+in_quad = .false.
+
+! Loop through the sides and compute intercept (if any) with a vertical line
+! from the point. This line has equation x=lon.
+do i = 1, 4
+ ! Load up the sides endpoints
+ if(i <= 3) then
+ x(1:2) = x_corners(i:i+1)
+ y(1:2) = y_corners(i:i+1)
+ else
+ x(1) = x_corners(4)
+ x(2) = x_corners(1)
+ y(1) = y_corners(4)
+ y(2) = y_corners(1)
+ endif
+
+ ! Check to see how a vertical line from the point is related to this side
+ call line_intercept(x, y, lon, lat, cant_be_in_box, in_box, &
+ intercepts_above(i), intercepts_below(i))
+
+ ! If cant_be_in_box is true, can return right away
+ if(cant_be_in_box) then
+ in_quad = .false.
+ return
+ ! Return true if on a side
+ else if(in_box) then
+ in_quad = .true.
+ return
+ endif
+
+enddo
+
+! See if the line intercepted a side of the quad both above and below
+num_above = sum(intercepts_above)
+num_below = sum(intercepts_below)
+
+if(num_above > 0 .and. num_below > 0) then
+ in_quad = .true.
+endif
+
+end function in_quad
+
+!------------------------------------------------------------
+!> Find the intercept of a vertical line from point (x_point, y_point) and
+!> a line segment with endpoints side_x and side_y.
+
+subroutine line_intercept(side_x_in, side_y, x_point_in, y_point, &
+ cant_be_in_box, in_box, intercept_above, intercept_below)
+
+real(r8), intent(in) :: side_x_in(2)
+real(r8), intent(in) :: side_y(2)
+real(r8), intent(in) :: x_point_in
+real(r8), intent(in) :: y_point
+logical, intent(out) :: cant_be_in_box
+logical, intent(out) :: in_box
+integer, intent(out) :: intercept_above
+integer, intent(out) :: intercept_below
+
+! For a given side have endpoints (side_x1, side_y1) and (side_x2, side_y2)
+! so equation of segment is y = side_y1 + m(x-side_x1) for y
+! between side_y1 and side_y2.
+! Intersection of vertical line and line containing side
+! occurs at y = side_y1 + m(x_point - side_x1); need this
+! y to be between side_y1 and side_y2.
+! If the vertical line is colinear with the side but the point is not on the side, return
+! cant_be_in_box as true. If the point is on the side, return in_box true.
+! If the intersection of the vertical line and the side occurs at a point above
+! the given point, return 1 for intercept_above. If the intersection occurs
+! below, return 1 for intercept_below. If the vertical line does not intersect
+! the segment, return false and 0 for all intent out arguments.
+
+! WARNING: CERTAINLY A PROBLEM FOR THE POLE BOX!!! POLE BOX COULD
+! HAVE SIDES THAT ARE LONGER THAN 180. For now pole boxes are excluded.
+
+! This can probably be made much cleaner and more efficient.
+
+real(r8) :: slope, y_intercept, side_x(2), x_point
+
+! May have to adjust the longitude intent in values, so copy
+side_x = side_x_in
+x_point = x_point_in
+
+! See if the side wraps around in longitude
+if(maxval(side_x) - minval(side_x) > 180.0_r8) then
+ if(side_x(1) < 180.0_r8) side_x(1) = side_x(1) + 360.0_r8
+ if(side_x(2) < 180.0_r8) side_x(2) = side_x(2) + 360.0_r8
+ if(x_point < 180.0_r8) x_point = x_point + 360.0_r8
+endif
+
+! Initialize the default returns
+cant_be_in_box = .false.
+in_box = .false.
+intercept_above = 0
+intercept_below = 0
+
+! First easy check, if x_point is not between endpoints of segment doesn't intersect
+if(x_point < minval(side_x) .or. x_point > maxval(side_x)) return
+
+! Otherwise line must intersect the segment
+
+! First subblock, slope is undefined
+if(side_x(2) == side_x(1)) then
+ ! The line is colinear with the side
+ ! If y_point is between endpoints then point is on this side
+ if(y_point <= maxval(side_y) .and. y_point >= minval(side_y)) then
+ in_box = .true.
+ return
+ ! If not on side but colinear with side, point cant be in quad
+ else
+ cant_be_in_box = .true.
+ return
+ endif
+
+else
+
+ ! Second possibility; slope is defined
+ ! FIXME: watch out for numerical instability.
+ ! near-zero x's and large side_y's may cause overflow
+ slope = (side_y(2) - side_y(1)) / (side_x(2) - side_x(1))
+
+ ! Intercept of vertical line through is at x_point and...
+ y_intercept = side_y(1) + slope * (x_point - side_x(1))
+
+ ! Intersects the segment, is it above, below, or at the point
+ if(y_intercept == y_point) then
+ in_box = .true.
+ return
+ else if(y_intercept > y_point) then
+ intercept_above = 1
+ return
+ else
+ intercept_below = 1
+ return
+ endif
+endif
+
+end subroutine line_intercept
+
+!------------------------------------------------------------
+
+subroutine quad_bilinear_interp(lon_in, lat_in, x_corners_in, y_corners_in, cyclic, &
+ p, expected_obs)
+
+real(r8), intent(in) :: lon_in, lat_in, x_corners_in(4), y_corners_in(4), p(4)
+logical, intent(in) :: cyclic
+real(r8), intent(out) :: expected_obs
+
+! Given a longitude and latitude (lon_in, lat), the longitude and
+! latitude of the 4 corners of a quadrilateral and the values at the
+! four corners, interpolates to (lon_in, lat) which is assumed to
+! be in the quad. This is done by bilinear interpolation, fitting
+! a function of the form a + bx + cy + dxy to the four points and
+! then evaluating this function at (lon, lat). The fit is done by
+! solving the 4x4 system of equations for a, b, c, and d. The system
+! is reduced to a 3x3 by eliminating a from the first three equations
+! and then solving the 3x3 before back substituting. There is concern
+! about the numerical stability of this implementation. Implementation
+! checks showed accuracy to seven decimal places on all tests.
+
+integer :: i
+real(r8) :: m(3, 3), v(3), r(3), a, b(2), c(2), d
+real(r8) :: x_corners(4), lon, y_corners(4), lat
+real(r8) :: lon_mean, lat_mean, interp_val, angle
+
+! Watch out for wraparound on x_corners.
+lon = lon_in
+x_corners = x_corners_in
+lat = lat_in
+y_corners = y_corners_in
+
+if (debug > 10) write(*,'(A,4F12.3)') 'corner data values: ', p
+if (debug > 10) write(*,'(A,4F12.3)') 'original x_corners: ', x_corners
+if (debug > 10) write(*,'(A,4F12.3)') 'original y_corners: ', y_corners
+
+!> @todo FIXME does this depend on cyclic or span flag???
+
+! See if the side wraps around in longitude. If the corners longitudes
+! wrap around 360, then the corners and the point to interpolate to
+! must be adjusted to be in the range from 180 to 540 degrees.
+if(maxval(x_corners) - minval(x_corners) > 180.0_r8) then
+ if(lon < 180.0_r8) lon = lon + 360.0_r8
+ do i = 1, 4
+ if(x_corners(i) < 180.0_r8) x_corners(i) = x_corners(i) + 360.0_r8
+ enddo
+endif
+
+!>@todo FIXME here is where can select and test various interpolation types
+
+!*******
+! Problems with extremes in polar cell interpolation can be reduced
+! by this block, but it is not clear that it is needed for actual
+! ocean grid data
+!! Find the mean longitude of corners and remove
+!lon_mean = sum(x_corners) / 4.0_r8
+!lat_mean = sum(y_corners) / 4.0_r8
+!
+!x_corners = x_corners - lon_mean
+!lon = lon - lon_mean
+!! Multiply everybody by the cos of the latitude - why?
+!do i = 1, 4
+! !x_corners(i) = x_corners(i) * cos(y_corners(i) * deg2rad)
+!enddo
+!!lon = lon * cos(lat * deg2rad)
+!!lon_mean = lon_mean * cos(lat * deg2rad)
+!
+!y_corners = y_corners - lat_mean
+!lat = lat - lat_mean
+
+! try something else. compute offsets from lower left,
+! rotate so line segment 1-2 is horizontal, and then
+! compute values.
+
+if (do_rotate) then
+ !print *, 'rotating quads before interp'
+ !do i=1, 4
+ ! print *, 'before', i, x_corners(i), y_corners(i)
+ !enddo
+ !print *, lat, lon
+ do i = 2, 4
+ x_corners(i) = x_corners(i) - x_corners(1)
+ y_corners(i) = y_corners(i) - y_corners(1)
+ enddo
+ lon = lon - x_corners(1)
+ lat = lat - y_corners(1)
+ x_corners(1) = 0.0_r8
+ y_corners(1) = 0.0_r8
+
+ !do i=1, 4
+ ! print *, 'xform ', i, x_corners(i), y_corners(i)
+ !enddo
+ !print *, lat, lon
+
+ b(1) = x_corners(2)
+ b(2) = y_corners(2)
+ ! avoid degenerate cases where grid rotated
+ ! exactly +/- 90 degrees.
+ if (abs(x_corners(2)) > 0.001_r8) then
+ c(1) = x_corners(2)
+ c(2) = 0.0_r8
+ else
+ c(1) = 0.0_r8
+ c(2) = y_corners(2)
+ endif
+
+!print *, b, c
+ angle = angle2(b, c)
+ !print *, 'angle = ', angle
+
+ if (abs(angle) > 0.001_r8) then
+ do i = 2, 4
+ b(1) = x_corners(i)
+ b(2) = y_corners(i)
+ b = rotate2(b, angle)
+ x_corners(i) = b(1)
+ y_corners(i) = b(2)
+ enddo
+ b(1) = lon
+ b(2) = lat
+ b = rotate2(b, angle)
+ lon = b(1)
+ lat = b(2)
+ endif
+else
+ !print *, 'NOT rotating quads before interp'
+endif
+
+! now everything is in degrees relative to the lower left and rotated.
+
+if (debug > 10) write(*,'(A,5F15.5)') 'xformed x_corners, lon: ', x_corners, lon
+if (debug > 10) write(*,'(A,5F15.5)') 'xformed y_corners, lat: ', y_corners, lat
+
+!*******
+
+! Fit a surface and interpolate; solve for 3x3 matrix
+do i = 1, 3
+ ! Eliminate a from the first 3 equations
+ m(i, 1) = x_corners(i) - x_corners(i + 1)
+ m(i, 2) = y_corners(i) - y_corners(i + 1)
+ m(i, 3) = x_corners(i)*y_corners(i) - x_corners(i + 1)*y_corners(i + 1)
+ v(i) = p(i) - p(i + 1)
+if (debug > 10) write(*,'(A,I3,7F12.3)') 'i, m(3), p(2), v: ', i, m(i,:), p(i), p(i+1), v(i)
+enddo
+
+! look for degenerate matrix and rotate if needed
+! compute deter of m
+!d = deter3(m)
+
+! Solve the matrix for b, c and d
+call mat3x3(m, v, r)
+if (debug > 10) print *, 'r ', r
+if (debug > 10) print *, 'p ', p
+
+
+! r contains b, c, and d; solve for a
+a = p(4) - r(1) * x_corners(4) - &
+ r(2) * y_corners(4) - &
+ r(3) * x_corners(4)*y_corners(4)
+
+
+!----------------- Implementation test block
+! When interpolating on dipole x3 never exceeded 1e-9 error in this test
+if (debug > 10) write(*,'(A,8F12.3)') 'test corners: a, r(1), r(2), r(3)', a, r(1), r(2), r(3)
+do i = 1, 4
+ interp_val = a + r(1)*x_corners(i) + r(2)*y_corners(i)+ r(3)*x_corners(i)*y_corners(i)
+
+ if(abs(interp_val - p(i)) > 1e-9) &
+ write(*, *) 'large interp residual ', i, interp_val, p(i), interp_val - p(i)
+if (debug > 10) write(*,'(A,I3,8F12.5)') 'test corner: i, interp_val, x_corn, y_corn: ', &
+ i, interp_val, x_corners(i), y_corners(i)
+enddo
+
+!----------------- Implementation test block
+
+
+! Now do the interpolation
+
+expected_obs = a + r(1)*lon + r(2)*lat + r(3)*lon*lat
+
+if (debug > 10) write(*,'(A,8F15.5)') 'poly: expected, lon, lat, a, r(1)*lon, r(2)*lat, r(3)*lon*lat: ', &
+ expected_obs, lon, lat, a, r(1)*lon, r(2)*lat, r(3)*lon*lat
+
+
+!********
+! Avoid exceeding maxima or minima as stopgap for poles problem
+! When doing bilinear interpolation in quadrangle, can get interpolated
+! values that are outside the range of the corner values
+if(expected_obs > maxval(p)) then
+! expected_obs = maxval(p)
+if (debug > 10) write(*,'(A,3F12.3)') 'expected obs > maxval (diff): ', expected_obs, maxval(p), abs(expected_obs - maxval(p))
+else if(expected_obs < minval(p)) then
+! expected_obs = minval(p)
+if (debug > 10) write(*,'(A,3F12.3)') 'expected obs < minval (diff): ', expected_obs, minval(p), abs(expected_obs - minval(p))
+endif
+!********
+
+end subroutine quad_bilinear_interp
+
+!------------------------------------------------------------
+!> Solves rank 3 linear system mr = v for r using Cramer's rule.
+
+subroutine mat3x3(m, v, r)
+
+real(r8), intent(in) :: m(3, 3), v(3)
+real(r8), intent(out) :: r(3)
+
+! Cramer's rule isn't the best choice
+! for speed or numerical stability so might want to replace
+! this at some point.
+
+real(r8) :: m_sub(3, 3), numer, denom
+integer :: i
+
+! Compute the denominator, det(m)
+denom = deter3(m)
+
+! Loop to compute the numerator for each component of r
+do i = 1, 3
+ m_sub = m
+ m_sub(:, i) = v
+ numer = deter3(m_sub)
+ r(i) = numer / denom
+if (debug > 10) write(*,'(A,I3,7F12.3)') 'mat: i, numer, denom, r: ', i, numer, denom, r(i)
+enddo
+
+end subroutine mat3x3
+
+!------------------------------------------------------------
+!> Computes determinant of 3x3 matrix m
+
+function deter3(m)
+
+real(r8), intent(in) :: m(3, 3)
+real(r8) :: deter3
+
+deter3 = m(1,1)*m(2,2)*m(3,3) + m(1,2)*m(2,3)*m(3,1) + &
+ m(1,3)*m(2,1)*m(3,2) - m(3,1)*m(2,2)*m(1,3) - &
+ m(1,1)*m(2,3)*m(3,2) - m(3,3)*m(2,1)*m(1,2)
+
+end function deter3
+
+!------------------------------------------------------------
+! Computes dot product of two 2-vectors
+
+function dot2(a, b)
+ real(r8), intent(in) :: a(2), b(2)
+ real(r8) :: dot2
+
+dot2 = a(1)*b(1) + a(2)*b(2)
+
+end function dot2
+
+!------------------------------------------------------------
+! compute the magnitude of a 2-vector
+
+function mag2(a)
+ real(r8), intent(in) :: a(2)
+ real(r8) :: mag2
+
+mag2 = sqrt(a(1)*a(1) + a(2)*a(2))
+
+end function mag2
+
+!------------------------------------------------------------
+! compute the angle between two 2-vectors
+
+function angle2(a, b)
+ real(r8), intent(in) :: a(2), b(2)
+ real(r8) :: angle2
+
+angle2 = acos(dot2(a,b) / (mag2(a) * mag2(b)))
+
+end function angle2
+
+!------------------------------------------------------------
+! rotate vector a counterclockwise by angle theta (in radians)
+
+function rotate2(a, theta)
+ real(r8), intent(in) :: a(2)
+ real(r8), intent(in) :: theta
+ real(r8) :: rotate2(2)
+
+real(r8) :: r(2,2)
+
+r(1,1) = cos(theta)
+r(1,2) = sin(theta)
+r(2,1) = sin(-theta)
+r(2,2) = cos(theta)
+
+rotate2(1) = r(1,1)*a(1) + r(1,2)*a(2)
+rotate2(2) = r(2,1)*a(1) + r(2,2)*a(2)
+
+end function rotate2
+
+!------------------------------------------------------------------
+
+!> masked locations are invalid and cannot be the corner of any quad
+
+function is_masked(opt, lon_index, lat_index)
+
+type(quad_grid_options), intent(in) :: opt
+integer, intent(in) :: lon_index, lat_index
+logical :: is_masked
+
+if (.not. opt%uses_mask) then
+ is_masked = .false.
+else
+ is_masked = opt%grid_mask(lon_index, lat_index)
+endif
+
+end function is_masked
+
+!------------------------------------------------------------------
+
+function all_corners_valid(opt, lon_ind, lat_ind, nx)
+
+type(quad_grid_options), intent(in) :: opt
+integer, intent(in) :: lon_ind, lat_ind
+integer, intent(in) :: nx
+logical :: all_corners_valid
+
+integer :: lon_ind_p1
+
+! set to fail so we can return early.
+all_corners_valid = .false.
+
+! Might have to worry about wrapping in longitude but not in latitude
+lon_ind_p1 = lon_ind + 1
+if (opt%spans_lon_zero .and. lon_ind_p1 > nx) lon_ind_p1 = 1
+
+if (is_masked(opt, lon_ind, lat_ind )) return
+if (is_masked(opt, lon_ind_p1, lat_ind )) return
+if (is_masked(opt, lon_ind_p1, lat_ind+1)) return
+if (is_masked(opt, lon_ind, lat_ind+1)) return
+
+all_corners_valid = .true.
+
+end function all_corners_valid
+
+!------------------------------------------------------------
+
+! single item wrapper
+
+subroutine quad_lon_lat_evaluate_ii_single(interp_handle, lon, lat, &
+ four_lons, four_lats, invals, outval, istatus)
+
+type(quad_interp_handle), intent(in) :: interp_handle
+real(r8), intent(in) :: lon, lat
+integer, intent(in) :: four_lons(4), four_lats(4)
+real(r8), intent(in) :: invals(4)
+real(r8), intent(out) :: outval
+integer, intent(out) :: istatus
+
+real(r8) :: in_array(4, 1), out_array(1)
+
+in_array(:, 1) = invals
+call quad_lon_lat_evaluate_ii_array(interp_handle, lon, lat, four_lons, four_lats, &
+ 1, in_array, out_array, istatus)
+outval = out_array(1)
+istatus = 0
+
+end subroutine quad_lon_lat_evaluate_ii_single
+
+!------------------------------------------------------------
+
+!> This is a different interface because you don't need fractions for the
+!> irregular case.
+
+subroutine quad_lon_lat_evaluate_ii_array(interp_handle, lon, lat, &
+ four_lons, four_lats, nitems, invals, outvals, istatus)
+
+type(quad_interp_handle), intent(in) :: interp_handle
+real(r8), intent(in) :: lon, lat
+integer, intent(in) :: four_lons(4), four_lats(4)
+integer, intent(in) :: nitems
+real(r8), intent(in) :: invals(4, nitems)
+real(r8), intent(out) :: outvals(nitems)
+integer, intent(out) :: istatus
+
+real(r8) :: x_corners(4), y_corners(4)
+integer :: e
+
+character(len=*), parameter :: routine = 'quad_lon_lat_evaluate:quad_lon_lat_evaluate_ii_array'
+
+! Full bilinear interpolation for quads
+if(interp_handle%grid_type == GRID_QUAD_FULLY_IRREGULAR) then
+
+ ! lons and lats are integer indices. x_corners and y_corners are the real*8 locations.
+ ! Get corner grid locations for accurate interpolation
+ call get_quad_corners(interp_handle%ii%lons_2D, four_lons(1), four_lats(1), &
+ interp_handle%opt%spans_lon_zero, interp_handle%nlon, &
+ interp_handle%nlat, x_corners, istatus)
+ if (istatus /= 0) return
+
+ call get_quad_corners(interp_handle%ii%lats_2D, four_lons(1), four_lats(1), &
+ interp_handle%opt%spans_lon_zero, interp_handle%nlon, &
+ interp_handle%nlat, y_corners, istatus)
+ if (istatus /= 0) return
+if (debug > 10) write(*,'(A,8F12.3)') 'evaluate: x_corners = ', x_corners
+if (debug > 10) write(*,'(A,8F12.3)') 'evaluate: y_corners = ', y_corners
+
+if (debug > 10) write(*,'(A,8F12.3)') 'evaluate: invals ens1 = ', invals(:, 1)
+ do e = 1, nitems
+ call quad_bilinear_interp(lon, lat, x_corners, y_corners, &
+ interp_handle%opt%spans_lon_zero, invals(:,e), outvals(e))
+ enddo
+if (debug > 10) write(*,'(A,8F12.3)') 'evaluate: outvals ens1 = ', outvals(1)
+else
+ string1 = 'wrong interface for this grid'
+ write(string2,*)'grid type is ',interp_handle%grid_type
+ write(string3,*)'expected ',GRID_QUAD_FULLY_IRREGULAR
+ call error_handler(E_ERR, routine, string1, &
+ source, revision, revdate, text2=string2, text3=string3)
+endif
+
+istatus = 0
+
+end subroutine quad_lon_lat_evaluate_ii_array
+
+!------------------------------------------------------------------
+!> single item wrapper
+
+subroutine quad_lon_lat_evaluate_ir_single(interp_handle, lon_fract, lat_fract, &
+ invals, outval, istatus)
+
+type(quad_interp_handle), intent(in) :: interp_handle
+real(r8), intent(in) :: lon_fract, lat_fract
+real(r8), intent(in) :: invals(4)
+real(r8), intent(out) :: outval
+integer, intent(out) :: istatus
+
+real(r8) :: in_array(4, 1), out_array(1)
+integer :: stat(1)
+
+in_array(:, 1) = invals
+call quad_lon_lat_evaluate_ir_array(interp_handle, lon_fract, lat_fract, &
+ 1, in_array, out_array, stat)
+outval = out_array(1)
+istatus = stat(1)
+
+end subroutine quad_lon_lat_evaluate_ir_single
+
+!------------------------------------------------------------
+
+!> In the regular, orthogonal case you only need the fractions
+!> across the quad at this point.
+
+subroutine quad_lon_lat_evaluate_ir_array(interp_handle, lon_fract, lat_fract, &
+ nitems, invals, outvals, istatus)
+
+type(quad_interp_handle), intent(in) :: interp_handle
+real(r8), intent(in) :: lon_fract, lat_fract
+integer, intent(in) :: nitems
+real(r8), intent(in) :: invals(4, nitems)
+real(r8), intent(out) :: outvals(nitems)
+integer, intent(out) :: istatus(nitems)
+
+real(r8) :: xbot(nitems), xtop(nitems)
+real(r8) :: x_corners(4), y_corners(4)
+integer :: i
+
+character(len=*), parameter :: routine = 'quad_lon_lat_evaluate:quad_lon_lat_evaluate_ir_array'
+
+! Full bilinear interpolation for quads
+if(interp_handle%grid_type == GRID_QUAD_FULLY_IRREGULAR) then
+
+ string1 = 'wrong interface for this grid'
+ write(string2,*)'grid type is ',interp_handle%grid_type
+ write(string3,*)'cannot be ',GRID_QUAD_FULLY_IRREGULAR
+ call error_handler(E_ERR, routine, string1, &
+ source, revision, revdate, text2=string2, text3=string3)
+endif
+
+! Rectangular bilinear interpolation
+!>@todo FIXME should this code check invals(:) for MISSING_R8?
+!> it costs time and for grids that don't have missing data it is
+!> not needed. should it call allow_missing_in_state() on init and
+!> key off that? (i think yes.)
+
+if (.false.) then
+
+ ! have to do the items individually because some items might
+ ! have missing and others not.
+ do i=1, nitems
+ if (any(invals(:, i) == MISSING_R8)) then
+ outvals(i) = MISSING_R8
+ istatus(i) = 1
+ else
+ xbot(1) = invals(1, i) + lon_fract * (invals(2, i) - invals(1, i))
+ xtop(1) = invals(4, i) + lon_fract * (invals(3, i) - invals(4, i))
+ outvals(i) = xbot(1) + lat_fract * (xtop(1) - xbot(1))
+ istatus(i) = 0
+ endif
+ enddo
+ return
+
+else
+
+ ! can use array syntax and do them all at once. no missing vals.
+ xbot = invals(1, :) + lon_fract * (invals(2, :) - invals(1, :))
+ xtop = invals(4, :) + lon_fract * (invals(3, :) - invals(4, :))
+
+ outvals(:) = xbot + lat_fract * (xtop - xbot)
+ istatus(:) = 0
+
+endif
+
+end subroutine quad_lon_lat_evaluate_ir_array
+
+!------------------------------------------------------------------
+
+end module quad_utils_mod
+
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/models/utilities/quad_utils_mod.nml b/models/utilities/quad_utils_mod.nml
new file mode 100644
index 0000000000..8ddb895803
--- /dev/null
+++ b/models/utilities/quad_utils_mod.nml
@@ -0,0 +1,3 @@
+&quad_interpolate_nml
+ debug = 0
+ /
diff --git a/models/wrf/WRF_DART_utilities/add_pert_where_high_refl.f90 b/models/wrf/WRF_DART_utilities/add_pert_where_high_refl.f90
index e57460bf89..522f1f4702 100644
--- a/models/wrf/WRF_DART_utilities/add_pert_where_high_refl.f90
+++ b/models/wrf/WRF_DART_utilities/add_pert_where_high_refl.f90
@@ -91,10 +91,6 @@ PROGRAM add_pert_where_high_refl
real(r8), allocatable :: p(:,:,:) ! pressure (mb)
-character(len=8) :: crdate ! needed by F90 DATE_AND_TIME intrinsic
-character(len=10) :: crtime ! needed by F90 DATE_AND_TIME intrinsic
-character(len=5) :: crzone ! needed by F90 DATE_AND_TIME intrinsic
-integer, dimension(8) :: values ! needed by F90 DATE_AND_TIME intrinsic
real(r8) :: dx, dy ! horizontal grid spacings (m)
integer :: bt, sn, we ! WRF grid dimensions
integer :: i, j, k, o
@@ -315,12 +311,6 @@ PROGRAM add_pert_where_high_refl
! the ensemble number so repeated runs have reproducible values.
call init_random_seq(rs, (gdays + gsecs)*1000 + ens_num)
-! Original code was setting the seed based on the milliseconds of
-! the system clock, so all seeds were random but not reproducible.
-!call date_and_time(crdate,crtime,crzone,values)
-!call init_random_seq(rs, -int(values(8)))
-
-
! Add perturbations.
diff --git a/models/wrf/WRF_DART_utilities/replace_wrf_fields.f90 b/models/wrf/WRF_DART_utilities/replace_wrf_fields.f90
index 03bac9743c..b4e9356f73 100644
--- a/models/wrf/WRF_DART_utilities/replace_wrf_fields.f90
+++ b/models/wrf/WRF_DART_utilities/replace_wrf_fields.f90
@@ -8,10 +8,11 @@ program replace_wrf_fields
use types_mod, only : r8
use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
- open_file, close_file, nc_check, get_next_filename, &
+ open_file, close_file, get_next_filename, &
find_namelist_in_file, check_namelist_read, &
do_nml_file, do_nml_term, nmlfileunit, &
initialize_utilities, finalize_utilities
+use netcdf_utilities_mod, only : nc_check
use parse_args_mod, only : get_args_from_string
use netcdf
diff --git a/models/wrf/WRF_DART_utilities/wrf_dart_obs_preprocess.f90 b/models/wrf/WRF_DART_utilities/wrf_dart_obs_preprocess.f90
index d467334bdb..cb7b42c3f3 100644
--- a/models/wrf/WRF_DART_utilities/wrf_dart_obs_preprocess.f90
+++ b/models/wrf/WRF_DART_utilities/wrf_dart_obs_preprocess.f90
@@ -32,7 +32,8 @@ program wrf_dart_obs_preprocess
use obs_sequence_mod, only : obs_sequence_type, static_init_obs_sequence, &
read_obs_seq_header, destroy_obs_sequence, &
get_num_obs, write_obs_seq
-use utilities_mod, only : find_namelist_in_file, check_namelist_read, nc_check
+use utilities_mod, only : find_namelist_in_file, check_namelist_read
+use netcdf_utilities_mod, only : nc_check
use obs_kind_mod, only : RADIOSONDE_U_WIND_COMPONENT, ACARS_U_WIND_COMPONENT, &
MARINE_SFC_U_WIND_COMPONENT, LAND_SFC_U_WIND_COMPONENT, &
METAR_U_10_METER_WIND, GPSRO_REFRACTIVITY, &
@@ -831,10 +832,10 @@ function isManLevel(plevel)
integer, parameter :: nman = 16
integer :: kk
logical :: isManLevel
-real (r8) raw_man_levels(nman) &
- / 100000.0_r8, 92500.0_r8, 85000.0_r8, 70000.0_r8, 50000.0_r8, 40000.0_r8, &
+real(r8) :: raw_man_levels(nman) = (/ &
+ 100000.0_r8, 92500.0_r8, 85000.0_r8, 70000.0_r8, 50000.0_r8, 40000.0_r8, &
30000.0_r8, 25000.0_r8, 20000.0_r8, 15000.0_r8, 10000.0_r8, 7000.0_r8, &
- 5000.0_r8, 3000.0_r8, 2000.0_r8, 1000.0_r8 /
+ 5000.0_r8, 3000.0_r8, 2000.0_r8, 1000.0_r8 /)
isManLevel = .false.
do kk = 1, nman
@@ -973,7 +974,8 @@ subroutine read_and_parse_input_seq(filename, nx, ny, obs_bdy, siglevel, ptop, &
tc_seq, gpsro_seq, other_seq)
use types_mod, only : r8
-use utilities_mod, only : nc_check
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file, &
+ nc_get_variable
use time_manager_mod, only : time_type
use location_mod, only : location_type, get_location, is_vertical
use obs_sequence_mod, only : obs_sequence_type, obs_type, init_obs, &
@@ -1005,7 +1007,6 @@ subroutine read_and_parse_input_seq(filename, nx, ny, obs_bdy, siglevel, ptop, &
SAT_U_WIND_COMPONENT, SAT_V_WIND_COMPONENT, &
VORTEX_LAT, VORTEX_LON, VORTEX_PMIN, VORTEX_WMAX
use model_mod, only : get_domain_info
-use netcdf
implicit none
@@ -1045,13 +1046,10 @@ subroutine read_and_parse_input_seq(filename, nx, ny, obs_bdy, siglevel, ptop, &
! read land distribution
allocate(xland(nint(nx),nint(ny)))
-call nc_check( nf90_open(path = "wrfinput_d01", mode = nf90_nowrite, ncid = fid), &
- 'read_and_parse_input_seq', 'open wrfinput_d01')
-call nc_check( nf90_inq_varid(fid, "XLAND", var_id), &
- 'read_and_parse_input_seq', 'inquire XLAND ID')
-call nc_check( nf90_get_var(fid, var_id, xland), &
- 'read_and_parse_input_seq', 'read XLAND')
-call nc_check( nf90_close(fid), 'read_and_parse_input_seq', 'close wrfinput_d01')
+
+fid = nc_open_file_readonly("wrfinput_d01", "read_and_parse_input_seq")
+call nc_get_variable(fid, "XLAND", xland)
+call nc_close_file(fid, "read_and_parse_input_seq")
input_ncep_qc = .false.
qcmeta = get_qc_meta_data(seq, 1)
diff --git a/models/wrf/module_map_utils-wrf3.0.f90 b/models/wrf/module_map_utils-wrf3.0.f90
index efe54c6e40..cbe0c647b7 100644
--- a/models/wrf/module_map_utils-wrf3.0.f90
+++ b/models/wrf/module_map_utils-wrf3.0.f90
@@ -135,11 +135,12 @@ MODULE map_utils
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ use types_mod, only : digits12
use constants_module
use misc_definitions_module
! Define some private constants
- INTEGER, PRIVATE, PARAMETER :: HIGH = 8
+ INTEGER, PRIVATE, PARAMETER :: HIGH = digits12
TYPE proj_info
@@ -685,6 +686,7 @@ SUBROUTINE set_ps(proj)
! Executable code
reflon = proj%stdlon + 90.
+ proj%cone = 1.0_r8
! Compute numerator term of map scale factor
scale_top = 1. + proj%hemi * SIN(proj%truelat1 * rad_per_deg)
diff --git a/models/wrf/module_map_utils.f90 b/models/wrf/module_map_utils.f90
index 14b71fd0a1..4666d1c35d 100644
--- a/models/wrf/module_map_utils.f90
+++ b/models/wrf/module_map_utils.f90
@@ -10,7 +10,7 @@
module constants_module
- use types_mod, only : r8
+ use types_mod, only : r8, digits12
real (kind=r8), parameter :: PI = 3.141592653589793_r8
real (kind=r8), parameter :: OMEGA_E = 0.00007292_r8 ! Angular rotation rate of the earth
@@ -227,7 +227,7 @@ MODULE map_utils
! use utilities_mod, only : register_module
! Define some private constants
- INTEGER, PRIVATE, PARAMETER :: HIGH = 8
+ INTEGER, PRIVATE, PARAMETER :: HIGH = digits12
TYPE proj_info
@@ -775,6 +775,7 @@ SUBROUTINE set_ps(proj)
! Executable code
reflon = proj%stdlon + 90.0_r8
+ proj%cone = 1.0_r8
! Compute numerator term of map scale factor
scale_top = 1.0_r8 + proj%hemi * SIN(proj%truelat1 * rad_per_deg)
diff --git a/models/wrf/work/input.nml b/models/wrf/work/input.nml
index 585d8c3180..cf8f372666 100644
--- a/models/wrf/work/input.nml
+++ b/models/wrf/work/input.nml
@@ -45,6 +45,8 @@
num_output_obs_members = 32,
output_interval = 1,
num_groups = 1,
+ distributed_state = .true.
+ compute_posterior = .true.
output_forward_op_errors = .false.,
output_timestamps = .false.,
trace_execution = .false.,
diff --git a/models/wrf/work/mkmf_closest_member_tool b/models/wrf/work/mkmf_closest_member_tool
index 207a9ab625..7fd464d5c6 100755
--- a/models/wrf/work/mkmf_closest_member_tool
+++ b/models/wrf/work/mkmf_closest_member_tool
@@ -5,6 +5,12 @@
# http://www.image.ucar.edu/DAReS/DART/DART_download
#
# DART $Id$
+#
+# usage: mkmf_closest_member_tool [ -mpi | -nompi ]
+#
+# without any args, builds closest_member_tool without mpi libraries, and it will run
+# as a normal executable. if -mpi is given, it will be compiled with the mpi
+# libraries and can run with multiple cooperating processes.
if ( $#argv > 0 ) then
if ("$argv[1]" == "-mpi") then
@@ -59,7 +65,6 @@ rm -f path_names_closest_member_tool.back
../../../build_templates/mkmf -p closest_member_tool -t ../../../build_templates/mkmf.template \
-a "../../.." ${wrapper_arg} path_names_closest_member_tool
-
exit $status
#
diff --git a/models/wrf/work/mkmf_perturb_single_instance b/models/wrf/work/mkmf_perturb_single_instance
new file mode 100755
index 0000000000..864a08b9b7
--- /dev/null
+++ b/models/wrf/work/mkmf_perturb_single_instance
@@ -0,0 +1,69 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id: mkmf_perturb_single_instance 12639 2018-06-06 22:11:25Z hendric@ucar.edu $
+
+if ( $#argv > 0 ) then
+ if ("$argv[1]" == "-mpi") then
+ setenv usingmpi 1
+ else if ("$argv[1]" == "-nompi") then
+ setenv usingmpi 0
+ else
+ echo "Unrecognized argument to mkmf_perturb_single_instance: $argv[1]"
+ echo "Usage: mkmf_perturb_single_instance [ -mpi | -nompi ]"
+ echo " default is to generate a Makefile without MPI support."
+ exit -1
+ endif
+else
+ setenv usingmpi 0
+endif
+
+
+# make a backup copy of the path_names file, and then use
+# sed to make sure it includes either the non-mpi subroutines,
+# or the subroutines which really call mpi.
+cp -f path_names_perturb_single_instance path_names_perturb_single_instance.back
+
+if ( $usingmpi ) then
+
+ echo "Making Makefile with MPI"
+ touch using_mpi_for_perturb_single_instance
+ sed -e 's#/null_mpi_util#/mpi_util#' \
+ -e 's#/null_win_mod#/no_cray_win_mod#' path_names_perturb_single_instance.back >! path_names_perturb_single_instance
+
+ setenv wrapper_arg -w
+
+else
+
+ echo "Making Makefile without MPI"
+ rm -f using_mpi_for_perturb_single_instance
+ sed -e 's#/mpi_util#/null_mpi_util#' \
+ -e '\#no_cray_win_mod.f90#d' \
+ -e '\#cray_win_mod.f90#d' path_names_perturb_single_instance.back >! path_names_perturb_single_instance
+
+ set p=`grep null_win_mod.f90 path_names_perturb_single_instance | wc -w`
+ if ( $p == 0) then
+ echo assimilation_code/modules/utilities/null_win_mod.f90 >> path_names_perturb_single_instance
+ endif
+
+ setenv wrapper_arg ""
+
+endif
+
+# remove temp file and now really call mkmf to generate makefile
+rm -f path_names_perturb_single_instance.back
+
+../../../build_templates/mkmf -p perturb_single_instance -t ../../../build_templates/mkmf.template \
+ -a "../../.." ${wrapper_arg} path_names_perturb_single_instance
+
+
+exit $status
+
+#
+# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/pertirb_tool/models/wrf/work/mkmf_perturb_single_instance $
+# $Revision: 12639 $
+# $Date: 2018-06-06 16:11:25 -0600 (Wed, 06 Jun 2018) $
+
diff --git a/models/wrf/work/path_names_model_mod_check b/models/wrf/work/path_names_model_mod_check
index 9acadaa185..60bfa42633 100644
--- a/models/wrf/work/path_names_model_mod_check
+++ b/models/wrf/work/path_names_model_mod_check
@@ -23,6 +23,7 @@ assimilation_code/modules/utilities/distributed_state_mod.f90
assimilation_code/modules/utilities/ensemble_manager_mod.f90
assimilation_code/modules/utilities/netcdf_utilities_mod.f90
assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/null_win_mod.f90
assimilation_code/modules/utilities/obs_impact_mod.f90
assimilation_code/modules/utilities/options_mod.f90
assimilation_code/modules/utilities/parse_args_mod.f90
@@ -39,4 +40,3 @@ models/wrf/model_mod.f90
models/wrf/module_map_utils.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
-assimilation_code/modules/utilities/null_win_mod.f90
diff --git a/models/wrf/work/path_names_perturb_single_instance b/models/wrf/work/path_names_perturb_single_instance
new file mode 100644
index 0000000000..88280fb883
--- /dev/null
+++ b/models/wrf/work/path_names_perturb_single_instance
@@ -0,0 +1,36 @@
+assimilation_code/location/threed_sphere/location_mod.f90
+assimilation_code/location/utilities/default_location_mod.f90
+assimilation_code/location/utilities/location_io_mod.f90
+assimilation_code/modules/assimilation/adaptive_inflate_mod.f90
+assimilation_code/modules/assimilation/assim_model_mod.f90
+assimilation_code/modules/assimilation/assim_tools_mod.f90
+assimilation_code/modules/assimilation/cov_cutoff_mod.f90
+assimilation_code/modules/assimilation/quality_control_mod.f90
+assimilation_code/modules/assimilation/reg_factor_mod.f90
+assimilation_code/modules/assimilation/sampling_error_correction_mod.f90
+assimilation_code/modules/io/dart_time_io_mod.f90
+assimilation_code/modules/io/direct_netcdf_mod.f90
+assimilation_code/modules/io/io_filenames_mod.f90
+assimilation_code/modules/io/state_structure_mod.f90
+assimilation_code/modules/io/state_vector_io_mod.f90
+assimilation_code/modules/observations/obs_kind_mod.f90
+assimilation_code/modules/observations/obs_sequence_mod.f90
+assimilation_code/modules/utilities/distributed_state_mod.f90
+assimilation_code/modules/utilities/ensemble_manager_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/null_win_mod.f90
+assimilation_code/modules/utilities/obs_impact_mod.f90
+assimilation_code/modules/utilities/options_mod.f90
+assimilation_code/modules/utilities/parse_args_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/perturb_single_instance/perturb_single_instance.f90
+models/utilities/default_model_mod.f90
+models/wrf/model_mod.f90
+models/wrf/module_map_utils.f90
+observations/forward_operators/obs_def_mod.f90
+observations/forward_operators/obs_def_utilities_mod.f90
diff --git a/models/wrf/work/quickbuild.csh b/models/wrf/work/quickbuild.csh
index 1421728c6e..d535db5c9c 100755
--- a/models/wrf/work/quickbuild.csh
+++ b/models/wrf/work/quickbuild.csh
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh
#
# DART software - Copyright UCAR. This open source software is provided
# by UCAR, "as is", without charge, subject to all terms of use at
@@ -15,8 +15,8 @@
# environment variable options:
# before running this script, do:
# "setenv CODE_DEBUG 1" (csh) or "export CODE_DEBUG=1" (bash)
-# to keep the .o and .mod files in the current directory instead of
-# removing them at the end. this usually improves runtime error reports
+# to keep the .o and .mod files in the current directory instead of
+# removing them at the end. this usually improves runtime error reports
# and these files are required by most debuggers.
#----------------------------------------------------------------------
@@ -24,7 +24,7 @@
set MODEL = "wrf"
# programs which have the option of building with MPI:
-set MPI_TARGETS = "filter perfect_model_obs model_mod_check wakeup_filter closest_member_tool"
+set MPI_TARGETS = "filter perfect_model_obs model_mod_check wakeup_filter closest_member_tool perturb_single_instance"
# set default (override with -mpi or -nompi):
# 0 = build without MPI, 1 = build with MPI
@@ -36,7 +36,7 @@ set with_mpi = 1
if ( $#argv >= 1 ) then
if ( "$1" == "-mpi" ) then
- set with_mpi = 1
+ set with_mpi = 1
else if ( "$1" == "-nompi" ) then
set with_mpi = 0
else
@@ -52,7 +52,7 @@ if ( $?CODE_DEBUG ) then
set cdebug = $CODE_DEBUG
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
# Build any NetCDF files from .cdl files
@@ -64,18 +64,18 @@ endif
if ( $has_cdl > 0 ) then
foreach DATAFILE ( *.cdl )
-
+
set OUTNAME = `basename $DATAFILE .cdl`.nc
-
+
if ( ! -f $OUTNAME ) then
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "constructing $MODEL data file $n named $OUTNAME"
-
+ echo "constructing $MODEL data file $n named $OUTNAME"
+
ncgen -o $OUTNAME $DATAFILE || exit $n
endif
-
+
end
endif
@@ -101,7 +101,7 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$MODEL build number $n is $PROG"
+ echo "$MODEL build number $n is $PROG"
\rm -f $PROG
csh $TARGET || exit $n
make || exit $n
@@ -117,15 +117,15 @@ foreach TARGET ( mkmf_preprocess mkmf_* )
skip:
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All single task DART programs compiled."
+echo "Success: All single task DART programs compiled."
if ( $with_mpi ) then
echo "Script now compiling MPI parallel versions of the DART programs."
@@ -134,10 +134,10 @@ else
exit 0
endif
-\rm -f *.o *.mod
+\rm -f *.o *.mod Makefile .cppdefs
#----------------------------------------------------------------------
-# Build the MPI-enabled target(s)
+# Build the MPI-enabled target(s)
#----------------------------------------------------------------------
foreach PROG ( $MPI_TARGETS )
@@ -147,21 +147,21 @@ foreach PROG ( $MPI_TARGETS )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "$MODEL MPI build number $n is $PROG"
+ echo "$MODEL MPI build number $n is $PROG"
\rm -f $PROG
csh $TARGET -mpi || exit $n
make || exit $n
end
-if ( $cdebug ) then
+if ( $cdebug ) then
echo 'preserving .o and .mod files for debugging'
else
- \rm -f *.o *.mod
+ \rm -f *.o *.mod Makefile .cppdefs
endif
\rm -f input.nml*_default
-echo "Success: All MPI parallel DART programs compiled."
+echo "Success: All MPI parallel DART programs compiled."
exit 0
diff --git a/observations/forward_operators/DEFAULT_obs_def_mod.F90 b/observations/forward_operators/DEFAULT_obs_def_mod.F90
index 10609835fa..3201e9f8b7 100644
--- a/observations/forward_operators/DEFAULT_obs_def_mod.F90
+++ b/observations/forward_operators/DEFAULT_obs_def_mod.F90
@@ -607,6 +607,7 @@ subroutine read_obs_def(ifile, obs_def, key, obs_val, fform)
integer :: o_index
logical :: is_ascii
character(len=32) :: fileformat ! here for backwards compatibility only
+character(len=256) :: errstring
character(len=11) :: header_external_FO
integer :: ii, secs,days
character(len=128) :: string
@@ -632,8 +633,10 @@ subroutine read_obs_def(ifile, obs_def, key, obs_val, fform)
if (is_ascii) then
read(ifile, '(a5)') header
if(header /= 'obdef') then
+ write(errstring, *) 'read "//header//" instead'
call error_handler(E_ERR,'read_obs_def', &
- 'Expected header "obdef" in input file', source, revision, revdate)
+ 'Expected header "obdef" in input file', &
+ source, revision, revdate, text2=errstring)
endif
endif
@@ -642,9 +645,10 @@ subroutine read_obs_def(ifile, obs_def, key, obs_val, fform)
if (is_ascii) then
read(ifile, '(a5)' ) header
if(header /= 'kind ') then
+ write(errstring, *) 'read "//header//" instead'
call error_handler(E_ERR,'read_kind', &
'Expected kind header "kind " in input file', &
- source, revision, revdate)
+ source, revision, revdate, text2=errstring)
endif
read(ifile, *) o_index
else
@@ -672,9 +676,10 @@ subroutine read_obs_def(ifile, obs_def, key, obs_val, fform)
continue
case DEFAULT
+ write(errstring, *) 'unknown type number was ', obs_def%kind
call error_handler(E_ERR, 'read_obs_def', &
'Attempt to read for undefined obs_kind type.', &
- source, revision, revdate)
+ source, revision, revdate, text2=errstring)
end select
! We need to see whether there is external prior metadata.
diff --git a/observations/forward_operators/obs_def_COSMOS_mod.f90 b/observations/forward_operators/obs_def_COSMOS_mod.f90
index e8c3ae620b..f1eba55f87 100644
--- a/observations/forward_operators/obs_def_COSMOS_mod.f90
+++ b/observations/forward_operators/obs_def_COSMOS_mod.f90
@@ -70,7 +70,7 @@ module obs_def_COSMOS_mod
use types_mod, only : r8, PI, metadatalength, MISSING_R8
use utilities_mod, only : register_module, error_handler, E_ERR, E_WARN, E_MSG, &
- logfileunit, get_unit, open_file, close_file, nc_check, &
+ logfileunit, get_unit, open_file, close_file, &
file_exist, ascii_file_format
use location_mod, only : location_type, set_location, get_location, &
VERTISHEIGHT, VERTISLEVEL, set_location_missing
@@ -80,9 +80,6 @@ module obs_def_COSMOS_mod
use obs_def_utilities_mod, only : track_status
use ensemble_manager_mod, only : ensemble_type
-use typesizes
-use netcdf
-
implicit none
private
diff --git a/observations/forward_operators/obs_def_altimeter_mod.f90 b/observations/forward_operators/obs_def_altimeter_mod.f90
index 61aee55537..f68f4afedf 100644
--- a/observations/forward_operators/obs_def_altimeter_mod.f90
+++ b/observations/forward_operators/obs_def_altimeter_mod.f90
@@ -123,7 +123,6 @@ subroutine get_expected_altimeter(state_handle, ens_size, location, altimeter_se
istatus = 1
endwhere
-return
end subroutine get_expected_altimeter
!----------------------------------------------------------------------
diff --git a/observations/forward_operators/obs_def_chem_units_mod.f90 b/observations/forward_operators/obs_def_chem_units_mod.f90
new file mode 100644
index 0000000000..d383e828ce
--- /dev/null
+++ b/observations/forward_operators/obs_def_chem_units_mod.f90
@@ -0,0 +1,154 @@
+! 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$
+
+! An example of a simple forward operator that involves more than
+! just interpolating directly from a state vector in a model.
+!
+! This section defines a specific type in the left column and
+! can be any string you want to use for an observation. The
+! right column must be a generic kind that already exists in
+! the obs_kind/DEFAULT_obs_kind_mod.F90 file.
+
+! BEGIN DART PREPROCESS KIND LIST
+! IASI_CO QTY_CO
+! END DART PREPROCESS KIND LIST
+
+! This section will be added to the main obs_def_mod.f90 that
+! is going to be generated, to allow it to call the code we
+! are defining here.
+
+! BEGIN DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
+! use obs_def_chem_units_mod, only : get_expected_chem_units
+! END DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
+
+! This section will be dropped into a large case statement in the
+! main obs_def_mod.f90 code to control what happens with each
+! observation type that is processed.
+
+! BEGIN DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
+! case(IASI_CO)
+! call get_expected_chem_units(state_handle, ens_size, location, expected_obs, istatus)
+! END DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
+
+! The next few sections do nothing because there is no additional
+! data to read, write, or prompt for. But there still needs to be a
+! case statement in the large select, so they must be here.
+
+! BEGIN DART PREPROCESS READ_OBS_DEF
+! case(IASI_CO)
+! continue
+! END DART PREPROCESS READ_OBS_DEF
+
+! BEGIN DART PREPROCESS WRITE_OBS_DEF
+! case(IASI_CO)
+! continue
+! END DART PREPROCESS WRITE_OBS_DEF
+
+! BEGIN DART PREPROCESS INTERACTIVE_OBS_DEF
+! case(IASI_CO)
+! continue
+! END DART PREPROCESS INTERACTIVE_OBS_DEF
+
+! This is the code that implements the forward operator.
+! Define a module, and make public anything that will be called
+! from the main obs_def_mod.f90 file. Here it is just the
+! get_expected routine. There isn't any initialization needed
+! but the stub is there; it could read a namelist if there are
+! any run-time options to be set.
+
+! BEGIN DART PREPROCESS MODULE CODE
+module obs_def_chem_units_mod
+
+use types_mod, only : r8, missing_r8
+use utilities_mod, only : register_module
+use location_mod, only : location_type
+use assim_model_mod, only : interpolate
+use obs_kind_mod, only : QTY_CO
+use ensemble_manager_mod, only : ensemble_type
+use obs_def_utilities_mod, only : track_status
+
+implicit none
+private
+
+public :: get_expected_windspeed
+
+! version controlled file description for error handling, do not edit
+character(len=*), parameter :: source = &
+ "$URL$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
+
+logical, save :: module_initialized = .false.
+
+real(r8) :: convert_table(max_defined_quantities) = 1.0_r8
+
+contains
+
+! ---------------------------------------------------
+
+subroutine initialize_module
+
+! Handle any module initialization tasks
+
+if (module_initialized) return
+
+call register_module(source, revision, revdate)
+module_initialized = .true.
+
+end subroutine initialize_module
+
+! ---------------------------------------------------
+
+subroutine get_expected_chem_units(state_handle, ens_size, location, chem, istatus)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+real(r8), intent(out) :: chem(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+! Forward operator for converting chemical species units.
+! must match the call in the GET_EXPECTED_OBS_FROM_DEF section above.
+
+real(r8) :: uwind(ens_size) ! zonal wind component
+real(r8) :: vwind(ens_size) ! meridional wind component
+integer :: this_istatus(ens_size)
+logical :: return_now
+
+if ( .not. module_initialized ) call initialize_module
+
+istatus = 0 ! to use track_status, it must start out 0
+
+if (first_time) then
+ first_time = .false.
+ ! read in table
+ convert_table(:) = 1.0_r8
+endif
+
+! Zonal wind at this location - this calls the model_mod code.
+call interpolate(state_handle, ens_size, location, QTY_CO, chem, this_istatus)
+call track_status(ens_size, this_istatus, wspd, istatus, return_now)
+if (return_now) return
+
+! The actual forward operator computation. This is the value that
+! will be returned. istatus (the return code) of 0 is good,
+! any value > 0 indicates an error. (values < 0 reserved for
+! system use.)
+
+where (istatus == 0) chem = convert_table(QTY_CO) * chem
+
+end subroutine get_expected_chem_units
+
+! ---------------------------------------------------
+
+end module obs_def_chem_units_mod
+! END DART PREPROCESS MODULE CODE
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/observations/forward_operators/obs_def_cice_mod.f90 b/observations/forward_operators/obs_def_cice_mod.f90
index 5599213965..2730a72493 100644
--- a/observations/forward_operators/obs_def_cice_mod.f90
+++ b/observations/forward_operators/obs_def_cice_mod.f90
@@ -4,28 +4,449 @@
!
! $Id$
-! FIXME: check to see if obs are of volume or thickness - for now we
+!>@todo FIXME: check to see if obs are of volume or thickness - for now we
! will assume volume.
-! FIXME: do we want to identify the satellite? (yes)
-! AMSRE is a passive microwave
-
! BEGIN DART PREPROCESS KIND LIST
-!SAT_SEAICE_AGREG_CONCENTR, QTY_SEAICE_AGREG_CONCENTR, COMMON_CODE
!SYN_SEAICE_CONCENTR, QTY_SEAICE_CONCENTR, COMMON_CODE
-!SAT_SEAICE_AGREG_VOLUME, QTY_SEAICE_AGREG_VOLUME, COMMON_CODE
-!SAT_SEAICE_AGREG_SNOWVOLUME, QTY_SEAICE_AGREG_SNOWVOLUME, COMMON_CODE
-!SAT_SEAICE_AGREG_THICKNESS, QTY_SEAICE_AGREG_THICKNESS, COMMON_CODE
-!SAT_SEAICE_AGREG_SNOWDEPTH, QTY_SEAICE_AGREG_SNOWDEPTH, COMMON_CODE
!SAT_U_SEAICE_COMPONENT, QTY_U_SEAICE_COMPONENT, COMMON_CODE
!SAT_V_SEAICE_COMPONENT, QTY_V_SEAICE_COMPONENT, COMMON_CODE
!SAT_SEAICE_CONCENTR, QTY_SEAICE_CONCENTR, COMMON_CODE
!SAT_SEAICE_VOLUME, QTY_SEAICE_VOLUME, COMMON_CODE
!SAT_SEAICE_SNOWVOLUME, QTY_SEAICE_SNOWVOLUME, COMMON_CODE
-!SAT_SEAICE_AGREG_FY, QTY_SEAICE_AGREG_FY, COMMON_CODE
-!SAT_SEAICE_AGREG_SURFACETEMP, QTY_SEAICE_AGREG_SURFACETEMP, COMMON_CODE
+!SAT_SEAICE_SURFACETEMP, QTY_SEAICE_SURFACETEMP, COMMON_CODE
+!SAT_SEAICE_FY, QTY_SEAICE_FY, COMMON_CODE
+!SAT_SEAICE_AGREG_FY, QTY_SEAICE_AGREG_FY
+!SAT_SEAICE_AGREG_SURFACETEMP, QTY_SEAICE_AGREG_SURFACETEMP
+!SAT_SEAICE_AGREG_FREEBOARD, QTY_SEAICE_AGREG_FREEBOARD
+!SAT_SEAICE_AGREG_CONCENTR, QTY_SEAICE_AGREG_CONCENTR
+!SAT_SEAICE_AGREG_VOLUME, QTY_SEAICE_AGREG_VOLUME
+!SAT_SEAICE_AGREG_SNOWVOLUME, QTY_SEAICE_AGREG_SNOWVOLUME
+!SAT_SEAICE_AGREG_THICKNESS, QTY_SEAICE_AGREG_THICKNESS
+!SAT_SEAICE_AGREG_SNOWDEPTH, QTY_SEAICE_AGREG_SNOWDEPTH
! END DART PREPROCESS KIND LIST
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
+! use obs_def_cice_mod, only : get_expected_agreg_freeboard, &
+! get_expected_agreg_over_grid, &
+! get_expected_agreg_over_ice, &
+! get_expected_agreg_thickness
+! END DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
+! case(SAT_SEAICE_AGREG_FREEBOARD)
+! call get_expected_agreg_freeboard(state_handle, ens_size, location, &
+! QTY_SEAICE_CONCENTR, QTY_SEAICE_VOLUME, QTY_SEAICE_SNOWVOLUME, &
+! expected_obs, istatus)
+! case(SAT_SEAICE_AGREG_THICKNESS)
+! call get_expected_agreg_thickness(state_handle, ens_size, location, &
+! QTY_SEAICE_VOLUME, expected_obs, istatus)
+! case(SAT_SEAICE_AGREG_SNOWDEPTH)
+! call get_expected_agreg_thickness(state_handle, ens_size, location, &
+! QTY_SEAICE_SNOWVOLUME, expected_obs, istatus)
+! case(SAT_SEAICE_AGREG_CONCENTR)
+! call get_expected_agreg_over_grid(state_handle, ens_size, location, &
+! QTY_SEAICE_CONCENTR, expected_obs,istatus)
+! case(SAT_SEAICE_AGREG_VOLUME)
+! call get_expected_agreg_over_grid(state_handle, ens_size, location, &
+! QTY_SEAICE_VOLUME, expected_obs, istatus)
+! case(SAT_SEAICE_AGREG_SNOWVOLUME)
+! call get_expected_agreg_over_grid(state_handle, ens_size, location, &
+! QTY_SEAICE_SNOWVOLUME, expected_obs, istatus)
+! case(SAT_SEAICE_AGREG_SURFACETEMP)
+! call get_expected_agreg_over_ice(state_handle, ens_size, location, &
+! QTY_SEAICE_SURFACETEMP, expected_obs, istatus)
+! case(SAT_SEAICE_AGREG_FY)
+! call get_expected_agreg_over_ice(state_handle, ens_size, location, &
+! QTY_SEAICE_FY, expected_obs, istatus)
+! END DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS READ_OBS_DEF
+! case(SAT_SEAICE_AGREG_FREEBOARD, &
+! SAT_SEAICE_AGREG_THICKNESS, &
+! SAT_SEAICE_AGREG_SNOWDEPTH, &
+! SAT_SEAICE_AGREG_CONCENTR, &
+! SAT_SEAICE_AGREG_VOLUME, &
+! SAT_SEAICE_AGREG_SNOWVOLUME, &
+! SAT_SEAICE_AGREG_SURFACETEMP, &
+! SAT_SEAICE_AGREG_FY)
+! continue
+! END DART PREPROCESS READ_OBS_DEF
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS WRITE_OBS_DEF
+! case(SAT_SEAICE_AGREG_FREEBOARD, &
+! SAT_SEAICE_AGREG_THICKNESS, &
+! SAT_SEAICE_AGREG_SNOWDEPTH, &
+! SAT_SEAICE_AGREG_CONCENTR, &
+! SAT_SEAICE_AGREG_VOLUME, &
+! SAT_SEAICE_AGREG_SNOWVOLUME, &
+! SAT_SEAICE_AGREG_SURFACETEMP, &
+! SAT_SEAICE_AGREG_FY)
+! continue
+! END DART PREPROCESS WRITE_OBS_DEF
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS INTERACTIVE_OBS_DEF
+! case(SAT_SEAICE_AGREG_FREEBOARD, &
+! SAT_SEAICE_AGREG_THICKNESS, &
+! SAT_SEAICE_AGREG_SNOWDEPTH, &
+! SAT_SEAICE_AGREG_CONCENTR, &
+! SAT_SEAICE_AGREG_VOLUME, &
+! SAT_SEAICE_AGREG_SNOWVOLUME, &
+! SAT_SEAICE_AGREG_SURFACETEMP, &
+! SAT_SEAICE_AGREG_FY)
+! continue
+! END DART PREPROCESS INTERACTIVE_OBS_DEF
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS MODULE CODE
+
+module obs_def_cice_mod
+
+use types_mod, only : r8, missing_r8, PI, deg2rad
+
+use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
+ check_namelist_read, find_namelist_in_file, &
+ nmlfileunit, do_output, do_nml_file,do_nml_term, &
+ ascii_file_format
+
+use location_mod, only : location_type, set_location, get_location, &
+ VERTISLEVEL
+
+use assim_model_mod, only : interpolate
+
+use obs_kind_mod, only : QTY_SEAICE_VOLUME, &
+ QTY_SEAICE_CONCENTR, &
+ QTY_SEAICE_SNOWVOLUME, &
+ QTY_SEAICE_FY, &
+ QTY_SEAICE_SURFACETEMP, &
+ QTY_SEAICE_CATEGORY
+
+use ensemble_manager_mod, only : ensemble_type
+
+use obs_def_utilities_mod, only : track_status
+
+implicit none
+
+public :: get_expected_agreg_freeboard, &
+ get_expected_agreg_thickness, &
+ get_expected_agreg_over_ice, &
+ get_expected_agreg_over_grid
+
+! version controlled file description for error handling, do not edit
+character(len=*), parameter :: source = &
+ "$URL$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
+
+logical, save :: module_initialized = .false.
+integer :: Ncat = 0
+
+character(len=512) :: string1, string2, string3
+
+!>@todo FIXME ... instead of using multiple istatus? arrays, could use
+!> the track_status() routine
+
+contains
+
+!-----------------------------------------------------------------------------
+!> The number of ice categories is needed for all the forward operators.
+!> The number of categories will be determined ONCE.
+
+subroutine initialize_module(state_handle, ens_size)
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+
+if (module_initialized) return
+call register_module(source, revision, revdate)
+module_initialized = .true.
+
+Ncat = get_number_of_ice_categories(state_handle, ens_size)
+
+end subroutine initialize_module
+
+
+!-----------------------------------------------------------------------------
+!>
+
+subroutine get_expected_agreg_freeboard(state_handle, ens_size, location, &
+ var_sic, var_siv, var_snv, &
+ agreg_fb, istatus)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+integer, intent(in) :: var_sic, var_siv, var_snv
+real(r8), intent(out) :: agreg_fb(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+!fb_volume is over grid, agreg_fb is over sea ice
+!for real observations we have fb
+real(r8) :: fb_volume(ens_size)
+real(r8) :: ice_volume(ens_size)
+real(r8) :: snow_volume(ens_size)
+real(r8) :: agreg_sic(ens_size)
+
+real(r8) :: loc_array(3),llat,llon
+integer :: icat
+integer :: istatus1(ens_size)
+integer :: istatus2(ens_size)
+integer :: istatus3(ens_size)
+
+type(location_type) :: location_fake
+
+real(r8), parameter :: ice_dens = 917.0_r8, &
+ snow_dens = 330.0_r8, &
+ water_dens = 1026.0_r8
+
+if (.not.module_initialized) call initialize_module(state_handle, ens_size)
+
+loc_array = get_location(location)
+llat = loc_array(1)
+llon = loc_array(2)
+
+istatus = 0
+fb_volume = 0.0_r8
+agreg_fb = 0.0_r8
+
+call get_expected_agreg_over_grid(state_handle, ens_size, location, &
+ QTY_SEAICE_CONCENTR, agreg_sic, istatus3)
+
+! model_interpolate interpolates from the model grid to a specific location
+! the 3rd variable location%z contains cat_index. The observation itself may
+! not contain cat_index, so we need create one.
+
+do icat = 1, Ncat
+
+ location_fake = set_location(llat,llon,real(icat,r8),VERTISLEVEL)
+
+ call interpolate(state_handle, ens_size, location_fake, &
+ QTY_SEAICE_VOLUME, ice_volume, istatus1)
+
+ call interpolate(state_handle, ens_size, location_fake, &
+ QTY_SEAICE_SNOWVOLUME, snow_volume, istatus2)
+
+ where(istatus1==0 .and. istatus2==0) &
+ fb_volume = fb_volume + ice_volume*(1 - ice_dens/water_dens) - &
+ snow_volume*snow_dens/water_dens
+end do
+
+where(istatus3==0 .and. agreg_sic>1e-6) agreg_fb = fb_volume/agreg_sic
+where(istatus1/=0) istatus = istatus1
+where(istatus2/=0) istatus = istatus2
+where(istatus3/=0) istatus = istatus3
+
+end subroutine get_expected_agreg_freeboard
+
+
+!-----------------------------------------------------------------------------
+!> The forward operator is to sum the model state over all the categories,
+!> unit per grid area. Nothing else is applied.
+!> Good for aggregate sea ice volume and snow volume
+
+subroutine get_expected_agreg_over_grid(state_handle, ens_size, location, &
+ obstype, agreg_grid, istatus)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+integer, intent(in) :: obstype
+real(r8), intent(out) :: agreg_grid(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+type(location_type) :: location_fake
+
+real(r8) :: grid(ens_size)
+integer :: icat
+real(r8) :: loc_array(3),llat,llon
+
+if (.not.module_initialized) call initialize_module(state_handle, ens_size)
+
+istatus = 0
+agreg_grid = 0.0_r8
+
+loc_array = get_location(location)
+llat = loc_array(1)
+llon = loc_array(2)
+
+! model_interpolate interpolates from the model grid to a specific location
+! the 3rd variable location%z contains cat_index. The observation itself may
+! not contain cat_index, so we need create one.
+
+do icat = 1, Ncat
+ location_fake = set_location(llat,llon,real(icat,r8),VERTISLEVEL)
+ call interpolate(state_handle, ens_size, location_fake, obstype, grid ,istatus)
+ where(istatus == 0) agreg_grid = agreg_grid + grid
+end do
+
+end subroutine get_expected_agreg_over_grid
+
+
+!-----------------------------------------------------------------------------
+!> This is to calculate the agregate value over ice only
+!> Unit per ice area
+
+subroutine get_expected_agreg_over_ice(state_handle, ens_size, location, &
+ obstype, agreg_ice, istatus)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+integer, intent(in) :: obstype
+real(r8), intent(out) :: agreg_ice(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+real(r8) :: sic(ens_size)
+real(r8) :: ice(ens_size)
+real(r8) :: agreg_sic(ens_size)
+real(r8) :: temp_ice(ens_size)
+integer :: istatus1(ens_size)
+integer :: istatus2(ens_size)
+integer :: istatus3(ens_size)
+integer :: icat
+
+real(r8) :: loc_array(3),llat,llon
+type(location_type) :: location_fake
+
+if (.not.module_initialized) call initialize_module(state_handle, ens_size)
+
+loc_array = get_location(location)
+llat = loc_array(1)
+llon = loc_array(2)
+istatus = 0
+
+temp_ice = 0
+
+call get_expected_agreg_over_grid(state_handle, ens_size, location, &
+ QTY_SEAICE_CONCENTR, agreg_sic, istatus3)
+
+! model_interpolate interpolates from the model grid to a specific location
+! the 3rd variable location%z contains cat_index. The observation itself may
+! not contain cat_index, so we need create one.
+
+do icat =1, Ncat
+ location_fake = set_location(llat,llon,real(icat,r8),VERTISLEVEL)
+ call interpolate(state_handle, ens_size, location_fake, &
+ QTY_SEAICE_CONCENTR, sic, istatus1)
+ call interpolate(state_handle, ens_size, location_fake, obstype, ice, istatus2)
+
+ where(istatus1 /= 0) istatus = istatus1
+ where(istatus2 /= 0) istatus = istatus2
+ where(istatus == 0) temp_ice = temp_ice + sic * ice
+end do
+
+!where(agreg_sic>1e-6) agreg_ice = temp_ice/agreg_sic
+agreg_ice = temp_ice/max(agreg_sic,1e-8)
+
+end subroutine get_expected_agreg_over_ice
+
+
+!-----------------------------------------------------------------------------
+!> For thickness, it's sum(volume*concentr)
+!> Good for sea ice thickness and snow thickness
+
+subroutine get_expected_agreg_thickness(state_handle, ens_size, location, &
+ obstype, agreg_thickness, istatus)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+integer, intent(in) :: obstype
+real(r8), intent(out) :: agreg_thickness(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+real(r8) :: agreg_sic(ens_size)
+real(r8) :: agreg_volume(ens_size)
+integer :: istatus1(ens_size), istatus2(ens_size)
+real(r8) :: loc_array(3),llat,llon
+
+if (.not.module_initialized) call initialize_module(state_handle, ens_size)
+
+loc_array = get_location(location)
+llat = loc_array(1)
+llon = loc_array(2)
+istatus = 0
+
+agreg_thickness = 0
+
+call get_expected_agreg_over_grid(state_handle, ens_size, location, &
+ QTY_SEAICE_CONCENTR, agreg_sic, istatus1)
+
+call get_expected_agreg_over_grid(state_handle, ens_size, location,&
+ obstype, agreg_volume, istatus2)
+
+where(istatus1 /= 0) istatus = istatus1
+where(istatus2 /= 0) istatus = istatus2
+!where(istatus == 0.and.agreg_sic>1e-6) agreg_thickness = agreg_volume/agreg_sic
+where(istatus == 0) agreg_thickness = agreg_volume/max(agreg_sic,1e-8)
+
+end subroutine get_expected_agreg_thickness
+
+
+!-----------------------------------------------------------------------------
+!> This determines the number of sea ice categories.
+
+function get_number_of_ice_categories(state_handle, ens_size)
+
+integer :: get_number_of_ice_categories
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+
+integer, parameter :: MAX_CATEGORIES = 100
+
+integer :: istatus(ens_size)
+real(r8) :: category(ens_size)
+real(r8) :: llat = 0.0_r8
+real(r8) :: llon = 0.0_r8
+integer :: icat
+type(location_type) :: location_fake
+
+get_number_of_ice_categories = 0
+
+CATEGORIES : do icat =1, MAX_CATEGORIES
+
+ location_fake = set_location(llat, llon, real(icat,r8), VERTISLEVEL)
+
+ call interpolate(state_handle, ens_size, location_fake, &
+ QTY_SEAICE_CATEGORY, category, istatus)
+
+ if (any(istatus /= 0)) exit CATEGORIES
+
+ get_number_of_ice_categories = get_number_of_ice_categories + 1
+
+enddo CATEGORIES
+
+if (get_number_of_ice_categories == MAX_CATEGORIES) then
+ write(string1,*)'at capacity of ice categories.'
+ write(string2,*)'If you have more than ',MAX_CATEGORIES,' ice categories'
+ write(string3,*)'modify "MAX_CATEGORIES", recompile and try again.'
+ call error_handler(E_ERR,'get_number_of_ice_categories',string1, &
+ source, revision, revdate, text2=string2, text3=string3)
+endif
+
+if (get_number_of_ice_categories == 0) then
+ write(string1,*)'Could not determine the number of ice categories.'
+ call error_handler(E_ERR,'get_number_of_ice_categories',string1, &
+ source, revision, revdate)
+endif
+
+end function get_number_of_ice_categories
+
+
+end module obs_def_cice_mod
+
+! END DART PREPROCESS MODULE CODE
+!-----------------------------------------------------------------------------
+
!
! $URL$
! $Id$
diff --git a/observations/forward_operators/obs_def_dew_point_mod.f90 b/observations/forward_operators/obs_def_dew_point_mod.f90
index 3b38c5fd80..7eb7566aca 100644
--- a/observations/forward_operators/obs_def_dew_point_mod.f90
+++ b/observations/forward_operators/obs_def_dew_point_mod.f90
@@ -142,9 +142,10 @@ subroutine get_expected_dew_point(state_handle, ens_size, location, key, td, ist
real(r8) :: qv(ens_size) ! water vapor mixing ratio (kg/kg)
real(r8) :: e_mb(ens_size) ! water vapor pressure (mb)
real(r8), PARAMETER :: e_min = 0.001_r8 ! threshold for minimum vapor pressure (mb),
- ! to avoid problems near zero in Bolton's equation
+ ! to avoid problems near zero vapor pressure in Bolton's equation
real(r8) :: p_Pa(ens_size) ! pressure (Pa)
real(r8) :: p_mb(ens_size) ! pressure (mb)
+real(r8) :: log_term(ens_size) ! Intermediate term in computation of dewpoint temperature
!> @todo make strings longer
character(len=129) :: errstring
logical :: return_now
@@ -193,9 +194,21 @@ subroutine get_expected_dew_point(state_handle, ens_size, location, key, td, ist
!------------------------------------------------------------------------------
! Use Bolton's approximation to compute dewpoint.
+ ! Bolton, David, 1980: The Computation of Equivalent Potential Temperature.
+ ! Monthly Weather Review. 108 (7): 1046-1053.
+ ! Bolton does not explicitly have this formula, but the pieces are there.
+ ! He uses the three constant values used here.
+ ! Other authors, and the Wikipedia page on dewpoint, provide this formula
+ ! explicitly and suggest 6.1121 instead of 6.112.
!------------------------------------------------------------------------------
- td = t_kelvin + (243.5_r8 / ((17.67_r8 / log(e_mb/6.112_r8)) - 1.0_r8) )
+ ! The following expression can fail numerically for dewpoints very close to 0 C
+ !td = t_kelvin + (243.5_r8 / ((17.67_r8 / log(e_mb/6.112_r8)) - 1.0_r8) )
+
+ ! A numerically robust formula that avoids the failure near dewpoints of 0 C
+ log_term = log(e_mb / 6.112_r8)
+ td = t_kelvin + 243.5_r8 * log_term / (17.67_r8 - log_term)
+
elsewhere
td = missing_r8
end where
diff --git a/observations/forward_operators/obs_def_dew_point_mod.html b/observations/forward_operators/obs_def_dew_point_mod.html
index 6753bcd62c..15b51f3abc 100644
--- a/observations/forward_operators/obs_def_dew_point_mod.html
+++ b/observations/forward_operators/obs_def_dew_point_mod.html
@@ -41,6 +41,8 @@
Overview
Revision 2801 implements a more robust method
(based on Bolton's Approximation) for calculating dew point.
+This has been further revised to avoid a numerical instability that could lead
+to failed forward operators for dewpoints almost exactly 0 C.
@@ -137,7 +139,7 @@
Bolton, David, 1980: The Computation of Equivalent Potential Temperature. Monthly Weather Review, 108, 1046-1053.
diff --git a/observations/forward_operators/obs_def_gps_mod.f90 b/observations/forward_operators/obs_def_gps_mod.f90
index 8d11a01aef..3a6393b759 100644
--- a/observations/forward_operators/obs_def_gps_mod.f90
+++ b/observations/forward_operators/obs_def_gps_mod.f90
@@ -21,7 +21,6 @@
! SPECIFIC_HUMIDITY, QTY_SPECIFIC_HUMIDITY, COMMON_CODE
! PRESSURE, QTY_PRESSURE, COMMON_CODE
! GPSRO_REFRACTIVITY, QTY_GPSRO
-! COSMIC_ELECTRON_DENSITY, QTY_ELECTRON_DENSITY, COMMON_CODE
! END DART PREPROCESS KIND LIST
diff --git a/observations/forward_operators/obs_def_insat_mod.f90 b/observations/forward_operators/obs_def_insat_mod.f90
new file mode 100644
index 0000000000..8977e3d7ad
--- /dev/null
+++ b/observations/forward_operators/obs_def_insat_mod.f90
@@ -0,0 +1,16 @@
+! 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$
+
+! BEGIN DART PREPROCESS KIND LIST
+! INSAT3D_TEMPERATURE, QTY_TEMPERATURE, COMMON_CODE
+! INSAT3D_SPECIFIC_HUMIDITY, QTY_SPECIFIC_HUMIDITY, COMMON_CODE
+! END DART PREPROCESS KIND LIST
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/observations/forward_operators/obs_def_ocean_mod.f90 b/observations/forward_operators/obs_def_ocean_mod.f90
index a63d9f1b9a..984bc56ee8 100644
--- a/observations/forward_operators/obs_def_ocean_mod.f90
+++ b/observations/forward_operators/obs_def_ocean_mod.f90
@@ -64,6 +64,7 @@
!EN_SEA_SURFACE_ANOMALY, QTY_SEA_SURFACE_ANOMALY, COMMON_CODE
!GFO_SEA_SURFACE_ANOMALY, QTY_SEA_SURFACE_ANOMALY, COMMON_CODE
!DRY_LAND, QTY_DRY_LAND, COMMON_CODE
+!OI_SEA_SURFACE_TEMPERATURE, QTY_TEMPERATURE, COMMON_CODE
!HFRADAR_U_CURRENT_COMPONENT, QTY_U_CURRENT_COMPONENT, COMMON_CODE
!HFRADAR_V_CURRENT_COMPONENT, QTY_V_CURRENT_COMPONENT, COMMON_CODE
!HFRADAR_RADIAL_VELOCITY, QTY_VELOCITY
diff --git a/observations/forward_operators/obs_def_oxygen_ion_density_mod.f90 b/observations/forward_operators/obs_def_oxygen_ion_density_mod.f90
new file mode 100644
index 0000000000..8d31084ac7
--- /dev/null
+++ b/observations/forward_operators/obs_def_oxygen_ion_density_mod.f90
@@ -0,0 +1,290 @@
+! 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: obs_def_ion_density_mod.f90 11692 2017-06-02 21:00:44Z nancy@ucar.edu $
+
+!-----------------------------------------------------------------------------
+! DART Code: Johnny Hendricks , hendric at ucar.edu
+! Original DART/Radar work: Nancy Collins
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS KIND LIST
+! DENSITY_ION_E, QTY_DENSITY_ION_E
+! MOLEC_OXYGEN_MIXING_RATIO, QTY_MOLEC_OXYGEN_MIXING_RATIO
+! ATOMIC_OXYGEN_MIXING_RATIO, QTY_ATOMIC_OXYGEN_MIXING_RATIO
+! DENSITY_ION_OP, QTY_DENSITY_ION_OP
+! ION_O_MIXING_RATIO, QTY_ION_O_MIXING_RATIO
+! ATOMIC_H_MIXING_RATIO, QTY_ATOMIC_H_MIXING_RATIO
+! END DART PREPROCESS KIND LIST
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
+! use obs_def_ion_density_mod, only : get_expected_oxygen_ion_val
+! END DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
+! case(DENSITY_ION_OP)
+! call get_expected_oxygen_ion_val(state_handle, ens_size, location, expected_obs, istatus)
+! END DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS READ_OBS_DEF
+! case(DENSITY_ION_E, &
+! MOLEC_OXYGEN_MIXING_RATIO, &
+! ATOMIC_OXYGEN_MIXING_RATIO, &
+! DENSITY_ION_OP, &
+! ION_O_MIXING_RATIO, &
+! ATOMIC_H_MIXING_RATIO)
+! continue
+! END DART PREPROCESS READ_OBS_DEF
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS WRITE_OBS_DEF
+! case(DENSITY_ION_E, &
+! MOLEC_OXYGEN_MIXING_RATIO, &
+! ATOMIC_OXYGEN_MIXING_RATIO, &
+! DENSITY_ION_OP, &
+! ION_O_MIXING_RATIO, &
+! ATOMIC_H_MIXING_RATIO)
+! continue
+! END DART PREPROCESS WRITE_OBS_DEF
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS INTERACTIVE_OBS_DEF
+! case(DENSITY_ION_E, &
+! MOLEC_OXYGEN_MIXING_RATIO, &
+! ATOMIC_OXYGEN_MIXING_RATIO, &
+! DENSITY_ION_OP, &
+! ION_O_MIXING_RATIO, &
+! ATOMIC_H_MIXING_RATIO)
+! continue
+! END DART PREPROCESS INTERACTIVE_OBS_DEF
+!-----------------------------------------------------------------------------
+
+!-----------------------------------------------------------------------------
+! BEGIN DART PREPROCESS MODULE CODE
+module obs_def_ion_density_mod
+
+use types_mod, only : r8, missing_r8, PI, deg2rad
+use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, &
+ check_namelist_read, find_namelist_in_file, &
+ nmlfileunit, do_output, do_nml_file, do_nml_term, &
+ ascii_file_format
+use location_mod, only : location_type, write_location, read_location, &
+ interactive_location, get_location
+use assim_model_mod, only : interpolate
+use obs_kind_mod, only : QTY_DENSITY_ION_E, & ! Right QTY to use?
+ QTY_MOLEC_OXYGEN_MIXING_RATIO, &
+ QTY_ATOMIC_OXYGEN_MIXING_RATIO, &
+ QTY_DENSITY_ION_OP, &
+ QTY_ION_O_MIXING_RATIO, & ! newly defined
+ QTY_ATOMIC_H_MIXING_RATIO, & ! newly defined
+ QTY_TEMPERATURE, &
+ QTY_PRESSURE
+
+use ensemble_manager_mod, only : ensemble_type
+use obs_def_utilities_mod, only : track_status
+
+implicit none
+private
+
+!>@todo compare get_expected_oxygen_ion_val to obs_def_upper_atm_mod.f90:get_expected_oxygen_ion_density ... identical
+
+public :: get_expected_oxygen_ion_val, oxygen_ion_density
+
+! version controlled file description for error handling, do not edit
+character(len=256), parameter :: source = &
+ "$URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/observations/forward_operators/obs_def_ion_density_mod.f90 $"
+character(len=32 ), parameter :: revision = "$Revision: 11692 $"
+character(len=128), parameter :: revdate = "$Date: 2017-06-02 15:00:44 -0600 (Fri, 02 Jun 2017) $"
+
+logical :: module_initialized = .false.
+
+!--------------------------------------------------------------
+! WACCM-X; put into common/types_mod.f90?
+real(r8), PARAMETER :: kboltz = 1.380648E-23_r8 ! [N*m/K]
+real(r8), PARAMETER :: universal_gas_constant = 8314.0_r8 ! [J/K/kmol]
+
+!--------------------------------------------------------------
+! WACCM-X; flag to check for the definition of QTYs needed by oxygen_ion_density
+logical :: first_oxygen_ion_call = .true.
+
+!--------------------------------------------------------------
+character(len=256) :: msgstring
+
+!--------------------------------------------------------------
+! Namelist with default values
+!
+! use_variable_mean_mass:
+
+logical :: use_variable_mean_mass = .false.
+
+namelist /obs_def_ion_density_mod_nml/ use_variable_mean_mass
+
+
+contains
+
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+! Start of executable routines
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+
+subroutine initialize_module
+
+! Called once to set values and allocate space
+
+integer :: iunit, io, rc
+
+! Prevent multiple calls from executing this code more than once.
+if (module_initialized) return
+
+module_initialized = .true.
+
+! Log the version of this source file.
+call register_module(source, revision, revdate)
+
+! Read the namelist entry.
+call find_namelist_in_file("input.nml", "obs_def_ion_density_mod_nml", iunit)
+read(iunit, nml = obs_def_ion_density_mod_nml, iostat = io)
+call check_namelist_read(iunit, io, "obs_def_ion_density_mod_nml")
+
+! Record the namelist values used for the run ...
+if (do_nml_file()) write(nmlfileunit, nml=obs_def_ion_density_mod_nml)
+if (do_nml_term()) write( * , nml=obs_def_ion_density_mod_nml)
+
+end subroutine initialize_module
+
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+! ION density section
+!----------------------------------------------------------------------
+!----------------------------------------------------------------------
+
+subroutine get_expected_oxygen_ion_val(state_handle, ens_size, location, obs_val, istatus)
+
+!-----------------------------------------------------------------------------
+! This function was implemented for WACCM-X.
+! Check the units for use with other models.
+! Given DART state vector and a location, it computes O+ density [1/cm^3].
+! The istatus variable should be returned as 0 unless there is a problem.
+!
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+real(r8), intent(out) :: obs_val(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+if ( .not. module_initialized ) call initialize_module
+
+istatus = 0 ! Need to initialize this to zero for track_status.
+obs_val = MISSING_R8
+
+call oxygen_ion_density(state_handle, ens_size, location, obs_val, istatus)
+
+end subroutine get_expected_oxygen_ion_val
+
+!----------------------------------------------------------------------
+
+subroutine oxygen_ion_density(state_handle, ens_size, location, ion_val, istatus)
+
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+real(r8), intent(out) :: ion_val(ens_size)
+integer, intent(out) :: istatus(ens_size)
+
+logical :: debug = .false. ! set to .true. to enable debug printout
+integer, dimension(ens_size) :: mmr_o1_status, mmr_o2_status, mmr_n2_status, ion_op_status
+integer, dimension(ens_size) :: mmr_h1_status, mmr_op_status, p_status, t_status
+real(r8), dimension(ens_size) :: mmr_o1, mmr_o2, mmr_n2, mmr_h1, mmr_op ! mass mixing ratio
+real(r8), dimension(ens_size) :: ion_op, mbar, pressure, temperature
+real(r8), dimension(3) :: debug_location
+real(r8) :: N2_molar_mass, O_molar_mass, O2_molar_mass, H_molar_mass
+
+logical :: return_now
+
+O_molar_mass = 28.0_r8
+O2_molar_mass = 16.0_r8
+H_molar_mass = 32.0_r8
+N2_molar_mass = 1.0_r8
+
+! Some models have density as part of the state.
+! If it is available, just return it. If density is not state,
+! then we need to create it from its constituents.
+call interpolate(state_handle, ens_size, location, QTY_DENSITY_ION_OP, ion_op, ion_op_status)
+call track_status(ens_size, ion_op_status, ion_val, istatus, return_now)
+if (all(istatus(:) == 0 )) return
+
+call interpolate(state_handle, ens_size, location, QTY_ATOMIC_OXYGEN_MIXING_RATIO, mmr_o1, mmr_o1_status)
+call track_status(ens_size, mmr_o1_status, ion_val, istatus, return_now)
+if (return_now) return
+
+call interpolate(state_handle, ens_size, location, QTY_MOLEC_OXYGEN_MIXING_RATIO, mmr_o2, mmr_o2_status)
+call track_status(ens_size, mmr_o2_status, ion_val, istatus, return_now)
+if (return_now) return
+
+call interpolate(state_handle, ens_size, location, QTY_ATOMIC_H_MIXING_RATIO, mmr_h1, mmr_h1_status)
+call track_status(ens_size, mmr_h1_status, ion_val, istatus, return_now)
+if (return_now) return
+
+call interpolate(state_handle, ens_size, location, QTY_ION_O_MIXING_RATIO, mmr_op, mmr_op_status)
+call track_status(ens_size, mmr_op_status, ion_val, istatus, return_now)
+if (return_now) return
+
+call interpolate(state_handle, ens_size, location, QTY_PRESSURE, pressure, p_status)
+call track_status(ens_size, p_status, ion_val, istatus, return_now)
+if (return_now) return
+
+call interpolate(state_handle, ens_size, location, QTY_TEMPERATURE, temperature, t_status)
+call track_status(ens_size, t_status, ion_val, istatus, return_now)
+if (return_now) return
+
+!---------------------------------------------------------------------------------------------------
+! Need to get number density (cgs units) from mass mixing ratio (kg/kg).
+! mbar is g/mole, same as rMass units
+! kg/kg * (g/mole)/(g/mole) * (Pa = N/m^2)/((Joules/K = N*m/K) * (K)) = m-3 * 1E-06 = cm-3
+!---------------------------------------------------------------------------------------------------
+! WACCM-X .i file pressure unit is Pa
+
+where(istatus == 0)
+mmr_n2 = 1.0_r8 - (mmr_o1 + mmr_o2 + mmr_h1)
+
+mbar = 1.0_r8/( mmr_o1/O_molar_mass &
+ + mmr_o2/O2_molar_mass &
+ + mmr_h1/H_molar_mass &
+ + mmr_n2/N2_molar_mass)
+
+ion_val = mmr_op * mbar/O_molar_mass * pressure/(kboltz * temperature) * 1.E-06_r8
+endwhere
+
+return
+
+if (debug) then
+ debug_location = get_location(location)
+ print *, 'final ion_val: ', ion_val
+ print *, 'istatus: ', istatus
+endif
+
+end subroutine oxygen_ion_density
+
+!----------------------------------------------------------------------
+
+end module obs_def_ion_density_mod
+! END DART PREPROCESS MODULE CODE
+!-----------------------------------------------------------------------------
+
+!
+! $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/observations/forward_operators/obs_def_ion_density_mod.f90 $
+! $Id: obs_def_ion_density_mod.f90 11692 2017-06-02 21:00:44Z nancy@ucar.edu $
+! $Revision: 11692 $
+! $Date: 2017-06-02 15:00:44 -0600 (Fri, 02 Jun 2017) $
diff --git a/observations/forward_operators/obs_def_radar_mod.f90 b/observations/forward_operators/obs_def_radar_mod.f90
index a4c67d8914..a5501be039 100644
--- a/observations/forward_operators/obs_def_radar_mod.f90
+++ b/observations/forward_operators/obs_def_radar_mod.f90
@@ -866,11 +866,11 @@ subroutine get_expected_radial_vel(state_handle, ens_size, location, velkey, &
!
! Reference: Lin et al., 1983 (J. Climate Appl.Meteor., 1065-1092)
+real(r8), dimension(ens_size) :: u, v, w, precip_fall_speed
+integer, dimension(ens_size) :: u_istatus, v_istatus, w_istatus, p_istatus
+logical :: return_now
real(r8) :: debug_location(3)
logical :: debug = .false. ! set to .true. to enable debug printout
-real(r8), dimension(ens_size) :: u, v, w, qr, qg, qs, rho, temp, precip_fall_speed
-integer, dimension(ens_size) :: u_istatus, v_istatus, w_istatus, qr_istatus, rho_istatus, temp_istatus, p_istatus
-logical :: return_now
if ( .not. module_initialized ) call initialize_module
@@ -1103,8 +1103,6 @@ subroutine get_expected_radar_ref(state_handle, ens_size, location, ref, istatus
integer, dimension(ens_size) :: qr_istatus, qg_istatus, qs_istatus
integer, dimension(ens_size) :: rho_istatus, temp_istatus
-real(r8) :: debug_location(3)
-logical :: debug = .false. ! set to .true. to enable debug printout
logical, save :: first_time = .true.
integer :: imem
logical :: return_now
diff --git a/observations/forward_operators/obs_def_tower_mod.f90 b/observations/forward_operators/obs_def_tower_mod.f90
index 5c6f437760..a0a2643c4d 100644
--- a/observations/forward_operators/obs_def_tower_mod.f90
+++ b/observations/forward_operators/obs_def_tower_mod.f90
@@ -87,7 +87,10 @@ module obs_def_tower_mod
use utilities_mod, only : register_module, E_ERR, E_MSG, error_handler, &
check_namelist_read, find_namelist_in_file, &
nmlfileunit, do_output, do_nml_file, do_nml_term, &
- nc_check, file_exist, is_longitude_between
+ file_exist, is_longitude_between
+
+use netcdf_utilities_mod, only : nc_check
+
use ensemble_manager_mod, only : ensemble_type
use typesizes
diff --git a/observations/forward_operators/obs_def_upper_atm_mod.f90 b/observations/forward_operators/obs_def_upper_atm_mod.f90
index 28ee041738..12061e04a0 100644
--- a/observations/forward_operators/obs_def_upper_atm_mod.f90
+++ b/observations/forward_operators/obs_def_upper_atm_mod.f90
@@ -46,12 +46,14 @@
! SAT_F107, QTY_1D_PARAMETER, COMMON_CODE
! SAT_RHO, QTY_DENSITY
! GPS_PROFILE, QTY_ELECTRON_DENSITY, COMMON_CODE
-! COSMIC_ELECTRON_DENSITY, QTY_ELECTRON_DENSITY, COMMON_CODE
+! COSMIC_ELECTRON_DENSITY, QTY_ELECTRON_DENSITY
! GND_GPS_VTEC, QTY_GND_GPS_VTEC
! CHAMP_DENSITY, QTY_DENSITY
! MIDAS_TEC, QTY_VERTICAL_TEC
! SSUSI_O_N2_RATIO, QTY_O_N2_COLUMN_DENSITY_RATIO
! GPS_VTEC_EXTRAP, QTY_VERTICAL_TEC, COMMON_CODE
+! SABER_TEMPERATURE, QTY_TEMPERATURE, COMMON_CODE
+! AURAMLS_TEMPERATURE, QTY_TEMPERATURE, COMMON_CODE
! END DART PREPROCESS KIND LIST
! BEGIN DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
@@ -59,6 +61,7 @@
! use obs_def_upper_atm_mod, only : get_expected_gnd_gps_vtec
! use obs_def_upper_atm_mod, only : get_expected_vtec
! use obs_def_upper_atm_mod, only : get_expected_O_N2_ratio
+! use obs_def_upper_atm_mod, only : get_expected_electron_density
! END DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
! BEGIN DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
@@ -72,6 +75,8 @@
! call get_expected_gnd_gps_vtec(state_handle, ens_size, location, expected_obs, istatus)
! case(SSUSI_O_N2_RATIO)
! call get_expected_O_N2_ratio(state_handle, ens_size, location, expected_obs, istatus)
+! case(COSMIC_ELECTRON_DENSITY)
+! call get_expected_electron_density(state_handle, ens_size, location, expected_obs, istatus)
! END DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
! BEGIN DART PREPROCESS READ_OBS_DEF
@@ -85,6 +90,8 @@
! continue
! case(SSUSI_O_N2_RATIO)
! continue
+! case(COSMIC_ELECTRON_DENSITY)
+! continue
! END DART PREPROCESS READ_OBS_DEF
! BEGIN DART PREPROCESS WRITE_OBS_DEF
@@ -98,6 +105,8 @@
! continue
! case(SSUSI_O_N2_RATIO)
! continue
+! case(COSMIC_ELECTRON_DENSITY)
+! continue
! END DART PREPROCESS WRITE_OBS_DEF
! BEGIN DART PREPROCESS INTERACTIVE_OBS_DEF
@@ -111,6 +120,8 @@
! continue
! case(SSUSI_O_N2_RATIO)
! continue
+! case(COSMIC_ELECTRON_DENSITY)
+! continue
! END DART PREPROCESS INTERACTIVE_OBS_DEF
! BEGIN DART PREPROCESS MODULE CODE
@@ -122,11 +133,14 @@ module obs_def_upper_atm_mod
VERTISHEIGHT, VERTISLEVEL
use assim_model_mod, only : interpolate
use obs_kind_mod, only : QTY_ATOMIC_OXYGEN_MIXING_RATIO, &
+ QTY_ATOMIC_H_MIXING_RATIO, &
+ QTY_ION_O_MIXING_RATIO, &
QTY_MOLEC_OXYGEN_MIXING_RATIO, &
QTY_TEMPERATURE, &
QTY_PRESSURE, &
QTY_DENSITY, &
QTY_DENSITY_ION_E, &
+ QTY_ELECTRON_DENSITY, &
QTY_GND_GPS_VTEC, &
QTY_GEOPOTENTIAL_HEIGHT, &
QTY_GEOMETRIC_HEIGHT, &
@@ -139,7 +153,8 @@ module obs_def_upper_atm_mod
public :: get_expected_upper_atm_density, &
get_expected_gnd_gps_vtec, &
get_expected_vtec, &
- get_expected_O_N2_ratio
+ get_expected_O_N2_ratio, &
+ get_expected_electron_density
! version controlled file description for error handling, do not edit
character(len=256), parameter :: source = &
@@ -149,12 +164,16 @@ module obs_def_upper_atm_mod
logical, save :: module_initialized = .false.
-real(r8), PARAMETER :: N2_molar_mass = 28.0_r8
-real(r8), PARAMETER :: O_molar_mass = 16.0_r8
-real(r8), PARAMETER :: O2_molar_mass = 32.0_r8
-real(r8), PARAMETER :: universal_gas_constant = 8314.0_r8 ! [J/K/kmol]
-integer, PARAMETER :: MAXLEVELS = 100 ! more than max levels expected in the model
+real(r8), parameter :: N2_molar_mass = 28.0_r8
+real(r8), parameter :: O_molar_mass = 16.0_r8
+real(r8), parameter :: O2_molar_mass = 32.0_r8
+real(r8), parameter :: H_molar_mass = 1.0_r8
+! WACCM-X; put into common/types_mod.f90?
+real(r8), parameter :: kboltz = 1.380648E-23_r8 ! [N*m/K]
+real(r8), parameter :: universal_gas_constant = 8314.0_r8 ! [J/K/kmol]
+real(r8), parameter :: molar_mass_dry_air = 28.9644_r8
+integer, parameter :: MAXLEVELS = 300 ! more than max levels expected in the model (waccm-x has 126)
character(len=512) :: string1, string2, string3
contains
@@ -265,7 +284,6 @@ subroutine get_expected_gnd_gps_vtec(state_handle, ens_size, location, obs_val,
if ( .not. module_initialized ) call initialize_module
istatus = 0 ! must be 0 to use track_status()
-obs_val = MISSING_R8
loc_vals = get_location(location)
@@ -277,9 +295,8 @@ subroutine get_expected_gnd_gps_vtec(state_handle, ens_size, location, obs_val,
if (iAlt > size(ALT)) then
write(string1,'(''more than '',i4,'' levels in the model.'')') MAXLEVELS
string2='increase MAXLEVELS in obs_def_upper_atm_mod.f90, rerun preprocess and recompile.'
- string3='increase ALT, IDensityS_ie array sizes in code and recompile'
call error_handler(E_ERR, 'get_expected_gnd_gps_vtec', string1, &
- source, revision, revdate, text2=string2, text3=string3)
+ source, revision, revdate, text2=string2)
endif
! At each altitude interpolate the 2D IDensityS_ie to the lon-lat where data
@@ -298,8 +315,14 @@ subroutine get_expected_gnd_gps_vtec(state_handle, ens_size, location, obs_val,
nAlts = nAlts+1
enddo LEVELS
-if (nAlts == 0) return
+! failed first time through loop - no values to return.
+if (nAlts == 0) then
+ obs_val(:) = MISSING_R8
+ return
+endif
+! clear the error from the last level and start again?
+istatus(:) = 0
tec=0.0_r8 !start with zero for the summation
do iAlt = 1, nAlts-1 !approximate the integral over the altitude as a sum of trapezoids
@@ -310,7 +333,6 @@ subroutine get_expected_gnd_gps_vtec(state_handle, ens_size, location, obs_val,
where (istatus == 0) &
obs_val = tec * 10.0**(-16) !units of TEC are "10^16" #electron/m^2 instead of just "1" #electron/m^2
-! return code set by track_status
end subroutine get_expected_gnd_gps_vtec
@@ -380,7 +402,7 @@ subroutine get_expected_O_N2_ratio(state_handle, ens_size, location, obs_val, is
real(r8), allocatable :: total_number_density(:, :)
real(r8), allocatable :: O_number_density(:, :)
-real(r8), PARAMETER :: k_constant = 1.381e-23_r8 ! m^2 * kg / s^2 / K
+real(r8), parameter :: k_constant = 1.381e-23_r8 ! m^2 * kg / s^2 / K
integer :: ilayer, nlevels, nilevels
integer :: this_istatus(ens_size)
real(r8) :: layerfraction(ens_size)
@@ -388,7 +410,6 @@ subroutine get_expected_O_N2_ratio(state_handle, ens_size, location, obs_val, is
if ( .not. module_initialized ) call initialize_module
istatus = 0
-obs_val = MISSING_R8
call error_handler(E_ERR, 'get_expected_O_N2_ratio', 'routine not tested', &
source, revision, revdate, &
@@ -406,6 +427,10 @@ subroutine get_expected_O_N2_ratio(state_handle, ens_size, location, obs_val, is
nilevels = 0
heights = 0.0_r8
+!>@todo FIXME: this is setting the same location for VERTISLEVEL
+!> as the loop below, so one can *not* be filling the interfaces and
+!> the other filling the midpoints.
+
FILLINTERFACES : do ilayer = 1,MAXLEVELS
loc = set_location(loc_lon, loc_lat, real(ilayer,r8), VERTISLEVEL)
@@ -418,7 +443,10 @@ subroutine get_expected_O_N2_ratio(state_handle, ens_size, location, obs_val, is
enddo FILLINTERFACES
-if (nilevels == 0) return
+if (nilevels == 0) then
+ obs_val(:) = missing_r8
+ return
+endif
istatus(:) = 0
thickness = 0.0_r8
@@ -428,7 +456,8 @@ subroutine get_expected_O_N2_ratio(state_handle, ens_size, location, obs_val, is
nlevels = 0
-FILLMIDPOINTS : do ilayer = 1,MAXLEVELS
+!>@todo FIXME: don't we know how many layers there are now?
+FILLMIDPOINTS : do ilayer = 1, MAXLEVELS
loc = set_location(loc_lon, loc_lat, real(ilayer,r8), VERTISLEVEL)
@@ -452,7 +481,10 @@ subroutine get_expected_O_N2_ratio(state_handle, ens_size, location, obs_val, is
enddo FILLMIDPOINTS
-if (nlevels == 0) return
+if (nlevels == 0) then
+ obs_val(:) = missing_r8
+ return
+endif
! Check to make sure we have more interfaces than layers.
!>@todo should this be an error instead of a message?
@@ -539,6 +571,96 @@ subroutine get_expected_O_N2_ratio(state_handle, ens_size, location, obs_val, is
end subroutine get_expected_O_N2_ratio
+!-----------------------------------------------------------------------------
+!> Common interface for electron density forward operators.
+!> If there is a variable in the DART state that is the electron density, just use it.
+!> If it doesn't exist, try the forward operator from WACCM-X, and return that error code.
+!> May be extended to handle other methods of computing electron density.
+
+subroutine get_expected_electron_density(state_handle, ens_size, location, obs_val, istatus)
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+integer, intent(out) :: istatus(ens_size)
+real(r8), intent(out) :: obs_val(ens_size)
+
+call interpolate(state_handle, ens_size, location, QTY_ELECTRON_DENSITY, obs_val, istatus)
+if (any(istatus == 0)) return
+
+call get_expected_oxygen_ion_density(state_handle, ens_size, location, obs_val, istatus)
+
+end subroutine get_expected_electron_density
+
+
+!-----------------------------------------------------------------------------
+!> Given DART state vector and a location, it computes O+ density [1/cm^3].
+!> The istatus variable should be returned as 0 unless there is a problem.
+!> This function was implemented for WACCM-X.
+!> Check the units for use with other models.
+
+subroutine get_expected_oxygen_ion_density(state_handle, ens_size, location, obs_val, istatus)
+type(ensemble_type), intent(in) :: state_handle
+integer, intent(in) :: ens_size
+type(location_type), intent(in) :: location
+integer, intent(out) :: istatus(ens_size)
+real(r8), intent(out) :: obs_val(ens_size)
+
+real(r8), dimension(ens_size) :: mmr_o1, mmr_o2, mmr_n2, mmr_h1, mmr_op ! mass mixing ratio
+real(r8), dimension(ens_size) :: mbar, pressure, temperature
+integer, dimension(ens_size) :: this_istatus
+real(r8), dimension(3) :: loc_vals
+logical :: return_now
+
+istatus = 0 ! Need to have istatus = 0 for track_status()
+
+! cam-fv returns volume mixing ratio, not mass mixing ratio. undo for computation below.
+call interpolate(state_handle, ens_size, location, QTY_ATOMIC_OXYGEN_MIXING_RATIO, mmr_o1, this_istatus)
+call track_status(ens_size, this_istatus, obs_val, istatus, return_now)
+if (return_now) return
+mmr_o1 = mmr_o1 / (molar_mass_dry_air/O_molar_mass)
+
+call interpolate(state_handle, ens_size, location, QTY_MOLEC_OXYGEN_MIXING_RATIO, mmr_o2, this_istatus)
+call track_status(ens_size, this_istatus, obs_val, istatus, return_now)
+if (return_now) return
+mmr_o2 = mmr_o2 / (molar_mass_dry_air/O2_molar_mass)
+
+call interpolate(state_handle, ens_size, location, QTY_ATOMIC_H_MIXING_RATIO, mmr_h1, this_istatus)
+call track_status(ens_size, this_istatus, obs_val, istatus, return_now)
+if (return_now) return
+mmr_h1 = mmr_h1 / (molar_mass_dry_air/H_molar_mass)
+
+call interpolate(state_handle, ens_size, location, QTY_ION_O_MIXING_RATIO, mmr_op, this_istatus)
+call track_status(ens_size, this_istatus, obs_val, istatus, return_now)
+if (return_now) return
+
+call interpolate(state_handle, ens_size, location, QTY_PRESSURE, pressure, this_istatus)
+call track_status(ens_size, this_istatus, obs_val, istatus, return_now)
+if (return_now) return
+
+call interpolate(state_handle, ens_size, location, QTY_TEMPERATURE, temperature, this_istatus)
+call track_status(ens_size, this_istatus, obs_val, istatus, return_now)
+if (return_now) return
+
+!------------------------------------------------------------------------------------------------------
+! Need to get number density (cgs units) from mass mixing ratio (kg/kg).
+! mbar is g/mole, same as rMass units
+! kg/kg * (g/mole)/(g/mole) * (Pa = N/m^2)/((Joules/K = N*m/K) * (K)) = m-3 * 1E-06 = cm-3
+!------------------------------------------------------------------------------------------------------
+! WACCM-X .i file pressure unit is Pa
+
+loc_vals = get_location(location)
+
+where (istatus == 0)
+ mmr_n2 = 1.0_r8 - (mmr_o1 + mmr_o2 + mmr_h1)
+ mbar = 1.0_r8/( mmr_o1/O_molar_mass &
+ + mmr_o2/O2_molar_mass &
+ + mmr_h1/H_molar_mass &
+ + mmr_n2/N2_molar_mass)
+ obs_val = mmr_op * mbar/O_molar_mass * pressure/(kboltz * temperature) * 1.E-06_r8
+end where
+
+end subroutine get_expected_oxygen_ion_density
+
end module obs_def_upper_atm_mod
! END DART PREPROCESS MODULE CODE
diff --git a/observations/obs_converters/AIRS/AIRS.html b/observations/obs_converters/AIRS/AIRS.html
index b51e6746a7..e8717deee2 100644
--- a/observations/obs_converters/AIRS/AIRS.html
+++ b/observations/obs_converters/AIRS/AIRS.html
@@ -254,11 +254,15 @@
PROGRAMS
-ftp edhs1.gsfc.nasa.gov
-# (log in as 'anonymous' and your email as the password)
-cd /edhs/hdfeos/latest_release
-mget *
-quit
+wget https://observer.gsfc.nasa.gov/ftp/edhs/hdfeos/latest_release/*
+
+# NOTE: direct ftp does not work for me anymore
+
+##ftp edhs1.gsfc.nasa.gov
+### (log in as 'anonymous' and your email as the password)
+##cd /edhs/hdfeos/latest_release
+##mget *
+##quit
# mar 2013, the dir contents:
#
@@ -272,7 +276,15 @@
PROGRAMS
#
# (i skipped a 'windows' dir).
#
-
+# mar 2019 contents:
+# HDF-EOS2.20v1.00.tar.Z 08-Jan-2018 15:21 7.3M
+# HDF-EOS2.20v1.00_Tes..> 08-Jan-2018 15:21 9.5M
+# HDF-EOS_REF.pdf 07-Nov-2018 13:45 695K
+# HDF-EOS_UG.pdf 08-Jan-2018 15:28 429K
+# hdf-4.2.13.tar.gz 08-Jan-2018 15:14 4.3M
+# jpegsrc.v9b.tar.gz 09-Jan-2018 13:44 1.0M
+# zlib-1.2.11.tar.gz 08-Jan-2018 15:22 593K
+#
for i in *.tar.gz
do
tar -zxvf $i
@@ -285,7 +297,7 @@
PROGRAMS
echo zlib:
-cd zlib-1.2.5
+cd zlib-1.2.11
./configure --prefix=/glade/p/work/nancy
make
make test
@@ -293,7 +305,7 @@
PROGRAMS
echo jpeg:
-cd jpeg-6b
+cd jpeg-9b
./configure --prefix=/glade/p/work/nancy
make
make test
@@ -305,7 +317,7 @@
PROGRAMS
echo hdf:
-cd hdf-4.2.6
+cd hdf-4.2.13
./configure --prefix=/glade/p/work/nancy
# (it found zlib and jpeg, from the install prefix i guess)
make
@@ -329,17 +341,9 @@
PROGRAMS
echo edit mkmf_convert_airs_L2 to have all the base paths
echo be /glade/p/work/nancy instead of whatever. make it look like:
echo ' '
-echo 'set JPGDIR = /glade/p/work/nancy'
-echo 'set JPGLIB = ${JPGDIR}/lib'
-echo 'set JPGINC = ${JPGDIR}/include'
-echo ' '
-echo 'set HDFDIR = /glade/p/work/nancy'
-echo 'set HDFLIB = ${HDFDIR}/lib'
-echo 'set HDFINC = ${HDFDIR}/include'
-echo ' '
-echo 'set EOSDIR = /glade/p/work/nancy'
-echo 'set EOSLIB = ${EOSDIR}/lib'
-echo 'set EOSINC = ${EOSDIR}/include'
+echo 'set JPGDIR = /glade/work/nancy'
+echo 'set HDFDIR = /glade/work/nancy'
+echo 'set EOSDIR = /glade/work/nancy'
echo ' '
./quickbuild.csh
diff --git a/observations/obs_converters/AIRS/airs_JPL_mod.f90 b/observations/obs_converters/AIRS/airs_JPL_mod.f90
index b81af30b90..2314215f0e 100644
--- a/observations/obs_converters/AIRS/airs_JPL_mod.f90
+++ b/observations/obs_converters/AIRS/airs_JPL_mod.f90
@@ -2,6 +2,12 @@
! DART $Id$
! adapted from original JPL code, example AIRS readers
+!
+! updated for version 6 of the AIRS data formats
+! added fields needed to support radiances
+! removed unused items to streamline the code.
+!
+! april 2019, nsc
module airs_JPL_mod
@@ -30,22 +36,6 @@ module airs_JPL_mod
parameter(AIRS_RET_AIRSTRACK = 3)
integer AIRS_RET_CLOUD
parameter(AIRS_RET_CLOUD = 2)
- integer AIRS_RET_CHANAMSUA
- parameter(AIRS_RET_CHANAMSUA = 15)
- integer AIRS_RET_CHANHSB
- parameter(AIRS_RET_CHANHSB = 5)
- integer AIRS_RET_MWHINGESURF
- parameter(AIRS_RET_MWHINGESURF = 7)
- integer AIRS_RET_H2OFUNC
- parameter(AIRS_RET_H2OFUNC = 11)
- integer AIRS_RET_O3FUNC
- parameter(AIRS_RET_O3FUNC = 9)
- integer AIRS_RET_COFUNC
- parameter(AIRS_RET_COFUNC = 9)
- integer AIRS_RET_CH4FUNC
- parameter(AIRS_RET_CH4FUNC = 7)
- integer AIRS_RET_HINGESURF
- parameter(AIRS_RET_HINGESURF = 100)
integer AIRS_RET_H2OPRESSURELEV
parameter(AIRS_RET_H2OPRESSURELEV = 15)
integer AIRS_RET_H2OPRESSURELAY
@@ -55,54 +45,15 @@ module airs_JPL_mod
type airs_granule_type
! Attributes
- integer*2 NumSO2FOVs
- character*256 processing_level
- character*256 instrument
- character*256 DayNightFlag
- character*256 AutomaticQAFlag
- integer NumTotalData
- integer NumProcessData
- integer NumSpecialData
- integer NumBadData
- integer NumMissingData
integer NumLandSurface
integer NumOceanSurface
- character*256 node_type
integer start_year
integer start_month
integer start_day
integer start_hour
integer start_minute
real start_sec
- integer start_orbit
- integer end_orbit
- integer orbit_path
- integer start_orbit_row
- integer end_orbit_row
integer granule_number
- integer num_scansets
- integer num_scanlines
- real*8 start_Latitude
- real*8 start_Longitude
- real*8 start_Time
- real*8 end_Latitude
- real*8 end_Longitude
- real*8 end_Time
- real eq_x_longitude
- real*8 eq_x_tai
- integer orbitgeoqa
- integer*2 num_satgeoqa
- integer*2 num_glintgeoqa
- integer*2 num_moongeoqa
- integer*2 num_ftptgeoqa
- integer*2 num_zengeoqa
- integer*2 num_demgeoqa
- integer*2 num_fpe
- integer*2 LonGranuleCen
- integer*2 LatGranuleCen
- integer*2 LocTimeGranuleCen
- character*256 CO_first_guess
- character*256 CH4_first_guess
! Geolocation fields
real*8 Latitude(AIRS_RET_GEOXTRACK, &
@@ -113,18 +64,6 @@ module airs_JPL_mod
AIRS_RET_GEOTRACK)
! Data Fields
- integer*2 RetQAFlag( 30, 45)
- real satheight( 45)
- real satroll( 45)
- real satpitch( 45)
- real satyaw( 45)
- integer satgeoqa( 45)
- integer*2 glintgeoqa( 45)
- integer*2 moongeoqa( 45)
- integer ftptgeoqa( 30, 45)
- integer*2 zengeoqa( 30, 45)
- integer*2 demgeoqa( 30, 45)
- real*8 nadirTAI( 45)
real*8 sat_lat( 45)
real*8 sat_lon( 45)
byte scan_node_type( 45)
@@ -141,84 +80,31 @@ module airs_JPL_mod
real landFrac_err( 30, 45)
real pressStd( 28)
real pressH2O( 15)
- real MWHingeSurfFreqGHz( 7)
real latAIRS( 3, 3, 30, 45)
real lonAIRS( 3, 3, 30, 45)
integer*2 Qual_Guess_PSurf( 30, 45)
real PSurfStd( 30, 45)
integer nSurfStd( 30, 45)
- real Press_mid_top_bndry( 30, 45)
- integer*2 nStd_mid_top_bndry( 30, 45)
- real Press_bot_mid_bndry( 30, 45)
- integer*2 nStd_bot_mid_bndry( 30, 45)
real PBest( 30, 45)
real PGood( 30, 45)
integer*2 nBestStd( 30, 45)
integer*2 nGoodStd( 30, 45)
- integer*2 Qual_Temp_Profile_Top( 30, 45)
- integer*2 Qual_Temp_Profile_Mid( 30, 45)
- integer*2 Qual_Temp_Profile_Bot( 30, 45)
real TAirStd( 28, 30, 45)
real TAirStdErr( 28, 30, 45)
+ integer*2 TAirStd_QC( 28, 30, 45)
real TSurfAir( 30, 45)
real TSurfAirErr( 30, 45)
+ integer*2 TSurfAir_QC( 30, 45)
integer*2 Qual_Surf( 30, 45)
real TSurfStd( 30, 45)
real TSurfStdErr( 30, 45)
- integer*2 numHingeSurf( 30, 45)
- real freqEmis( 100, 30, 45)
- real emisIRStd( 100, 30, 45)
- real emisIRStdErr( 100, 30, 45)
- integer*2 Qual_MW_Only_Temp_Strat( 30, 45)
- integer*2 Qual_MW_Only_Temp_Tropo( 30, 45)
- real TAirMWOnlyStd( 28, 30, 45)
- byte MWSurfClass( 30, 45)
- real sfcTbMWStd( 7, 30, 45)
- real EmisMWStd( 7, 30, 45)
- real EmisMWStdErr( 7, 30, 45)
- integer*2 Qual_MW_Only_H2O( 30, 45)
- real totH2OMWOnlyStd( 30, 45)
integer*2 Qual_H2O( 30, 45)
real H2OMMRStd( 14, 30, 45)
real H2OMMRStdErr( 14, 30, 45)
+ integer*2 H2OMMRStd_QC( 14, 30, 45)
real totH2OStd( 30, 45)
real totH2OStdErr( 30, 45)
- real H2OMMRSat( 14, 30, 45)
- real H2OMMRSat_liquid( 14, 30, 45)
- integer*2 num_H2O_Func( 30, 45)
- real H2O_verticality( 11, 30, 45)
- integer*2 Qual_O3( 30, 45)
- real totO3Std( 30, 45)
- real totO3StdErr( 30, 45)
- real O3VMRStd( 28, 30, 45)
- real O3VMRStdErr( 28, 30, 45)
- integer*2 num_O3_Func( 30, 45)
- real O3_verticality( 9, 30, 45)
- integer*2 Qual_CO( 30, 45)
- real CO_total_column( 30, 45)
- integer*2 num_CO_Func( 30, 45)
- integer CO_trapezoid_layers( 9)
- real CO_eff_press( 9, 30, 45)
- real CO_VMR_eff( 9, 30, 45)
- real CO_VMR_eff_err( 9, 30, 45)
- real CO_verticality( 9, 30, 45)
- real CO_dof( 30, 45)
- integer*2 Qual_CH4( 30, 45)
- real CH4_total_column( 30, 45)
- integer*2 num_CH4_Func( 30, 45)
- integer CH4_trapezoid_layers( 7)
- real CH4_eff_press( 7, 30, 45)
- real CH4_VMR_eff( 7, 30, 45)
- real CH4_VMR_eff_err( 7, 30, 45)
- real CH4_verticality( 7, 30, 45)
- real CH4_dof( 30, 45)
- real PTropopause( 30, 45)
- real T_Tropopause( 30, 45)
- real GP_Tropopause( 30, 45)
- real GP_Height( 28, 30, 45)
- real GP_Height_MWOnly( 28, 30, 45)
- real GP_Surface( 30, 45)
- integer*2 Qual_Cloud_OLR( 30, 45)
+ integer*2 totH2OStd_QC( 30, 45)
integer numCloud( 30, 45)
real TCldTopStd( 2, 30, 45)
real TCldTopStdErr( 2, 30, 45)
@@ -226,39 +112,8 @@ module airs_JPL_mod
real PCldTopStdErr( 2, 30, 45)
real CldFrcStd( 2, 3, 3, 30, 45)
real CldFrcStdErr( 2, 3, 3, 30, 45)
- real olr( 30, 45)
- real olr_err( 30, 45)
- integer*2 Qual_clrolr( 30, 45)
- real clrolr( 30, 45)
- real clrolr_err( 30, 45)
- integer*2 dust_flag( 3, 3, 30, 45)
- integer*2 spectral_clear_indicator( 3, 3, 30, 45)
- integer*2 num_clear_spectral_indicator( 30, 45)
- real CC_noise_eff_amp_factor( 30, 45)
- real CC1_noise_eff_amp_factor( 30, 45)
real totCldH2OStd( 30, 45)
real totCldH2OStdErr( 30, 45)
- real CC1_Resid( 30, 45)
- real CCfinal_Resid( 30, 45)
- real CCfinal_Noise_Amp( 30, 45)
- real Tdiff_IR_MW_ret( 30, 45)
- real Tdiff_IR_4CC1( 30, 45)
- real TSurfdiff_IR_4CC1( 30, 45)
- real TSurfdiff_IR_4CC2( 30, 45)
- real AMSU_Chans_Resid( 30, 45)
- real TotCld_4_CCfinal( 30, 45)
- real Surf_Resid_Ratio( 30, 45)
- real Temp_Resid_Ratio( 30, 45)
- real Water_Resid_Ratio( 30, 45)
- real Cloud_Resid_Ratio( 30, 45)
- real O3_Resid_Ratio( 30, 45)
- real CO_Resid_Ratio( 30, 45)
- real CH4_Resid_Ratio( 30, 45)
- real MWCheck_Resid_Ratio( 30, 45)
- real O3_dof( 30, 45)
- byte all_spots_avg( 30, 45)
- byte MW_ret_used( 30, 45)
- real Initial_CC_score( 30, 45)
byte retrieval_type( 30, 45)
byte Startup( 30, 45)
END type airs_granule_type
@@ -277,27 +132,28 @@ module airs_JPL_mod
! Problems reading individual attributes or fields are reported to
! the console but do not interrupt program flow.
- subroutine airs_ret_rdr(file_name, airs_ret_gran)
- character(len=*), intent(in) :: file_name(:)
- type(airs_granule_type) :: airs_ret_gran
-
- integer statn ! HDF-EOS status. 0 for success
- integer fid ! HDF-EOS file ID
- integer swid ! HDF-EOS swath ID
- integer nchar ! Number of characters
- character*256 swathname ! Name of swath
- integer nswath ! Number of swaths
- integer start(10) /0,0,0,0,0, 0,0,0,0,0/
+ subroutine airs_ret_rdr(file_name, airs_ret_gran, ver)
+ character(len=*), intent(in) :: file_name
+ type(airs_granule_type), intent(out) :: airs_ret_gran
+ integer, intent(in) :: ver
+
+ integer :: statn ! HDF-EOS status. 0 for success
+ integer :: fid ! HDF-EOS file ID
+ integer :: swid ! HDF-EOS swath ID
+ integer :: nchar ! Number of characters
+ character*256 :: swathname ! Name of swath
+ integer :: nswath ! Number of swaths
+ integer :: start(10) = (/0,0,0,0,0, 0,0,0,0,0/)
! start of each dimensions for Swath I/O
! 0 => start with first element
- integer stride(10)/1,1,1,1,1, 1,1,1,1,1/
+ integer :: stride(10) = (/1,1,1,1,1, 1,1,1,1,1/)
! stride of each dimensions for Swath I/O
! 1 => use every element
- integer edge(10) ! size of each dimension for swath I/O
+ integer :: edge(10) ! size of each dimension for swath I/O
! will be set for each individual read
- integer swopen, swinqswath, swattach
- integer swrdfld, swrdattr
- integer swdetach, swclose
+ integer :: swopen, swinqswath, swattach
+ integer :: swrdfld, swrdattr
+ integer :: swdetach, swclose
fid = swopen(file_name, 1)
if (fid .eq. -1) then
@@ -331,66 +187,6 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
end if
! Attributes
- statn = swrdattr(swid, "NumSO2FOVs", &
- airs_ret_gran%NumSO2FOVs)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "NumSO2FOVs"
-
- statn = swrdattr(swid, "processing_level", &
- airs_ret_gran%processing_level)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "processing_level"
-
- statn = swrdattr(swid, "instrument", &
- airs_ret_gran%instrument)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "instrument"
-
- statn = swrdattr(swid, "DayNightFlag", &
- airs_ret_gran%DayNightFlag)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "DayNightFlag"
-
- statn = swrdattr(swid, "AutomaticQAFlag", &
- airs_ret_gran%AutomaticQAFlag)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "AutomaticQAFlag"
-
- statn = swrdattr(swid, "NumTotalData", &
- airs_ret_gran%NumTotalData)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "NumTotalData"
-
- statn = swrdattr(swid, "NumProcessData", &
- airs_ret_gran%NumProcessData)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "NumProcessData"
-
- statn = swrdattr(swid, "NumSpecialData", &
- airs_ret_gran%NumSpecialData)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "NumSpecialData"
-
- statn = swrdattr(swid, "NumBadData", &
- airs_ret_gran%NumBadData)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "NumBadData"
-
- statn = swrdattr(swid, "NumMissingData", &
- airs_ret_gran%NumMissingData)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "NumMissingData"
-
statn = swrdattr(swid, "NumLandSurface", &
airs_ret_gran%NumLandSurface)
if (statn .ne. 0) &
@@ -403,12 +199,6 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading attribute ", &
"NumOceanSurface"
- statn = swrdattr(swid, "node_type", &
- airs_ret_gran%node_type)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "node_type"
-
statn = swrdattr(swid, "start_year", &
airs_ret_gran%start_year)
if (statn .ne. 0) &
@@ -445,181 +235,12 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading attribute ", &
"start_sec"
- statn = swrdattr(swid, "start_orbit", &
- airs_ret_gran%start_orbit)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "start_orbit"
-
- statn = swrdattr(swid, "end_orbit", &
- airs_ret_gran%end_orbit)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "end_orbit"
-
- statn = swrdattr(swid, "orbit_path", &
- airs_ret_gran%orbit_path)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "orbit_path"
-
- statn = swrdattr(swid, "start_orbit_row", &
- airs_ret_gran%start_orbit_row)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "start_orbit_row"
-
- statn = swrdattr(swid, "end_orbit_row", &
- airs_ret_gran%end_orbit_row)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "end_orbit_row"
-
statn = swrdattr(swid, "granule_number", &
airs_ret_gran%granule_number)
if (statn .ne. 0) &
print *, "Error ", statn, " reading attribute ", &
"granule_number"
- statn = swrdattr(swid, "num_scansets", &
- airs_ret_gran%num_scansets)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "num_scansets"
-
- statn = swrdattr(swid, "num_scanlines", &
- airs_ret_gran%num_scanlines)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "num_scanlines"
-
- statn = swrdattr(swid, "start_Latitude", &
- airs_ret_gran%start_Latitude)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "start_Latitude"
-
- statn = swrdattr(swid, "start_Longitude", &
- airs_ret_gran%start_Longitude)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "start_Longitude"
-
- statn = swrdattr(swid, "start_Time", &
- airs_ret_gran%start_Time)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "start_Time"
-
- statn = swrdattr(swid, "end_Latitude", &
- airs_ret_gran%end_Latitude)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "end_Latitude"
-
- statn = swrdattr(swid, "end_Longitude", &
- airs_ret_gran%end_Longitude)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "end_Longitude"
-
- statn = swrdattr(swid, "end_Time", &
- airs_ret_gran%end_Time)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "end_Time"
-
- statn = swrdattr(swid, "eq_x_longitude", &
- airs_ret_gran%eq_x_longitude)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "eq_x_longitude"
-
- statn = swrdattr(swid, "eq_x_tai", &
- airs_ret_gran%eq_x_tai)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "eq_x_tai"
-
- statn = swrdattr(swid, "orbitgeoqa", &
- airs_ret_gran%orbitgeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "orbitgeoqa"
-
- statn = swrdattr(swid, "num_satgeoqa", &
- airs_ret_gran%num_satgeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "num_satgeoqa"
-
- statn = swrdattr(swid, "num_glintgeoqa", &
- airs_ret_gran%num_glintgeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "num_glintgeoqa"
-
- statn = swrdattr(swid, "num_moongeoqa", &
- airs_ret_gran%num_moongeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "num_moongeoqa"
-
- statn = swrdattr(swid, "num_ftptgeoqa", &
- airs_ret_gran%num_ftptgeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "num_ftptgeoqa"
-
- statn = swrdattr(swid, "num_zengeoqa", &
- airs_ret_gran%num_zengeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "num_zengeoqa"
-
- statn = swrdattr(swid, "num_demgeoqa", &
- airs_ret_gran%num_demgeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "num_demgeoqa"
-
- statn = swrdattr(swid, "num_fpe", &
- airs_ret_gran%num_fpe)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "num_fpe"
-
- statn = swrdattr(swid, "LonGranuleCen", &
- airs_ret_gran%LonGranuleCen)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "LonGranuleCen"
-
- statn = swrdattr(swid, "LatGranuleCen", &
- airs_ret_gran%LatGranuleCen)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "LatGranuleCen"
-
- statn = swrdattr(swid, "LocTimeGranuleCen", &
- airs_ret_gran%LocTimeGranuleCen)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "LocTimeGranuleCen"
-
- statn = swrdattr(swid, "CO_first_guess", &
- airs_ret_gran%CO_first_guess)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "CO_first_guess"
-
- statn = swrdattr(swid, "CH4_first_guess", &
- airs_ret_gran%CH4_first_guess)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading attribute ", &
- "CH4_first_guess"
-
-
! Geolocation fields
edge(1) = AIRS_RET_GEOXTRACK
edge(2) = AIRS_RET_GEOTRACK
@@ -640,106 +261,6 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
! Data Fields
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "RetQAFlag", &
- start, stride, edge, &
- airs_ret_gran%RetQAFlag)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "RetQAFlag"
-
- edge(1) = 45
- statn = SWrdfld(swid, "satheight", &
- start, stride, edge, &
- airs_ret_gran%satheight)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "satheight"
-
- edge(1) = 45
- statn = SWrdfld(swid, "satroll", &
- start, stride, edge, &
- airs_ret_gran%satroll)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "satroll"
-
- edge(1) = 45
- statn = SWrdfld(swid, "satpitch", &
- start, stride, edge, &
- airs_ret_gran%satpitch)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "satpitch"
-
- edge(1) = 45
- statn = SWrdfld(swid, "satyaw", &
- start, stride, edge, &
- airs_ret_gran%satyaw)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "satyaw"
-
- edge(1) = 45
- statn = SWrdfld(swid, "satgeoqa", &
- start, stride, edge, &
- airs_ret_gran%satgeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "satgeoqa"
-
- edge(1) = 45
- statn = SWrdfld(swid, "glintgeoqa", &
- start, stride, edge, &
- airs_ret_gran%glintgeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "glintgeoqa"
-
- edge(1) = 45
- statn = SWrdfld(swid, "moongeoqa", &
- start, stride, edge, &
- airs_ret_gran%moongeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "moongeoqa"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "ftptgeoqa", &
- start, stride, edge, &
- airs_ret_gran%ftptgeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "ftptgeoqa"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "zengeoqa", &
- start, stride, edge, &
- airs_ret_gran%zengeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "zengeoqa"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "demgeoqa", &
- start, stride, edge, &
- airs_ret_gran%demgeoqa)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "demgeoqa"
-
- edge(1) = 45
- statn = SWrdfld(swid, "nadirTAI", &
- start, stride, edge, &
- airs_ret_gran%nadirTAI)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "nadirTAI"
-
edge(1) = 45
statn = SWrdfld(swid, "sat_lat", &
start, stride, edge, &
@@ -877,14 +398,6 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"pressH2O"
- edge(1) = 7
- statn = SWrdfld(swid, "MWHingeSurfFreqGHz", &
- start, stride, edge, &
- airs_ret_gran%MWHingeSurfFreqGHz)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "MWHingeSurfFreqGHz"
-
edge(4) = 45
edge(3) = 30
edge(2) = 3
@@ -907,14 +420,18 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"lonAIRS"
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_Guess_PSurf", &
- start, stride, edge, &
- airs_ret_gran%Qual_Guess_PSurf)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_Guess_PSurf"
+ if (ver == 5) then
+ edge(2) = 45
+ edge(1) = 30
+ statn = SWrdfld(swid, "Qual_Guess_PSurf", &
+ start, stride, edge, &
+ airs_ret_gran%Qual_Guess_PSurf)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "Qual_Guess_PSurf"
+ else
+ airs_ret_gran%Qual_Guess_PSurf = -1
+ endif
edge(2) = 45
edge(1) = 30
@@ -934,42 +451,6 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"nSurfStd"
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Press_mid_top_bndry", &
- start, stride, edge, &
- airs_ret_gran%Press_mid_top_bndry)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Press_mid_top_bndry"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "nStd_mid_top_bndry", &
- start, stride, edge, &
- airs_ret_gran%nStd_mid_top_bndry)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "nStd_mid_top_bndry"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Press_bot_mid_bndry", &
- start, stride, edge, &
- airs_ret_gran%Press_bot_mid_bndry)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Press_bot_mid_bndry"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "nStd_bot_mid_bndry", &
- start, stride, edge, &
- airs_ret_gran%nStd_bot_mid_bndry)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "nStd_bot_mid_bndry"
-
edge(2) = 45
edge(1) = 30
statn = SWrdfld(swid, "PBest", &
@@ -1006,33 +487,6 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"nGoodStd"
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_Temp_Profile_Top", &
- start, stride, edge, &
- airs_ret_gran%Qual_Temp_Profile_Top)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_Temp_Profile_Top"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_Temp_Profile_Mid", &
- start, stride, edge, &
- airs_ret_gran%Qual_Temp_Profile_Mid)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_Temp_Profile_Mid"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_Temp_Profile_Bot", &
- start, stride, edge, &
- airs_ret_gran%Qual_Temp_Profile_Bot)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_Temp_Profile_Bot"
-
edge(3) = 45
edge(2) = 30
edge(1) = 28
@@ -1053,6 +507,20 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"TAirStdErr"
+ if (ver == 6) then
+ edge(3) = 45
+ edge(2) = 30
+ edge(1) = 28
+ statn = SWrdfld(swid, "TAirStd_QC", &
+ start, stride, edge, &
+ airs_ret_gran%TAirStd_QC)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "TAirStd_QC"
+ else
+ airs_ret_gran%TAirStd_QC = -1
+ endif
+
edge(2) = 45
edge(1) = 30
statn = SWrdfld(swid, "TSurfAir", &
@@ -1071,14 +539,31 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"TSurfAirErr"
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_Surf", &
- start, stride, edge, &
- airs_ret_gran%Qual_Surf)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_Surf"
+ if (ver == 6) then
+ edge(2) = 45
+ edge(1) = 30
+ statn = SWrdfld(swid, "TSurfAir_QC", &
+ start, stride, edge, &
+ airs_ret_gran%TSurfAir_QC)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "TSurfAir_QC"
+ else
+ airs_ret_gran%TSurfAir_QC = -1
+ endif
+
+ if (ver == 5) then
+ edge(2) = 45
+ edge(1) = 30
+ statn = SWrdfld(swid, "Qual_Surf", &
+ start, stride, edge, &
+ airs_ret_gran%Qual_Surf)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "Qual_Surf"
+ else
+ airs_ret_gran%Qual_Surf = -1
+ endif
edge(2) = 45
edge(1) = 30
@@ -1098,563 +583,144 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"TSurfStdErr"
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "numHingeSurf", &
- start, stride, edge, &
- airs_ret_gran%numHingeSurf)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "numHingeSurf"
+
+ if (ver == 5) then
+ edge(2) = 45
+ edge(1) = 30
+ statn = SWrdfld(swid, "Qual_H2O", &
+ start, stride, edge, &
+ airs_ret_gran%Qual_H2O)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "Qual_H2O"
+ else
+ airs_ret_gran%Qual_H2O = -1
+ endif
edge(3) = 45
edge(2) = 30
- edge(1) = 100
- statn = SWrdfld(swid, "freqEmis", &
+ edge(1) = 14
+ statn = SWrdfld(swid, "H2OMMRStd", &
start, stride, edge, &
- airs_ret_gran%freqEmis)
+ airs_ret_gran%H2OMMRStd)
if (statn .ne. 0) &
print *, "Error ", statn, " reading field ", &
- "freqEmis"
+ "H2OMMRStd"
edge(3) = 45
edge(2) = 30
- edge(1) = 100
- statn = SWrdfld(swid, "emisIRStd", &
+ edge(1) = 14
+ statn = SWrdfld(swid, "H2OMMRStdErr", &
start, stride, edge, &
- airs_ret_gran%emisIRStd)
+ airs_ret_gran%H2OMMRStdErr)
if (statn .ne. 0) &
print *, "Error ", statn, " reading field ", &
- "emisIRStd"
+ "H2OMMRStdErr"
- edge(3) = 45
- edge(2) = 30
- edge(1) = 100
- statn = SWrdfld(swid, "emisIRStdErr", &
- start, stride, edge, &
- airs_ret_gran%emisIRStdErr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "emisIRStdErr"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_MW_Only_Temp_Strat", &
- start, stride, edge, &
- airs_ret_gran%Qual_MW_Only_Temp_Strat)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_MW_Only_Temp_Strat"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_MW_Only_Temp_Tropo", &
- start, stride, edge, &
- airs_ret_gran%Qual_MW_Only_Temp_Tropo)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_MW_Only_Temp_Tropo"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 28
- statn = SWrdfld(swid, "TAirMWOnlyStd", &
- start, stride, edge, &
- airs_ret_gran%TAirMWOnlyStd)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "TAirMWOnlyStd"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "MWSurfClass", &
- start, stride, edge, &
- airs_ret_gran%MWSurfClass)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "MWSurfClass"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 7
- statn = SWrdfld(swid, "sfcTbMWStd", &
- start, stride, edge, &
- airs_ret_gran%sfcTbMWStd)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "sfcTbMWStd"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 7
- statn = SWrdfld(swid, "EmisMWStd", &
- start, stride, edge, &
- airs_ret_gran%EmisMWStd)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "EmisMWStd"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 7
- statn = SWrdfld(swid, "EmisMWStdErr", &
- start, stride, edge, &
- airs_ret_gran%EmisMWStdErr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "EmisMWStdErr"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_MW_Only_H2O", &
- start, stride, edge, &
- airs_ret_gran%Qual_MW_Only_H2O)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_MW_Only_H2O"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "totH2OMWOnlyStd", &
- start, stride, edge, &
- airs_ret_gran%totH2OMWOnlyStd)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "totH2OMWOnlyStd"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_H2O", &
- start, stride, edge, &
- airs_ret_gran%Qual_H2O)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_H2O"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 14
- statn = SWrdfld(swid, "H2OMMRStd", &
- start, stride, edge, &
- airs_ret_gran%H2OMMRStd)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "H2OMMRStd"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 14
- statn = SWrdfld(swid, "H2OMMRStdErr", &
- start, stride, edge, &
- airs_ret_gran%H2OMMRStdErr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "H2OMMRStdErr"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "totH2OStd", &
- start, stride, edge, &
- airs_ret_gran%totH2OStd)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "totH2OStd"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "totH2OStdErr", &
- start, stride, edge, &
- airs_ret_gran%totH2OStdErr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "totH2OStdErr"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 14
- statn = SWrdfld(swid, "H2OMMRSat", &
- start, stride, edge, &
- airs_ret_gran%H2OMMRSat)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "H2OMMRSat"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 14
- statn = SWrdfld(swid, "H2OMMRSat_liquid", &
- start, stride, edge, &
- airs_ret_gran%H2OMMRSat_liquid)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "H2OMMRSat_liquid"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "num_H2O_Func", &
- start, stride, edge, &
- airs_ret_gran%num_H2O_Func)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "num_H2O_Func"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 11
- statn = SWrdfld(swid, "H2O_verticality", &
- start, stride, edge, &
- airs_ret_gran%H2O_verticality)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "H2O_verticality"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_O3", &
- start, stride, edge, &
- airs_ret_gran%Qual_O3)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_O3"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "totO3Std", &
- start, stride, edge, &
- airs_ret_gran%totO3Std)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "totO3Std"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "totO3StdErr", &
- start, stride, edge, &
- airs_ret_gran%totO3StdErr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "totO3StdErr"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 28
- statn = SWrdfld(swid, "O3VMRStd", &
- start, stride, edge, &
- airs_ret_gran%O3VMRStd)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "O3VMRStd"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 28
- statn = SWrdfld(swid, "O3VMRStdErr", &
- start, stride, edge, &
- airs_ret_gran%O3VMRStdErr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "O3VMRStdErr"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "num_O3_Func", &
- start, stride, edge, &
- airs_ret_gran%num_O3_Func)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "num_O3_Func"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 9
- statn = SWrdfld(swid, "O3_verticality", &
- start, stride, edge, &
- airs_ret_gran%O3_verticality)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "O3_verticality"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_CO", &
- start, stride, edge, &
- airs_ret_gran%Qual_CO)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_CO"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CO_total_column", &
- start, stride, edge, &
- airs_ret_gran%CO_total_column)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CO_total_column"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "num_CO_Func", &
- start, stride, edge, &
- airs_ret_gran%num_CO_Func)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "num_CO_Func"
-
- edge(1) = 9
- statn = SWrdfld(swid, "CO_trapezoid_layers", &
- start, stride, edge, &
- airs_ret_gran%CO_trapezoid_layers)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CO_trapezoid_layers"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 9
- statn = SWrdfld(swid, "CO_eff_press", &
- start, stride, edge, &
- airs_ret_gran%CO_eff_press)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CO_eff_press"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 9
- statn = SWrdfld(swid, "CO_VMR_eff", &
- start, stride, edge, &
- airs_ret_gran%CO_VMR_eff)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CO_VMR_eff"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 9
- statn = SWrdfld(swid, "CO_VMR_eff_err", &
- start, stride, edge, &
- airs_ret_gran%CO_VMR_eff_err)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CO_VMR_eff_err"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 9
- statn = SWrdfld(swid, "CO_verticality", &
- start, stride, edge, &
- airs_ret_gran%CO_verticality)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CO_verticality"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CO_dof", &
- start, stride, edge, &
- airs_ret_gran%CO_dof)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CO_dof"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_CH4", &
- start, stride, edge, &
- airs_ret_gran%Qual_CH4)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_CH4"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CH4_total_column", &
- start, stride, edge, &
- airs_ret_gran%CH4_total_column)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CH4_total_column"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "num_CH4_Func", &
- start, stride, edge, &
- airs_ret_gran%num_CH4_Func)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "num_CH4_Func"
-
- edge(1) = 7
- statn = SWrdfld(swid, "CH4_trapezoid_layers", &
- start, stride, edge, &
- airs_ret_gran%CH4_trapezoid_layers)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CH4_trapezoid_layers"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 7
- statn = SWrdfld(swid, "CH4_eff_press", &
- start, stride, edge, &
- airs_ret_gran%CH4_eff_press)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CH4_eff_press"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 7
- statn = SWrdfld(swid, "CH4_VMR_eff", &
- start, stride, edge, &
- airs_ret_gran%CH4_VMR_eff)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CH4_VMR_eff"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 7
- statn = SWrdfld(swid, "CH4_VMR_eff_err", &
- start, stride, edge, &
- airs_ret_gran%CH4_VMR_eff_err)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CH4_VMR_eff_err"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 7
- statn = SWrdfld(swid, "CH4_verticality", &
- start, stride, edge, &
- airs_ret_gran%CH4_verticality)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CH4_verticality"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CH4_dof", &
- start, stride, edge, &
- airs_ret_gran%CH4_dof)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CH4_dof"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "PTropopause", &
- start, stride, edge, &
- airs_ret_gran%PTropopause)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "PTropopause"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "T_Tropopause", &
- start, stride, edge, &
- airs_ret_gran%T_Tropopause)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "T_Tropopause"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "GP_Tropopause", &
- start, stride, edge, &
- airs_ret_gran%GP_Tropopause)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "GP_Tropopause"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 28
- statn = SWrdfld(swid, "GP_Height", &
- start, stride, edge, &
- airs_ret_gran%GP_Height)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "GP_Height"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 28
- statn = SWrdfld(swid, "GP_Height_MWOnly", &
- start, stride, edge, &
- airs_ret_gran%GP_Height_MWOnly)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "GP_Height_MWOnly"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "GP_Surface", &
- start, stride, edge, &
- airs_ret_gran%GP_Surface)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "GP_Surface"
+ if (ver == 6) then
+ edge(3) = 45
+ edge(2) = 30
+ edge(1) = 14
+ statn = SWrdfld(swid, "H2OMMRStd_QC", &
+ start, stride, edge, &
+ airs_ret_gran%H2OMMRStd_QC)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "H2OMMRStd_QC"
+ else
+ airs_ret_gran%H2OMMRStd_QC = -1
+ endif
edge(2) = 45
edge(1) = 30
- statn = SWrdfld(swid, "Qual_Cloud_OLR", &
+ statn = SWrdfld(swid, "totH2OStd", &
start, stride, edge, &
- airs_ret_gran%Qual_Cloud_OLR)
+ airs_ret_gran%totH2OStd)
if (statn .ne. 0) &
print *, "Error ", statn, " reading field ", &
- "Qual_Cloud_OLR"
+ "totH2OStd"
edge(2) = 45
edge(1) = 30
- statn = SWrdfld(swid, "numCloud", &
- start, stride, edge, &
- airs_ret_gran%numCloud)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "numCloud"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 2
- statn = SWrdfld(swid, "TCldTopStd", &
- start, stride, edge, &
- airs_ret_gran%TCldTopStd)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "TCldTopStd"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 2
- statn = SWrdfld(swid, "TCldTopStdErr", &
- start, stride, edge, &
- airs_ret_gran%TCldTopStdErr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "TCldTopStdErr"
-
- edge(3) = 45
- edge(2) = 30
- edge(1) = 2
- statn = SWrdfld(swid, "PCldTopStd", &
+ statn = SWrdfld(swid, "totH2OStdErr", &
start, stride, edge, &
- airs_ret_gran%PCldTopStd)
+ airs_ret_gran%totH2OStdErr)
if (statn .ne. 0) &
print *, "Error ", statn, " reading field ", &
- "PCldTopStd"
+ "totH2OStdErr"
- edge(3) = 45
- edge(2) = 30
- edge(1) = 2
- statn = SWrdfld(swid, "PCldTopStdErr", &
- start, stride, edge, &
- airs_ret_gran%PCldTopStdErr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
+ if (ver == 6) then
+ edge(2) = 45
+ edge(1) = 30
+ statn = SWrdfld(swid, "totH2OStd_QC", &
+ start, stride, edge, &
+ airs_ret_gran%totH2OStd_QC)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "totH2OStd_QC"
+ else
+ airs_ret_gran%totH2OStd_QC = -1
+ endif
+
+ if (ver == 5) then
+ edge(2) = 45
+ edge(1) = 30
+ statn = SWrdfld(swid, "numCloud", &
+ start, stride, edge, &
+ airs_ret_gran%numCloud)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "numCloud"
+ else
+ airs_ret_gran%numCloud = -1
+ endif
+
+ if (ver == 5) then
+ edge(3) = 45
+ edge(2) = 30
+ edge(1) = 2
+ statn = SWrdfld(swid, "TCldTopStd", &
+ start, stride, edge, &
+ airs_ret_gran%TCldTopStd)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "TCldTopStd"
+
+ edge(3) = 45
+ edge(2) = 30
+ edge(1) = 2
+ statn = SWrdfld(swid, "TCldTopStdErr", &
+ start, stride, edge, &
+ airs_ret_gran%TCldTopStdErr)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "TCldTopStdErr"
+
+ edge(3) = 45
+ edge(2) = 30
+ edge(1) = 2
+ statn = SWrdfld(swid, "PCldTopStd", &
+ start, stride, edge, &
+ airs_ret_gran%PCldTopStd)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "PCldTopStd"
+
+ edge(3) = 45
+ edge(2) = 30
+ edge(1) = 2
+ statn = SWrdfld(swid, "PCldTopStdErr", &
+ start, stride, edge, &
+ airs_ret_gran%PCldTopStdErr)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
"PCldTopStdErr"
+ else
+ airs_ret_gran%TCldTopStd = -1
+ airs_ret_gran%TCldTopStdErr = -1
+ airs_ret_gran%PCldTopStd = -1
+ airs_ret_gran%PCldTopStdErr = -1
+ endif
edge(5) = 45
edge(4) = 30
@@ -1680,100 +746,6 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"CldFrcStdErr"
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "olr", &
- start, stride, edge, &
- airs_ret_gran%olr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "olr"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "olr_err", &
- start, stride, edge, &
- airs_ret_gran%olr_err)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "olr_err"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Qual_clrolr", &
- start, stride, edge, &
- airs_ret_gran%Qual_clrolr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Qual_clrolr"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "clrolr", &
- start, stride, edge, &
- airs_ret_gran%clrolr)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "clrolr"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "clrolr_err", &
- start, stride, edge, &
- airs_ret_gran%clrolr_err)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "clrolr_err"
-
- edge(4) = 45
- edge(3) = 30
- edge(2) = 3
- edge(1) = 3
- statn = SWrdfld(swid, "dust_flag", &
- start, stride, edge, &
- airs_ret_gran%dust_flag)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "dust_flag"
-
- edge(4) = 45
- edge(3) = 30
- edge(2) = 3
- edge(1) = 3
- statn = SWrdfld(swid, "spectral_clear_indicator", &
- start, stride, edge, &
- airs_ret_gran%spectral_clear_indicator)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "spectral_clear_indicator"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "num_clear_spectral_indicator", &
- start, stride, edge, &
- airs_ret_gran%num_clear_spectral_indicator)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "num_clear_spectral_indicator"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CC_noise_eff_amp_factor", &
- start, stride, edge, &
- airs_ret_gran%CC_noise_eff_amp_factor)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CC_noise_eff_amp_factor"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CC1_noise_eff_amp_factor", &
- start, stride, edge, &
- airs_ret_gran%CC1_noise_eff_amp_factor)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CC1_noise_eff_amp_factor"
-
edge(2) = 45
edge(1) = 30
statn = SWrdfld(swid, "totCldH2OStd", &
@@ -1792,195 +764,6 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"totCldH2OStdErr"
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CC1_Resid", &
- start, stride, edge, &
- airs_ret_gran%CC1_Resid)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CC1_Resid"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CCfinal_Resid", &
- start, stride, edge, &
- airs_ret_gran%CCfinal_Resid)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CCfinal_Resid"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CCfinal_Noise_Amp", &
- start, stride, edge, &
- airs_ret_gran%CCfinal_Noise_Amp)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CCfinal_Noise_Amp"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Tdiff_IR_MW_ret", &
- start, stride, edge, &
- airs_ret_gran%Tdiff_IR_MW_ret)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Tdiff_IR_MW_ret"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Tdiff_IR_4CC1", &
- start, stride, edge, &
- airs_ret_gran%Tdiff_IR_4CC1)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Tdiff_IR_4CC1"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "TSurfdiff_IR_4CC1", &
- start, stride, edge, &
- airs_ret_gran%TSurfdiff_IR_4CC1)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "TSurfdiff_IR_4CC1"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "TSurfdiff_IR_4CC2", &
- start, stride, edge, &
- airs_ret_gran%TSurfdiff_IR_4CC2)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "TSurfdiff_IR_4CC2"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "AMSU_Chans_Resid", &
- start, stride, edge, &
- airs_ret_gran%AMSU_Chans_Resid)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "AMSU_Chans_Resid"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "TotCld_4_CCfinal", &
- start, stride, edge, &
- airs_ret_gran%TotCld_4_CCfinal)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "TotCld_4_CCfinal"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Surf_Resid_Ratio", &
- start, stride, edge, &
- airs_ret_gran%Surf_Resid_Ratio)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Surf_Resid_Ratio"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Temp_Resid_Ratio", &
- start, stride, edge, &
- airs_ret_gran%Temp_Resid_Ratio)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Temp_Resid_Ratio"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Water_Resid_Ratio", &
- start, stride, edge, &
- airs_ret_gran%Water_Resid_Ratio)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Water_Resid_Ratio"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Cloud_Resid_Ratio", &
- start, stride, edge, &
- airs_ret_gran%Cloud_Resid_Ratio)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Cloud_Resid_Ratio"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "O3_Resid_Ratio", &
- start, stride, edge, &
- airs_ret_gran%O3_Resid_Ratio)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "O3_Resid_Ratio"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CO_Resid_Ratio", &
- start, stride, edge, &
- airs_ret_gran%CO_Resid_Ratio)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CO_Resid_Ratio"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "CH4_Resid_Ratio", &
- start, stride, edge, &
- airs_ret_gran%CH4_Resid_Ratio)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "CH4_Resid_Ratio"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "MWCheck_Resid_Ratio", &
- start, stride, edge, &
- airs_ret_gran%MWCheck_Resid_Ratio)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "MWCheck_Resid_Ratio"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "O3_dof", &
- start, stride, edge, &
- airs_ret_gran%O3_dof)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "O3_dof"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "all_spots_avg", &
- start, stride, edge, &
- airs_ret_gran%all_spots_avg)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "all_spots_avg"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "MW_ret_used", &
- start, stride, edge, &
- airs_ret_gran%MW_ret_used)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "MW_ret_used"
-
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Initial_CC_score", &
- start, stride, edge, &
- airs_ret_gran%Initial_CC_score)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Initial_CC_score"
-
edge(2) = 45
edge(1) = 30
statn = SWrdfld(swid, "retrieval_type", &
@@ -1990,14 +773,18 @@ subroutine airs_ret_rdr(file_name, airs_ret_gran)
print *, "Error ", statn, " reading field ", &
"retrieval_type"
- edge(2) = 45
- edge(1) = 30
- statn = SWrdfld(swid, "Startup", &
- start, stride, edge, &
- airs_ret_gran%Startup)
- if (statn .ne. 0) &
- print *, "Error ", statn, " reading field ", &
- "Startup"
+ if (ver == 5) then
+ edge(2) = 45
+ edge(1) = 30
+ statn = SWrdfld(swid, "Startup", &
+ start, stride, edge, &
+ airs_ret_gran%Startup)
+ if (statn .ne. 0) &
+ print *, "Error ", statn, " reading field ", &
+ "Startup"
+ else
+ airs_ret_gran%Startup = -1
+ endif
! Final clean-up
diff --git a/observations/obs_converters/AIRS/airs_obs_mod.f90 b/observations/obs_converters/AIRS/airs_obs_mod.f90
index f6a03a1c26..5dc6fecb11 100644
--- a/observations/obs_converters/AIRS/airs_obs_mod.f90
+++ b/observations/obs_converters/AIRS/airs_obs_mod.f90
@@ -38,12 +38,14 @@ module airs_obs_mod
set_qc_meta_data, set_obs_def, get_first_obs, &
get_last_obs, get_obs_def
+use obs_err_mod, only : rawin_temp_error
+
use airs_JPL_mod ! need ', only' list here
implicit none
private
-public :: real_obs_sequence, create_output_filename
+public :: make_obs_sequence, initialize_obs_sequence, compute_thin_factor
! version controlled file description for error handling, do not edit
character(len=256), parameter :: source = &
@@ -73,8 +75,10 @@ module airs_obs_mod
contains
-subroutine initialize_module
!-------------------------------------------------
+
+subroutine initialize_module
+
call register_module(source, revision, revdate)
call set_calendar_type(GREGORIAN)
@@ -83,27 +87,23 @@ subroutine initialize_module
end subroutine initialize_module
-
-
-function real_obs_sequence ( granule, lon1, lon2, lat1, lat2, &
- min_MMR_threshold, top_pressure_level, &
- row_thin, col_thin)
-!------------------------------------------------------------------------------
+!-------------------------------------------------
! extract the temperature and humidity observations from a granule
! and convert to DART observation format. allow caller to specify
! a bounding box and only extract data within that region.
-type(airs_granule_type), intent(in) :: granule
+subroutine make_obs_sequence ( seq, granule, lon1, lon2, lat1, lat2, &
+ min_MMR_threshold, top_pressure_level, &
+ row_thin, col_thin, use_NCEP_errs, version)
+
+type(obs_sequence_type), intent(inout) :: seq
+type(airs_granule_type), intent(in) :: granule
real(r8), intent(in) :: lon1, lon2, lat1, lat2
real(r8), intent(in) :: min_MMR_threshold, top_pressure_level
integer, intent(in) :: row_thin, col_thin
+logical, intent(in) :: use_NCEP_errs
+integer, intent(in) :: version
-! max possible obs from this one granule.
-integer :: max_num = &
- AIRS_RET_STDPRESSURELAY * AIRS_RET_GEOXTRACK * AIRS_RET_GEOTRACK + &
- AIRS_RET_H2OPRESSURELAY * AIRS_RET_GEOXTRACK * AIRS_RET_GEOTRACK
-
-type(obs_sequence_type) :: real_obs_sequence
type(obs_def_type) :: obs_def
type(obs_type) :: obs, prev_obs
type(location_type) :: obs_loc
@@ -122,31 +122,16 @@ function real_obs_sequence ( granule, lon1, lon2, lat1, lat2, &
if ( .not. module_initialized ) call initialize_module
-num_copies = 1
-num_qc = 1
-
-! Initialize an obs_sequence
-call init_obs_sequence(real_obs_sequence, num_copies, num_qc, max_num)
-
-! set meta data of obs_seq
-do i = 1, num_copies
- call set_copy_meta_data(real_obs_sequence, i, 'observation')
-end do
-
-do i = 1, num_qc
- call set_qc_meta_data(real_obs_sequence, i, 'AIRS QC')
-end do
-
! Initialize the obs variables
-call init_obs( obs, num_copies, num_qc)
-call init_obs(prev_obs, num_copies, num_qc)
+call init_obs( obs, 1, 1)
+call init_obs(prev_obs, 1, 1)
! assign each observation the correct observation type
tobstype = get_index_for_type_of_obs('AIRS_TEMPERATURE')
qobstype = get_index_for_type_of_obs('AIRS_SPECIFIC_HUMIDITY')
if ((tobstype < 1) .or. (qobstype < 1)) then
msgstring = 'unknown observation type [AIRS_TEMPERATURE, AIRS_SPECIFIC_HUMIDITY]'
- call error_handler(E_ERR,'real_obs_sequence',msgstring,source,revision,revdate)
+ call error_handler(E_ERR,'make_obs_sequence',msgstring,source,revision,revdate)
endif
@@ -254,23 +239,27 @@ function real_obs_sequence ( granule, lon1, lon2, lat1, lat2, &
obs_value = granule%TAirStd(ivert, icol, irow)
if (obs_value == -9999.0_r8) cycle vert_T_loop
-
- obs_var = granule%TAirStdErr(ivert, icol, irow) * &
- granule%TAirStdErr(ivert, icol, irow)
-
! temperature values are located directly at the pressure levels
vloc = granule%pressStd(ivert) * mb_to_Pa
- call real_obs(num_copies, num_qc, obs, olon, olat, vloc, obs_value, &
+ if (use_NCEP_errs) then
+ obs_var = max(rawin_temp_error(vloc / mb_to_Pa), & ! back to mb for this call
+ granule%TAirStdErr(ivert, icol, irow))
+ else
+ obs_var = granule%TAirStdErr(ivert, icol, irow)
+ endif
+ obs_var = obs_var * obs_var
+
+ call make_obs(num_copies, num_qc, obs, olon, olat, vloc, obs_value, &
obs_var, tqc, AIRS_TEMPERATURE, which_vert, seconds, days)
if(obs_num == 1) then ! for the first observation
- call insert_obs_in_seq(real_obs_sequence, obs)
+ call insert_obs_in_seq(seq, obs)
else ! not the first observation
if(time >= pre_time) then ! same time or later than previous obs
- call insert_obs_in_seq(real_obs_sequence, obs, prev_obs)
+ call insert_obs_in_seq(seq, obs, prev_obs)
else ! earlier
- call insert_obs_in_seq(real_obs_sequence, obs)
+ call insert_obs_in_seq(seq, obs)
endif
endif
prev_obs = obs
@@ -292,7 +281,7 @@ function real_obs_sequence ( granule, lon1, lon2, lat1, lat2, &
vert_Q_loop: do ivert=istart,humidity_top_index
- if (granule%Qual_H2O(icol, irow) > 0) exit vert_Q_loop
+ if ((version == 6) .and. (granule%H2OMMRStd_QC(ivert, icol, irow) > 0)) cycle vert_Q_loop
qqc = 0 ! if we get here, the quality control is 'Best' == 0
@@ -303,7 +292,6 @@ function real_obs_sequence ( granule, lon1, lon2, lat1, lat2, &
if (granule%H2OMMRStd(ivert, icol, irow) == -9999.0_r8) cycle vert_Q_loop
obs_value = Q(ivert, icol, irow)
- obs_var = Q_err(ivert, icol, irow) * Q_err(ivert, icol, irow)
! moisture obs are the mean of the layer with the bottom at
! the given pressure. compute the midpoint (in log space)
@@ -315,16 +303,23 @@ function real_obs_sequence ( granule, lon1, lon2, lat1, lat2, &
midpres = exp((log_lower + log_upper) / 2.0_r8)
vloc = midpres * mb_to_Pa
- call real_obs(num_copies, num_qc, obs, olon, olat, vloc, obs_value, &
+ if (use_NCEP_errs) then
+ obs_var = max(Q_err(ivert, icol, irow), 0.2_r8) ! ncep routine needs temp & rh but always returns 0.2
+ else
+ obs_var = Q_err(ivert, icol, irow)
+ endif
+ obs_var = obs_var * obs_var
+
+ call make_obs(num_copies, num_qc, obs, olon, olat, vloc, obs_value, &
obs_var, qqc, AIRS_SPECIFIC_HUMIDITY, which_vert, seconds, days)
if(obs_num == 1) then ! for the first observation
- call insert_obs_in_seq(real_obs_sequence, obs)
+ call insert_obs_in_seq(seq, obs)
else ! not the first observation
if(time >= pre_time) then ! same time or later than previous obs
- call insert_obs_in_seq(real_obs_sequence, obs, prev_obs)
+ call insert_obs_in_seq(seq, obs, prev_obs)
else ! earlier
- call insert_obs_in_seq(real_obs_sequence, obs)
+ call insert_obs_in_seq(seq, obs)
endif
endif
prev_obs = obs
@@ -344,23 +339,23 @@ function real_obs_sequence ( granule, lon1, lon2, lat1, lat2, &
enddo rowloop
! Print a little summary
-write(msgstring,*) 'obs used = ', obs_num, ' obs skipped = ', max_num - obs_num
+write(msgstring,*) 'obs used = ', obs_num
call error_handler(E_MSG, ' ', msgstring)
-if ( get_first_obs(real_obs_sequence, obs) ) then
+if ( get_first_obs(seq, obs) ) then
call get_obs_def(obs, obs_def)
pre_time = get_obs_def_time(obs_def)
- call print_time(pre_time,' first time in sequence is ')
+ call print_time(pre_time,' time of first obs in sequence is ')
call print_date(pre_time,' which is gregorian date ')
obs_loc = get_obs_def_location(obs_def)
latlon = get_location(obs_loc)
write(msgstring,*)'lat,lon,pres =', latlon(1), latlon(2), latlon(3)
call error_handler(E_MSG, 'location: ', msgstring)
endif
-if( get_last_obs(real_obs_sequence, obs)) then
+if( get_last_obs(seq, obs)) then
call get_obs_def(obs, obs_def)
time = get_obs_def_time(obs_def)
- call print_time(time,' last time in sequence is ')
+ call print_time(time,' time of last obs in sequence is ')
call print_date(time,' which is gregorian date ')
obs_loc = get_obs_def_location(obs_def)
latlon = get_location(obs_loc)
@@ -369,11 +364,11 @@ function real_obs_sequence ( granule, lon1, lon2, lat1, lat2, &
endif
call error_handler(E_MSG, ' ', ' ')
-end function real_obs_sequence
+end subroutine make_obs_sequence
-subroutine real_obs(num_copies, num_qc, obs, lon, lat, vloc, obs_value, &
+subroutine make_obs(num_copies, num_qc, obs, lon, lat, vloc, obs_value, &
var2, aqc, obs_kind, which_vert, seconds, days)
!------------------------------------------------------------------------------
integer, intent(in) :: num_copies, num_qc
@@ -389,7 +384,7 @@ subroutine real_obs(num_copies, num_qc, obs, lon, lat, vloc, obs_value, &
! Does real initialization of an observation type
-call real_obs_def(obsdef0, lon, lat, vloc, &
+call make_obs_def(obsdef0, lon, lat, vloc, &
var2, obs_kind, which_vert, seconds, days)
call set_obs_def(obs, obsdef0)
@@ -403,11 +398,11 @@ subroutine real_obs(num_copies, num_qc, obs, lon, lat, vloc, obs_value, &
call set_qc(obs, aqc01(1:1))
end do
-end subroutine real_obs
+end subroutine make_obs
-subroutine real_obs_def(obs_def, lon, lat, vloc, &
+subroutine make_obs_def(obs_def, lon, lat, vloc, &
var2, obs_kind, which_vert, seconds, days)
!----------------------------------------------------------------------
type(obs_def_type), intent(inout) :: obs_def
@@ -428,8 +423,21 @@ subroutine real_obs_def(obs_def, lon, lat, vloc, &
call set_obs_def_time(obs_def, set_time(seconds, days) )
call set_obs_def_error_variance(obs_def, var2)
-end subroutine real_obs_def
+end subroutine make_obs_def
+
+function compute_thin_factor(along, across)
+!----------------------------------------------------------------------
+integer, intent(in) :: along
+integer, intent(in) :: across
+integer :: compute_thin_factor
+
+if (along > 0 .and. across > 0) then
+ compute_thin_factor = along * across
+else
+ compute_thin_factor = 1
+endif
+end function compute_thin_factor
subroutine check_size(size1, size2, varlabel, subrlabel)
!----------------------------------------------------------------------
@@ -445,37 +453,35 @@ subroutine check_size(size1, size2, varlabel, subrlabel)
end subroutine check_size
-subroutine create_output_filename(l2name, ofname)
+function initialize_obs_sequence(ofname, filecount, sample_factor)
!-------------------------------------------------
-! The L2 filenames have a very long extension that
-! records when the data was published - not very interesting
-! for our purposes. replace with something DART-y.
-character(len=*), intent(IN) :: l2name
-character(len=*), intent(OUT) :: ofname
-
-integer :: i, basestart, extstart, strlen
-
-! hardcoded and brittle, but for now... the first 19 chars
-! of the input filename have the date & granule number, which
-! seems like the bulk of the useful info. find the last / and
-! copy from there to +19 chars.
-
-strlen = len_trim(l2name)
-
-basestart = 1
-slashloop : do i = strlen-1,1,-1
- if (l2name(i:i) == '/' ) then
- basestart = i+1
- exit slashloop
- endif
-enddo slashloop
+! create an obs sequence
+character(len=*), intent(in) :: ofname
+integer, intent(in) :: filecount
+integer, intent(in) :: sample_factor
+type(obs_sequence_type) :: initialize_obs_sequence
-extstart = basestart+19-1
+type(obs_sequence_type) :: seq
-ofname = l2name(basestart:extstart)//'.out'
-if (DEBUG) print *, 'output filename = ', ofname
+! max possible obs from this one granule.
+integer :: max_num, num_copies, num_qc
-end subroutine create_output_filename
+max_num = (AIRS_RET_STDPRESSURELAY * AIRS_RET_GEOXTRACK * AIRS_RET_GEOTRACK + &
+ AIRS_RET_H2OPRESSURELAY * AIRS_RET_GEOXTRACK * AIRS_RET_GEOTRACK ) / sample_factor
+
+num_copies = 1
+num_qc = 1
+
+! Initialize an obs_sequence
+call init_obs_sequence(seq, num_copies, num_qc, max_num * filecount)
+
+! set meta data of obs_seq
+call set_copy_meta_data(seq, 1, 'observation')
+call set_qc_meta_data(seq, 1, 'AIRS QC')
+
+initialize_obs_sequence = seq
+
+end function initialize_obs_sequence
subroutine debug_print_size_check(granule)
@@ -490,26 +496,26 @@ subroutine debug_print_size_check(granule)
call check_size(size(granule%TAirStd), &
AIRS_RET_STDPRESSURELAY*AIRS_RET_GEOXTRACK*AIRS_RET_GEOTRACK, &
- 'TAirStd (T)','real_obs_sequence')
+ 'TAirStd (T)','make_obs_sequence')
if (DEBUG) print *, 'first row T', granule%TAirStd(:, 1, 1)
if (DEBUG) print *, 'second row T', granule%TAirStd(:, 2, 1)
if (DEBUG) print *, 'second col T', granule%TAirStd(:, 1, 2)
call check_size(size(granule%TAirStdErr), size(granule%TAirStd), &
- 'TAirStdErr (T_err)','real_obs_sequence')
+ 'TAirStdErr (T_err)','make_obs_sequence')
if (DEBUG) print *, 'first row T err', granule%TAirStdErr(:, 1, 1)
! First (lowest) good pressure level number
call check_size(size(granule%nBestStd), AIRS_RET_GEOXTRACK*AIRS_RET_GEOTRACK, &
- 'nBestStd (T QC)','real_obs_sequence')
+ 'nBestStd (T QC)','make_obs_sequence')
if (DEBUG) print *, 'first row nBestStd', granule%nBestStd(:, 1)
call check_size(size(granule%H2OMMRStd), &
AIRS_RET_H2OPRESSURELAY*AIRS_RET_GEOXTRACK*AIRS_RET_GEOTRACK, &
- 'H2OMMRStd (MMR)','real_obs_sequence')
+ 'H2OMMRStd (MMR)','make_obs_sequence')
if (DEBUG) print *, 'AIRS_RET_H2OPRESSURELEV = ', AIRS_RET_H2OPRESSURELEV
if (DEBUG) print *, 'AIRS_RET_H2OPRESSURELAY = ', AIRS_RET_H2OPRESSURELAY
@@ -518,12 +524,12 @@ subroutine debug_print_size_check(granule)
if (DEBUG) print *, 'second col MMR', granule%H2OMMRStd(:, 1, 2)
call check_size(size(granule%H2OMMRStdErr), size(granule%H2OMMRStd), &
- 'H2OMMRStdErr (MMR_err)','real_obs_sequence')
+ 'H2OMMRStdErr (MMR_err)','make_obs_sequence')
if (DEBUG) print *, 'first row MMR err', granule%H2OMMRStdErr(:, 1, 1)
call check_size(size(granule%Qual_H2O), AIRS_RET_GEOXTRACK*AIRS_RET_GEOTRACK, &
- 'Qual_H2O (Q QC)','real_obs_sequence')
+ 'Qual_H2O (Q QC)','make_obs_sequence')
if (DEBUG) print *, 'first row qual_h2o', granule%Qual_H2O(:, 1)
@@ -531,6 +537,16 @@ subroutine debug_print_size_check(granule)
if (DEBUG) print *, 'second col Q', Q(:, 2, 1)
if (DEBUG) print *, 'second col Q', Q(:, 1, 2)
+call check_size(size(granule%H2OMMRStd_QC), &
+ AIRS_RET_H2OPRESSURELAY*AIRS_RET_GEOXTRACK*AIRS_RET_GEOTRACK, &
+ 'H2OMMRStd_QC (Q QC)','make_obs_sequence')
+
+if (DEBUG) print *, 'first row H2OMMRStd_QC', granule%H2OMMRStd_QC(:, 1, 1)
+
+if (DEBUG) print *, 'first row Q', Q(:, 1, 1)
+if (DEBUG) print *, 'second col Q', Q(:, 2, 1)
+if (DEBUG) print *, 'second col Q', Q(:, 1, 2)
+
if (DEBUG) print *, 'first row Q_err', Q_err(:, 1, 1)
diff --git a/observations/obs_converters/AIRS/convert_airs_L2.f90 b/observations/obs_converters/AIRS/convert_airs_L2.f90
index 9d815e7de4..d76f848040 100644
--- a/observations/obs_converters/AIRS/convert_airs_L2.f90
+++ b/observations/obs_converters/AIRS/convert_airs_L2.f90
@@ -6,7 +6,7 @@
program convert_airs_L2
-! Initial version of a program to read the AIRS retrievals for temperature
+! Program to read the AIRS retrievals for temperature
! and humidity.
use types_mod, only : r8, deg2rad, PI
@@ -16,10 +16,11 @@ program convert_airs_L2
use utilities_mod, only : initialize_utilities, register_module, &
error_handler, finalize_utilities, E_ERR, E_MSG, &
find_namelist_in_file, check_namelist_read, &
- do_nml_file, do_nml_term, &
+ do_nml_file, do_nml_term, set_filename_list, &
logfileunit, nmlfileunit, get_next_filename
-use airs_obs_mod, only : real_obs_sequence, create_output_filename
+use airs_obs_mod, only : make_obs_sequence, initialize_obs_sequence, &
+ compute_thin_factor
implicit none
@@ -27,6 +28,7 @@ program convert_airs_L2
! Declare local parameters
! ----------------------------------------------------------------------
+integer :: thin_factor, filecount
character(len=256) :: datafile(1), output_name, dartfile, msgstring
type(airs_granule_type) :: granule
type(obs_sequence_type) :: seq
@@ -43,13 +45,11 @@ program convert_airs_L2
! Declare namelist parameters
! ----------------------------------------------------------------------
-integer, parameter :: MAXFILES = 256
-character(len=128) :: nextfile
+integer, parameter :: MAXFILES = 512
-character(len=128) :: l2_files(MAXFILES) = ''
-character(len=128) :: l2_file_list = ''
-character(len=128) :: datadir = '.'
-character(len=128) :: outputdir = '.'
+character(len=256) :: l2_files(MAXFILES) = ''
+character(len=256) :: l2_file_list = ''
+character(len=256) :: outputfile = ''
real(r8) :: lon1 = 0.0_r8, & ! lower longitude bound
lon2 = 360.0_r8, & ! upper longitude bound
@@ -60,12 +60,15 @@ program convert_airs_L2
real(r8) :: top_pressure_level = 0.0001 ! no obs higher than this
integer :: cross_track_thin = 0
integer :: along_track_thin = 0
+logical :: use_NCEP_errs = .false.
+integer :: version = 6 ! AIRS file format version
namelist /convert_airs_L2_nml/ l2_files, l2_file_list, &
- datadir, outputdir, &
+ outputfile, &
lon1, lon2, lat1, lat2, &
min_MMR_threshold, top_pressure_level, &
- cross_track_thin, along_track_thin
+ cross_track_thin, along_track_thin, &
+ use_NCEP_errs, version
! ----------------------------------------------------------------------
! start of executable program code
@@ -90,54 +93,37 @@ program convert_airs_L2
if (do_nml_file()) write(nmlfileunit, nml=convert_airs_L2_nml)
if (do_nml_term()) write( * , nml=convert_airs_L2_nml)
-if ((l2_files(1) /= '') .and. (l2_file_list /= '')) then
- write(msgstring,*)'cannot specify both an input file and an input file list'
- call error_handler(E_ERR, 'convert_airs_L2', msgstring, &
- source, revision, revdate)
-endif
-
-
-index = 0
-
-! do loop without an index. will loop until exit called.
-do
- index = index + 1
- if (l2_files(1) /= '') then
- if (index > size(l2_files)) then
- write(msgstring,*)'cannot specify more than ', size(l2_files), ' files'
- call error_handler(E_ERR, 'convert_airs_L2', msgstring, &
- source, revision, revdate)
- endif
- nextfile = l2_files(index)
- else
- ! this is the new routine
- ! it opens the listfile, returns the index-th one
- nextfile = get_next_filename(l2_file_list, index)
- endif
-
- if (nextfile == '') exit
-
- ! construct an appropriate output filename
- call create_output_filename(nextfile, output_name)
- datafile(1) = trim(datadir) // '/' // trim(nextfile)
- dartfile = trim(outputdir) // '/' // trim(output_name)
-
+
+! when this routine returns, the l2_files variable will have
+! all the filenames, regardless of which way they were specified.
+filecount = set_filename_list(l2_files, l2_file_list, "convert_airs_l2")
+
+! used to estimate the max size of the output sequence
+thin_factor = compute_thin_factor(along_track_thin, cross_track_thin)
+
+! initialize an empty obs_seq to start
+seq = initialize_obs_sequence(outputfile, filecount, thin_factor)
+
+! for each input file
+do index=1, filecount
+
! read from HDF file into a derived type that holds all the information
- call airs_ret_rdr(datafile, granule)
+ call airs_ret_rdr(l2_files(index), granule, version)
! convert derived type information to DART sequence
- seq = real_obs_sequence(granule, lon1, lon2, lat1, lat2, &
- min_MMR_threshold, top_pressure_level, &
- along_track_thin, cross_track_thin)
-
- ! write the sequence to a disk file
- call write_obs_seq(seq, dartfile)
-
- ! release the sequence memory
- call destroy_obs_sequence(seq)
+ call make_obs_sequence(seq, granule, lon1, lon2, lat1, lat2, &
+ min_MMR_threshold, top_pressure_level, &
+ along_track_thin, cross_track_thin, &
+ use_NCEP_errs, version)
enddo
+! write the sequence to a disk file
+call write_obs_seq(seq, outputfile)
+
+! release the sequence memory
+call destroy_obs_sequence(seq)
+
call error_handler(E_MSG, 'convert_airs_L2', 'Finished successfully.',source,revision,revdate)
call finalize_utilities()
diff --git a/observations/obs_converters/AIRS/convert_airs_L2.nml b/observations/obs_converters/AIRS/convert_airs_L2.nml
index 2c5c965b24..497de7da07 100644
--- a/observations/obs_converters/AIRS/convert_airs_L2.nml
+++ b/observations/obs_converters/AIRS/convert_airs_L2.nml
@@ -1,15 +1,16 @@
&convert_airs_L2_nml
- l2_files = 'input.hdf',
- l2_file_list = '',
- datadir = '.',
- outputdir = '.',
- lon1 = 0.0,
- lon2 = 360.0,
- lat1 = -90.0,
- lat2 = 90.0,
- min_MMR_threshold = 1.0e-30,
- top_pressure_level = 0.0001,
- cross_track_thin = 0,
- along_track_thin = 0,
+ l2_files = ''
+ l2_file_list = ''
+ outputfile = 'obs_seq.out'
+ lon1 = 0.0
+ lon2 = 360.0
+ lat1 = -90.0
+ lat2 = 90.0
+ min_MMR_threshold = 1.0e-30
+ top_pressure_level = 0.0001
+ cross_track_thin = 0
+ along_track_thin = 0
+ use_NCEP_errs = .false.
+ version = 6
/
diff --git a/observations/obs_converters/AIRS/work/input.nml b/observations/obs_converters/AIRS/work/input.nml
index 51f8193096..fa8bd0c07d 100644
--- a/observations/obs_converters/AIRS/work/input.nml
+++ b/observations/obs_converters/AIRS/work/input.nml
@@ -7,19 +7,25 @@
input_files = '../../../../observations/forward_operators/obs_def_AIRS_mod.f90'
/
+! version 5 file?:
+! l2_files = '../data/AIRS.2007.11.01.001.L2.RetStd.v5.2.2.0.G08078150655.hdf'
+! version 6 file?:
+! l2_files = '../data/AIRS.2017.01.01.110.L2.RetStd_IR.v6.0.31.1.G19058124823.hdf'
+
&convert_airs_L2_nml
- datadir = '../data',
- l2_files = 'AIRS.2007.11.01.001.L2.RetStd.v5.2.2.0.G08078150655.hdf',
- l2_file_list = '' ,
- outputdir = '../output',
+ l2_files = '../data/AIRS.2017.01.01.110.L2.RetStd_IR.v6.0.31.1.G19058124823.hdf'
+ l2_file_list = ''
+ outputfile = 'obs_seq.out'
+ lon1 = 0.0
+ lon2 = 360.0
+ lat1 = -90.0
+ lat2 = 90.0
min_MMR_threshold = 1.0e-30
- top_pressure_level = 0.0001,
- along_track_thin = 0,
- cross_track_thin = 0,
- lon1 = 0.0,
- lon2 = 360.0,
- lat1 = -90.0,
- lat2 = 90.0
+ top_pressure_level = 0.0001
+ cross_track_thin = 0
+ along_track_thin = 0
+ use_NCEP_errs = .true.
+ version = 6
/
&obs_sequence_nml
@@ -33,5 +39,6 @@
/
&utilities_nml
+ module_details = .false.
/
diff --git a/observations/obs_converters/AIRS/work/mkmf_convert_airs_L2 b/observations/obs_converters/AIRS/work/mkmf_convert_airs_L2
index 81abdc1438..8e213d77be 100755
--- a/observations/obs_converters/AIRS/work/mkmf_convert_airs_L2
+++ b/observations/obs_converters/AIRS/work/mkmf_convert_airs_L2
@@ -6,26 +6,40 @@
#
# DART $Id$
-# if you are building this on yellowstone.ucar.edu you can changed
-# each of the /opt/local build directories below to /glade/p/work/nancy
-# where i have built the jpg, hdf, and eos libraries.
-
-set JPGDIR = /opt/local
-set JPGLIB = ${JPGDIR}/lib
-set JPGINC = ${JPGDIR}/include
+# if you are building this on cheyenne.ucar.edu (ncar supercomputer)
+# i've been able to use these two methods to build this converter:
+#
+# 1) use the prebuild hdf-eos module on the system:
+# a) unload the netcdf module,
+# b) load the hdf-eos module, then
+# c) reload netcdf
+# d) uncomment the MYINCDIR, MYLIBDIR lines below that use the NCAR_... versions
+#
+# 2) use the older libs i have previously built:
+# a) load the gnu compiler module
+# (i get dup symbol errors with intel.)
+# b) use the /glade/work/nancy versions of the dirs
-set HDFDIR = /opt/local
-set HDFLIB = ${HDFDIR}/lib
-set HDFINC = ${HDFDIR}/include
+# these env vars seem to be defined on cheyenne by loading the hdf-eos module:
+# NCAR_INC_HDFEOS
+# NCAR_LDFLAGS_HDFEOS
+# NCAR_LIBS_HDFEOS
-set EOSDIR = /opt/local
-set EOSLIB = ${EOSDIR}/lib
-set EOSINC = ${EOSDIR}/include
+set MYINCDIR = "-I$NCAR_INC_HDFEOS"
+set MYLIBDIR = "-L$NCAR_LIBS_HDFEOS"
+set MYLIBS = "$NCAR_LIBS_HDFEOS"
-set MYLIBS = "-lhdfeos -lmfhdf -ldf -ljpeg -lz -lm"
+# or
+#
+#set JPGDIR = /glade/work/nancy
+#set HDFDIR = /glade/work/nancy
+#set EOSDIR = /glade/work/nancy
+#
+#set MYINCDIR = "-I$EOSDIR/include -I$HDFDIR/include -I$JPGDIR/include"
+#set MYLIBDIR = "-L$EOSDIR/lib -L$HDFDIR/lib -L$JPGDIR/lib"
+#set MYLIBS = "-lhdfeos -lmfhdf -ldf -ljpeg -lz -lm"
+#
-set MYINCDIR = "-I${EOSDIR}/include -I${HDFDIR}/include -I${JPGDIR}/include"
-set MYLIBDIR = "-L${EOSDIR}/lib -L${HDFDIR}/lib -L${JPGDIR}/lib"
../../../../build_templates/mkmf -p convert_airs_L2 -t ../../../../build_templates/mkmf.template \
-l "${MYINCDIR} ${MYLIBDIR} ${MYLIBS}" \
diff --git a/observations/obs_converters/AIRS/work/path_names_convert_airs_L2 b/observations/obs_converters/AIRS/work/path_names_convert_airs_L2
index 3ebab84da0..ddd21bf7cf 100644
--- a/observations/obs_converters/AIRS/work/path_names_convert_airs_L2
+++ b/observations/obs_converters/AIRS/work/path_names_convert_airs_L2
@@ -27,3 +27,4 @@ observations/obs_converters/AIRS/airs_JPL_mod.f90
observations/obs_converters/AIRS/airs_obs_mod.f90
observations/obs_converters/AIRS/convert_airs_L2.f90
observations/obs_converters/utilities/obs_utilities_mod.f90
+observations/obs_converters/obs_error/ncep_obs_err_mod.f90
diff --git a/observations/obs_converters/AIRS/work/quickbuild.csh b/observations/obs_converters/AIRS/work/quickbuild.csh
index 0992c8ac5e..b79255ee66 100755
--- a/observations/obs_converters/AIRS/work/quickbuild.csh
+++ b/observations/obs_converters/AIRS/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/AURA/convert_aura.f90 b/observations/obs_converters/AURA/convert_aura.f90
index d1851a07f9..e49bf3f391 100644
--- a/observations/obs_converters/AURA/convert_aura.f90
+++ b/observations/obs_converters/AURA/convert_aura.f90
@@ -14,8 +14,9 @@ program convert_aura
use utilities_mod, only : initialize_utilities, find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_nml_file, &
get_next_filename, error_handler, E_ERR, E_MSG, &
- nc_check, find_textfile_dims, finalize_utilities, &
+ find_textfile_dims, finalize_utilities, &
timestamp,do_nml_term
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : VERTISPRESSURE, set_location ! pressure ccordinates for SABER
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
static_init_obs_sequence, init_obs, destroy_obs, &
diff --git a/observations/obs_converters/AURA/work/quickbuild.csh b/observations/obs_converters/AURA/work/quickbuild.csh
index f6d4ec27a8..45a670737f 100755
--- a/observations/obs_converters/AURA/work/quickbuild.csh
+++ b/observations/obs_converters/AURA/work/quickbuild.csh
@@ -6,16 +6,17 @@
#
# DART $Id$
#
-# This script compiles all executables in this directory.
+# compile all converter programs
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,10 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-# clean up. comment this out if you want to keep the .o and .mod files around
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/AVISO/convert_aviso.f90 b/observations/obs_converters/AVISO/convert_aviso.f90
index 7c48bb6a19..6b203a75b6 100644
--- a/observations/obs_converters/AVISO/convert_aviso.f90
+++ b/observations/obs_converters/AVISO/convert_aviso.f90
@@ -20,9 +20,11 @@ program convert_aviso
use types_mod, only : r8
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities, &
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
error_handler, E_ERR, E_MSG
+use netcdf_utilities_mod, only : nc_check
+
use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
increment_time, get_time, operator(+), GREGORIAN
diff --git a/observations/obs_converters/AVISO/work/quickbuild.csh b/observations/obs_converters/AVISO/work/quickbuild.csh
index 0ee8451098..2c4904404a 100755
--- a/observations/obs_converters/AVISO/work/quickbuild.csh
+++ b/observations/obs_converters/AVISO/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/Ameriflux/work/quickbuild.csh b/observations/obs_converters/Ameriflux/work/quickbuild.csh
index 8792864600..1b58e5e520 100755
--- a/observations/obs_converters/Ameriflux/work/quickbuild.csh
+++ b/observations/obs_converters/Ameriflux/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/CHAMP/work/quickbuild.csh b/observations/obs_converters/CHAMP/work/quickbuild.csh
index bdd4d4bf62..182d045d40 100755
--- a/observations/obs_converters/CHAMP/work/quickbuild.csh
+++ b/observations/obs_converters/CHAMP/work/quickbuild.csh
@@ -6,7 +6,7 @@
#
# DART $Id$
#
-# compile all CHAMP density converter programs
+# compile all converter programs
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
@@ -15,7 +15,8 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -56,7 +57,7 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo "Success: All ${MODEL} programs compiled."
diff --git a/observations/obs_converters/CNOFS/work/quickbuild.csh b/observations/obs_converters/CNOFS/work/quickbuild.csh
index adf8c7aa0b..15783b89ac 100755
--- a/observations/obs_converters/CNOFS/work/quickbuild.csh
+++ b/observations/obs_converters/CNOFS/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/COSMOS/COSMOS_development.f90 b/observations/obs_converters/COSMOS/COSMOS_development.f90
index 84b221fc97..31e2cbd1bb 100644
--- a/observations/obs_converters/COSMOS/COSMOS_development.f90
+++ b/observations/obs_converters/COSMOS/COSMOS_development.f90
@@ -27,8 +27,9 @@ program COSMOS_development
register_module, error_handler, E_MSG, E_ERR, &
open_file, close_file, do_nml_file, do_nml_term, &
check_namelist_read, find_namelist_in_file, &
- nmlfileunit, file_exist, nc_check, to_upper, &
- find_textfile_dims
+ nmlfileunit, file_exist, to_upper, find_textfile_dims
+
+use netcdf_utilities_mod, only : nc_check
use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
set_date, set_time, get_time, print_time, &
diff --git a/observations/obs_converters/COSMOS/COSMOS_to_obs.f90 b/observations/obs_converters/COSMOS/COSMOS_to_obs.f90
index d242e29ead..4e880e678e 100644
--- a/observations/obs_converters/COSMOS/COSMOS_to_obs.f90
+++ b/observations/obs_converters/COSMOS/COSMOS_to_obs.f90
@@ -31,8 +31,9 @@ program COSMOS_to_obs
register_module, error_handler, E_MSG, E_ERR, &
open_file, close_file, do_nml_file, do_nml_term, &
check_namelist_read, find_namelist_in_file, &
- nmlfileunit, file_exist, nc_check, to_upper, &
- find_textfile_dims
+ nmlfileunit, file_exist, to_upper, find_textfile_dims
+
+use netcdf_utilities_mod, only : nc_check
use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
set_date, set_time, get_time, print_time, &
diff --git a/observations/obs_converters/COSMOS/work/quickbuild.csh b/observations/obs_converters/COSMOS/work/quickbuild.csh
index d32ee14532..15d6b45f70 100755
--- a/observations/obs_converters/COSMOS/work/quickbuild.csh
+++ b/observations/obs_converters/COSMOS/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/DWL/work/quickbuild.csh b/observations/obs_converters/DWL/work/quickbuild.csh
index 16642cfac0..329691220b 100755
--- a/observations/obs_converters/DWL/work/quickbuild.csh
+++ b/observations/obs_converters/DWL/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/GPSPW/convert_gpspw.f90 b/observations/obs_converters/GPSPW/convert_gpspw.f90
index 3296b26450..c4a9716283 100644
--- a/observations/obs_converters/GPSPW/convert_gpspw.f90
+++ b/observations/obs_converters/GPSPW/convert_gpspw.f90
@@ -18,8 +18,10 @@ program convert_gpspw
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use types_mod, only : r8
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities, &
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file, &
+ nc_get_global_attribute
use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
increment_time, get_time, get_date, operator(-), GREGORIAN
use location_mod, only : VERTISUNDEF
@@ -32,8 +34,6 @@ program convert_gpspw
create_3d_obs, getvar_int, getdimlen, getvar_real_2d, &
getvar_int_2d, query_varname, set_missing_name
-use netcdf
-
implicit none
character(len=20), parameter :: gpspw_netcdf_file = 'gpspw_input.nc'
@@ -44,13 +44,13 @@ program convert_gpspw
num_qc = 1 ! number of QC entries
integer :: iunit, io
-integer :: ncid, nstn, nlev, n, i, oday, osec, nused, k, index, ntime, it
+integer :: ncid, nstn, n, i, oday, osec, nused, index, ntime, it
logical :: file_exist, first_obs
real(r8) :: qc
real(r8) :: pwv_miss = -999.
-real(r8) :: pwverr_miss = -999.
+!real(r8) :: pwverr_miss = -999.
-character(len=129), allocatable :: stationID(:)
+!character(len=129), allocatable :: stationID(:)
real(r8), allocatable :: lat(:), lon(:), elev(:), toff(:)
!real(r8), allocatable :: latu(:), lonu(:), levu(:), tobu(:)
real(r8), allocatable :: pwv(:,:), pwv_err(:,:)
@@ -62,7 +62,8 @@ program convert_gpspw
type(obs_type) :: obs, prev_obs
type(time_type) :: comp_day0, time_obs, prev_time
-character(len=NF90_MAX_NAME) :: varname(5)
+integer, parameter :: MAX_NAME = 256
+character(len=MAX_NAME) :: varname(5)
! For the data resource, check Readme in data/ directory.
! Sumoinet data provides observation times only as offset [sec] from 00Z
@@ -90,7 +91,7 @@ program convert_gpspw
character(len=19):: sdate
character(len= 8):: ymd ! YYYYMMDD
character(len=10):: ymdh ! YYYYMMDDHH
-integer :: iyear, iday, ihour, thour
+integer :: iyear, iday, ihour
integer :: iyr, imo, idy, ihr, imn, isc
!------------
@@ -106,9 +107,8 @@ program convert_gpspw
first_obs = .true.
-call nc_check( nf90_open(gpspw_netcdf_file, nf90_nowrite, ncid), &
- 'convert_gpspw', 'opening file '//trim(gpspw_netcdf_file))
-call nc_check( nf90_get_att(ncid,nf90_global,'start_date',sdate), 'get_att start_date')
+ncid = nc_open_file_readonly(gpspw_netcdf_file, 'convert_gpspw')
+call nc_get_global_attribute(ncid, 'start_date', sdate)
read(sdate,'(i4,1x,i3,1x,i2)') iyear, iday, ihour
call set_calendar_type(GREGORIAN)
@@ -256,10 +256,7 @@ program convert_gpspw
deallocate(pwv)
deallocate(pwv_err)
-! need to wait to close file because in the loop it queries the
-! report types.
-call nc_check( nf90_close(ncid) , &
- 'convert_gpspw', 'closing file '//trim(gpspw_netcdf_file))
+call nc_close_file(ncid, 'convert_gpspw')
! if we added any obs to the sequence, write it now.
if ( get_num_obs(obs_seq) > 0 ) call write_obs_seq(obs_seq, gpspw_outfile)
diff --git a/observations/obs_converters/GPSPW/work/quickbuild.csh b/observations/obs_converters/GPSPW/work/quickbuild.csh
index 6c055dc56d..f7dc56dd48 100755
--- a/observations/obs_converters/GPSPW/work/quickbuild.csh
+++ b/observations/obs_converters/GPSPW/work/quickbuild.csh
@@ -6,16 +6,17 @@
#
# DART $Id$
#
-# This script compiles all executables in this directory.
+# compile all converter programs
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,10 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-# clean up. comment this out if you want to keep the .o and .mod files around
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/GSI2DART/work/quickbuild.csh b/observations/obs_converters/GSI2DART/work/quickbuild.csh
index 0ce475b94d..ea211225b9 100755
--- a/observations/obs_converters/GSI2DART/work/quickbuild.csh
+++ b/observations/obs_converters/GSI2DART/work/quickbuild.csh
@@ -6,16 +6,19 @@
#
# DART $Id$
#
-# This script compiles all executables in this directory.
+# compile all converter programs
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
+\rm -f ../../../obs_def/obs_def_mod.f90
+\rm -f ../../../obs_kind/obs_kind_mod.f90
set MODEL = "GSI-related data"
@@ -46,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -54,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/GTSPP/gtspp_to_obs.f90 b/observations/obs_converters/GTSPP/gtspp_to_obs.f90
index 41f0c8f8d8..467ba5c004 100644
--- a/observations/obs_converters/GTSPP/gtspp_to_obs.f90
+++ b/observations/obs_converters/GTSPP/gtspp_to_obs.f90
@@ -23,7 +23,8 @@ program gtspp_to_obs
use utilities_mod, only : initialize_utilities, find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_output, &
get_next_filename, error_handler, E_ERR, E_MSG, &
- nc_check, find_textfile_dims, finalize_utilities
+ find_textfile_dims, finalize_utilities
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : VERTISHEIGHT, set_location
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
static_init_obs_sequence, init_obs, destroy_obs, &
diff --git a/observations/obs_converters/GTSPP/thinned_gtspp_to_obs.f90 b/observations/obs_converters/GTSPP/thinned_gtspp_to_obs.f90
index 14f6fb7803..a1637bae96 100644
--- a/observations/obs_converters/GTSPP/thinned_gtspp_to_obs.f90
+++ b/observations/obs_converters/GTSPP/thinned_gtspp_to_obs.f90
@@ -28,7 +28,8 @@ program thinned_gtspp_to_obs
use utilities_mod, only : initialize_utilities, find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_output, &
get_next_filename, error_handler, E_ERR, E_MSG, &
- nc_check, find_textfile_dims, finalize_utilities
+ find_textfile_dims, finalize_utilities
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : VERTISHEIGHT, set_location
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
static_init_obs_sequence, init_obs, destroy_obs, &
diff --git a/observations/obs_converters/GTSPP/work/quickbuild.csh b/observations/obs_converters/GTSPP/work/quickbuild.csh
index 3924e2d56d..84f92aed7d 100755
--- a/observations/obs_converters/GTSPP/work/quickbuild.csh
+++ b/observations/obs_converters/GTSPP/work/quickbuild.csh
@@ -6,16 +6,17 @@
#
# DART $Id$
#
-# This script compiles all executables in this directory.
+# compile all converter programs
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -44,15 +45,11 @@ foreach TARGET ( mkmf_* )
switch ( $TARGET )
case mkmf_preprocess:
breaksw
- case mkmf_advance_time:
- echo "If advance_time fails to build with gfortran, edit the source"
- echo "and comment out the interface block for iargc() and try again."
- # fall through!
default:
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -60,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/MADIS/convert_madis_acars.f90 b/observations/obs_converters/MADIS/convert_madis_acars.f90
index 79e705f841..c474a7c3f9 100644
--- a/observations/obs_converters/MADIS/convert_madis_acars.f90
+++ b/observations/obs_converters/MADIS/convert_madis_acars.f90
@@ -28,7 +28,8 @@ program convert_madis_acars
use types_mod, only : r8, missing_r8
use location_mod, only : VERTISPRESSURE
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities
+use utilities_mod, only : initialize_utilities, finalize_utilities
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file
use time_manager_mod, only : time_type, set_calendar_type, set_date, operator(>=), &
increment_time, get_time, operator(-), GREGORIAN
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
@@ -48,8 +49,6 @@ program convert_madis_acars
use obs_utilities_mod, only : getvar_real, get_or_fill_QC, add_obs_to_seq, &
create_3d_obs, getvar_int, getdimlen, set_missing_name
-use netcdf
-
implicit none
character(len=14), parameter :: acars_netcdf_file = 'acars_input.nc'
@@ -94,8 +93,7 @@ program convert_madis_acars
first_obs = .true.
-call nc_check( nf90_open(acars_netcdf_file, nf90_nowrite, ncid), &
- 'convert_madis_acars', 'opening file '//trim(acars_netcdf_file) )
+ncid = nc_open_file_readonly(acars_netcdf_file, 'convert_madis_acars')
call getdimlen(ncid, "recNum", nobs)
call set_missing_name("missing_value")
@@ -141,8 +139,7 @@ program convert_madis_acars
qc_wdir = 0 ; qc_wspd = 0
endif
-call nc_check( nf90_close(ncid), &
- 'convert_madis_acars', 'closing file '//trim(acars_netcdf_file) )
+call nc_close_file(ncid, 'convert_madis_acars')
! either read existing obs_seq or create a new one
diff --git a/observations/obs_converters/MADIS/convert_madis_marine.f90 b/observations/obs_converters/MADIS/convert_madis_marine.f90
index 85eb8c244d..461a87e084 100644
--- a/observations/obs_converters/MADIS/convert_madis_marine.f90
+++ b/observations/obs_converters/MADIS/convert_madis_marine.f90
@@ -30,7 +30,8 @@ program convert_madis_marine
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use types_mod, only : r8, missing_r8
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities
+use utilities_mod, only : initialize_utilities, finalize_utilities
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file
use time_manager_mod, only : time_type, set_calendar_type, set_date, &
increment_time, get_time, operator(-), GREGORIAN
use location_mod, only : VERTISSURFACE
@@ -56,8 +57,6 @@ program convert_madis_marine
use obs_utilities_mod, only : getvar_real, get_or_fill_QC, add_obs_to_seq, &
create_3d_obs, getvar_int, getdimlen, set_missing_name
-use netcdf
-
implicit none
character(len=15), parameter :: marine_netcdf_file = 'marine_input.nc'
@@ -101,8 +100,7 @@ program convert_madis_marine
first_obs = .true.
-call nc_check( nf90_open(marine_netcdf_file, nf90_nowrite, ncid), &
- 'convert_madis_marine', 'opening file '//trim(marine_netcdf_file) )
+ncid = nc_open_file_readonly(marine_netcdf_file, 'convert_madis_marine')
call getdimlen(ncid, "recNum", nobs)
call set_missing_name("missing_value")
@@ -151,8 +149,7 @@ program convert_madis_marine
qc_wdir = 0 ; qc_wspd = 0
endif
-call nc_check( nf90_close(ncid), &
- 'convert_madis_marine', 'closing file '//trim(marine_netcdf_file) )
+call nc_close_file(ncid, 'convert_madis_marine')
! either read existing obs_seq or create a new one
diff --git a/observations/obs_converters/MADIS/convert_madis_mesonet.f90 b/observations/obs_converters/MADIS/convert_madis_mesonet.f90
index 99ceb28c38..221d2b26d5 100644
--- a/observations/obs_converters/MADIS/convert_madis_mesonet.f90
+++ b/observations/obs_converters/MADIS/convert_madis_mesonet.f90
@@ -32,7 +32,8 @@ program convert_madis_mesonet
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use types_mod, only : r8, missing_r8
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities
+use utilities_mod, only : initialize_utilities, finalize_utilities
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file
use time_manager_mod, only : time_type, set_calendar_type, set_date, &
increment_time, get_time, operator(-), GREGORIAN
use location_mod, only : VERTISSURFACE
@@ -102,8 +103,7 @@ program convert_madis_mesonet
first_obs = .true.
-call nc_check(nf90_open(surface_netcdf_file, nf90_nowrite, ncid), &
- 'convert_madis_mesonet', 'opening file '//trim(surface_netcdf_file))
+ncid = nc_open_file_readonly(surface_netcdf_file, 'convert_madis_mesonet')
call getdimlen(ncid, "recNum", nobs)
call set_missing_name("missing_value")
@@ -157,8 +157,7 @@ program convert_madis_mesonet
qc_wdir = 0 ; qc_wspd = 0
endif
-call nc_check( nf90_close(ncid), &
- 'convert_madis_mesonet', 'closing file '//trim(surface_netcdf_file))
+call nc_close_file(ncid, 'convert_madis_mesonet')
! either read existing obs_seq or create a new one
diff --git a/observations/obs_converters/MADIS/convert_madis_metar.f90 b/observations/obs_converters/MADIS/convert_madis_metar.f90
index 625e1dbddf..2b71558a9a 100644
--- a/observations/obs_converters/MADIS/convert_madis_metar.f90
+++ b/observations/obs_converters/MADIS/convert_madis_metar.f90
@@ -31,7 +31,8 @@ program convert_madis_metar
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use types_mod, only : r8, missing_r8
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities
+use utilities_mod, only : initialize_utilities, finalize_utilities
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file, nc_check
use time_manager_mod, only : time_type, set_calendar_type, set_date, &
increment_time, get_time, operator(-), GREGORIAN
use location_mod, only : VERTISSURFACE
@@ -102,8 +103,7 @@ program convert_madis_metar
first_obs = .true.
-call nc_check( nf90_open(surface_netcdf_file, nf90_nowrite, ncid), &
- 'convert_madis_metar', 'opening file '//trim(surface_netcdf_file))
+ncid = nc_open_file_readonly(surface_netcdf_file, 'convert_madis_metar')
call getdimlen(ncid, "recNum", nobs)
call set_missing_name("missing_value")
@@ -353,8 +353,7 @@ program convert_madis_metar
! need to wait to close file because in the loop it queries the
! report types.
-call nc_check( nf90_close(ncid) , &
- 'convert_madis_metar', 'closing file '//trim(surface_netcdf_file))
+call nc_close_file(ncid, 'convert_madis_metar')
! if we added any obs to the sequence, write it now.
if ( get_num_obs(obs_seq) > 0 ) call write_obs_seq(obs_seq, surface_out_file)
diff --git a/observations/obs_converters/MADIS/convert_madis_profiler.f90 b/observations/obs_converters/MADIS/convert_madis_profiler.f90
index 0475028699..3bd9c48cc7 100644
--- a/observations/obs_converters/MADIS/convert_madis_profiler.f90
+++ b/observations/obs_converters/MADIS/convert_madis_profiler.f90
@@ -29,7 +29,8 @@ program convert_madis_profiler
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use types_mod, only : r8, missing_r8
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities
+use utilities_mod, only : initialize_utilities, finalize_utilities
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file
use time_manager_mod, only : time_type, set_calendar_type, set_date, &
increment_time, get_time, operator(-), GREGORIAN
use location_mod, only : VERTISHEIGHT
@@ -88,8 +89,7 @@ program convert_madis_profiler
first_obs = .true.
-call nc_check( nf90_open(profiler_netcdf_file, nf90_nowrite, ncid), &
- 'convert_madis_profiler', 'opening file '//trim(profiler_netcdf_file))
+ncid = nc_open_file_readonly(profiler_netcdf_file, 'convert_madis_profiler')
call getdimlen(ncid, "recNum", nsta)
call getdimlen(ncid, "level" , nlev)
@@ -237,8 +237,7 @@ program convert_madis_profiler
! need to wait to close file because in the loop it queries the
! report types.
-call nc_check( nf90_close(ncid) , &
- 'convert_madis_profiler', 'closing file '//trim(profiler_netcdf_file))
+call nc_close_file(ncid, 'convert_madis_profiler')
! if we added any obs to the sequence, write it now.
if ( get_num_obs(obs_seq) > 0 ) call write_obs_seq(obs_seq, profiler_out_file)
diff --git a/observations/obs_converters/MADIS/convert_madis_rawin.f90 b/observations/obs_converters/MADIS/convert_madis_rawin.f90
index c7ec7342f7..0d2a95d89d 100644
--- a/observations/obs_converters/MADIS/convert_madis_rawin.f90
+++ b/observations/obs_converters/MADIS/convert_madis_rawin.f90
@@ -34,9 +34,10 @@ program convert_madis_rawin
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use types_mod, only : r8, missing_r8
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities, &
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, &
do_nml_file, do_nml_term, logfileunit, nmlfileunit
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file, nc_check
use time_manager_mod, only : time_type, set_calendar_type, set_date, &
increment_time, get_time, operator(-), GREGORIAN
use location_mod, only : VERTISSURFACE, VERTISPRESSURE, VERTISHEIGHT
@@ -157,8 +158,7 @@ program convert_madis_rawin
first_obs = .true.
-call nc_check( nf90_open(rawin_in_file, nf90_nowrite, ncid), &
- 'convert_madis_rawin', 'opening file '//trim(rawin_in_file))
+ncid = nc_open_file_readonly(rawin_in_file, 'convert_madis_rawin')
call getdimlen(ncid, "recNum", nsound)
call set_missing_name("missing_value")
@@ -704,8 +704,7 @@ program convert_madis_rawin
enddo sondeloop2
! have to close at end of loop, unlike other versions of the madis converters
-call nc_check( nf90_close(ncid), &
- 'convert_madis_rawin', 'closing file '//trim(rawin_in_file))
+call nc_close_file(ncid, 'convert_madis_rawin')
! if we added any obs to the sequence, write it now.
if ( get_num_obs(obs_seq) > 0 ) call write_obs_seq(obs_seq, rawin_out_file)
diff --git a/observations/obs_converters/MADIS/convert_madis_satwnd.f90 b/observations/obs_converters/MADIS/convert_madis_satwnd.f90
index 014a6814a4..fd4272d273 100644
--- a/observations/obs_converters/MADIS/convert_madis_satwnd.f90
+++ b/observations/obs_converters/MADIS/convert_madis_satwnd.f90
@@ -34,7 +34,8 @@ program convert_madis_satwnd
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use types_mod, only : r8, missing_r8
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities
+use utilities_mod, only : initialize_utilities, finalize_utilities
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file
use time_manager_mod, only : time_type, set_calendar_type, set_date, &
increment_time, get_time, operator(-), GREGORIAN
use location_mod, only : VERTISPRESSURE
@@ -112,8 +113,7 @@ program convert_madis_satwnd
first_obs = .true.
-call nc_check( nf90_open(satwnd_netcdf_file, nf90_nowrite, ncid), &
- 'convert_madis_satwnd', 'opening file '//trim(satwnd_netcdf_file))
+ncid = nc_open_file_readonly(satwnd_netcdf_file, 'convert_madis_satwnd')
call getdimlen(ncid, "recNum", nobs)
@@ -243,8 +243,7 @@ program convert_madis_satwnd
! need to wait to close file because in the loop it queries the
! report types.
-call nc_check( nf90_close(ncid) , &
- 'convert_madis_satwnd', 'closing file '//trim(satwnd_netcdf_file))
+call nc_close_file(ncid, 'convert_madis_satwnd')
! if we added any obs to the sequence, write it now.
if ( get_num_obs(obs_seq) > 0 ) call write_obs_seq(obs_seq, satwnd_out_file)
diff --git a/observations/obs_converters/MADIS/work/quickbuild.csh b/observations/obs_converters/MADIS/work/quickbuild.csh
index 1b82b5693d..30bd6c02ab 100755
--- a/observations/obs_converters/MADIS/work/quickbuild.csh
+++ b/observations/obs_converters/MADIS/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/MIDAS/MIDAS_to_obs.f90 b/observations/obs_converters/MIDAS/MIDAS_to_obs.f90
index c1b1b099f9..c99850efbe 100644
--- a/observations/obs_converters/MIDAS/MIDAS_to_obs.f90
+++ b/observations/obs_converters/MIDAS/MIDAS_to_obs.f90
@@ -18,7 +18,9 @@ program MIDAS_to_obs
register_module, error_handler, E_ERR, E_MSG, &
do_nml_file, do_nml_term, &
check_namelist_read, find_namelist_in_file, &
- nmlfileunit, file_exist, nc_check
+ nmlfileunit, file_exist
+
+use netcdf_utilities_mod, only : nc_check
use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
set_time, get_time, print_time, print_date
@@ -36,7 +38,6 @@ program MIDAS_to_obs
use obs_kind_mod, only : MIDAS_TEC
-use typesizes
use netcdf
implicit none
diff --git a/observations/obs_converters/MIDAS/work/quickbuild.csh b/observations/obs_converters/MIDAS/work/quickbuild.csh
index 774473ecd4..2452d9c615 100755
--- a/observations/obs_converters/MIDAS/work/quickbuild.csh
+++ b/observations/obs_converters/MIDAS/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/MODIS/work/quickbuild.csh b/observations/obs_converters/MODIS/work/quickbuild.csh
index 16642cfac0..329691220b 100755
--- a/observations/obs_converters/MODIS/work/quickbuild.csh
+++ b/observations/obs_converters/MODIS/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/README b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/README
index 145820cee9..7e0dca7719 100644
--- a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/README
+++ b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/README
@@ -1,5 +1,5 @@
-# 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
+# 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
#
# DART $Id$
diff --git a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/create_obs_seq.csh b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/create_obs_seq.csh
index 71ac60da75..8bd43cd332 100755
--- a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/create_obs_seq.csh
+++ b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/create_obs_seq.csh
@@ -1,7 +1,7 @@
#!/bin/csh
#
-# 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
+# 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
#
# DART $Id$
diff --git a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/do_obs.lsf b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/do_obs.lsf
index 4cc27e3ff7..8ee1d90559 100755
--- a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/do_obs.lsf
+++ b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/do_obs.lsf
@@ -1,7 +1,7 @@
#!/bin/sh
#
-# 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
+# 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
#
# DART $Id$
diff --git a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_create.csh b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_create.csh
index 674ed26d8a..7f624b6cb9 100755
--- a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_create.csh
+++ b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_create.csh
@@ -1,7 +1,7 @@
#!/bin/csh
#
-# 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
+# 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
#
# DART $Id$
diff --git a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_parallel.lsf b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_parallel.lsf
index 68289e4f53..45909614f0 100755
--- a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_parallel.lsf
+++ b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_parallel.lsf
@@ -1,7 +1,7 @@
#!/bin/csh
#
-# 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
+# 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
#
# DART $Id$
diff --git a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_parallel.pbs b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_parallel.pbs
index ca6fd83e2e..3ab71ef921 100755
--- a/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_parallel.pbs
+++ b/observations/obs_converters/NCEP/ascii_to_obs/shell_scripts/multi_parallel.pbs
@@ -1,7 +1,7 @@
#!/bin/csh
#
-# 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
+# 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
#
# DART $Id$
diff --git a/observations/obs_converters/NCEP/ascii_to_obs/work/quickbuild.csh b/observations/obs_converters/NCEP/ascii_to_obs/work/quickbuild.csh
index 794ee0107a..6453e51c06 100755
--- a/observations/obs_converters/NCEP/ascii_to_obs/work/quickbuild.csh
+++ b/observations/obs_converters/NCEP/ascii_to_obs/work/quickbuild.csh
@@ -6,19 +6,17 @@
#
# DART $Id$
#
-# Script to manage the compilation of the executables in this directory.
-#
-# The 'preprocess' step constructs 2 modules which define which DART
-# observation types will be compiled into the code. To add (or remove)
-# obs types, edit the 'input.nml' namelist file, and find the &preprocess_nml
-# section. The 'input_types' item is an array of character strings listing
-# the observation definition files which will be included when preprocess
-# is compiled and run. Add and remove filenames from this list to control
-# the observation types.
-#
+# compile all converter programs
+
+#----------------------------------------------------------------------
+# 'preprocess' is a program that culls the appropriate sections of the
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
+# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../../obs_def/obs_def_mod.f90
\rm -f ../../../../obs_kind/obs_kind_mod.f90
@@ -51,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -59,10 +57,10 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod
-\rm -f input.nml.*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
+
+echo "Success: All ${MODEL} programs compiled."
-echo "Success: All DART programs compiled."
exit 0
#
diff --git a/observations/obs_converters/NCEP/netcdf/README b/observations/obs_converters/NCEP/netcdf/README
new file mode 100644
index 0000000000..62e756b8e2
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/README
@@ -0,0 +1,23 @@
+# 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
+#
+# DART $Id$
+
+This is the start of a converter from the new NetCDF format
+files with NCEP obs in them, directly to DART obs_seq files.
+
+THIS CONVERTER IS NOT FINISHED YET. anyone interested in
+doing the rest, let dart@ucar.edu know. we'd love to use
+it instead of parsing prepbufr files.
+
+Thanks to Soyoung Ha for the initial work on this converter.
+We stopped when some of the needed information was not in
+the netcdf file, but later versions of the converter are
+expected to contain what's needed.
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/NCEP/netcdf/convert_pb_netcdf.f90 b/observations/obs_converters/NCEP/netcdf/convert_pb_netcdf.f90
new file mode 100644
index 0000000000..ae2dfc054c
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/convert_pb_netcdf.f90
@@ -0,0 +1,463 @@
+! 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$
+
+
+!! THIS PROGRAM IS NOT FINISHED! there are observations available in
+!! netcdf format, but there were some missing fields that made completing
+!! this program impossible. We believe that now the missing data might
+!! be added to the netcdf format files, so this could be finished.
+!! It's in the release as-is so if someone wants to try to complete it
+!! they have something to start from.
+
+program convert_pb_netcdf
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! convert_pb_netcdf - program that reads a prep_bufr file that has
+! been converted to netcdf format by MET version 5.
+! (Model Evaluation Tools) Developmental Testbed Center
+!
+! adapted from MADIS converters by Soyoung Ha and Nancy Collins, 3/27/2018
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+use types_mod, only : r8, missing_r8
+use utilities_mod, only : initialize_utilities, finalize_utilities
+use netcdf_utilities_mod, only : nc_check
+use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
+ increment_time, get_time, operator(-), GREGORIAN, &
+ set_time_missing, print_date
+use location_mod, only : VERTISSURFACE, VERTISPRESSURE
+use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
+ static_init_obs_sequence, init_obs, write_obs_seq, &
+ init_obs_sequence, get_num_obs, &
+ set_copy_meta_data, set_qc_meta_data
+use meteor_mod, only : sat_vapor_pressure, specific_humidity, &
+ wind_dirspd_to_uv, pres_alt_to_pres, &
+ temp_and_dewpoint_to_rh
+use obs_err_mod ! all
+use dewpoint_obs_err_mod, only : dewpt_error_from_rh_and_temp, &
+ rh_error_from_dewpt_and_temp
+use obs_kind_mod ! FIXME, all for now
+use sort_mod, only : index_sort
+use obs_def_altimeter_mod, only : compute_altimeter
+use obs_utilities_mod, only : getvar_real_2d, get_or_fill_QC, add_obs_to_seq, &
+ create_3d_obs, getvar_int, getdimlen, set_missing_name, &
+ getvar_char
+
+use netcdf
+
+implicit none
+
+character(len=128), parameter :: pb_netcdf_file = 'prep_bufr_input.nc'
+character(len=128), parameter :: pb_out_file = 'obs_seq.prep_bufr'
+
+! the following logical parameters control which water-vapor variables appear in the output file,
+! whether to use the NCEP error or Lin and Hubbard (2004) moisture error model, and if the
+! input file has data quality control fields, whether to use or ignore them.
+logical, parameter :: LH_err = .false.
+logical, parameter :: include_specific_humidity = .true.
+logical, parameter :: include_relative_humidity = .false.
+logical, parameter :: include_dewpoint = .false.
+logical, parameter :: use_input_qc = .true.
+
+integer, parameter :: num_copies = 1, & ! number of copies in sequence
+ num_qc = 1 ! number of QC entries
+
+integer, parameter :: MXSTRLEN = 16 ! must match what's in input files.
+
+
+real(r8), parameter :: def_elev = 0.0_r8
+
+integer :: ncid, nobs, nhdr, mxstr, nvars, n, i, oday, osec, nused, sec1, sec2
+integer :: hdr, hdr_arr_len, obs_arr_len
+logical :: file_exist, first_obs
+real(r8) :: hdr_miss, obs_miss
+
+real(r8) :: sfcp_miss, tair_miss, tdew_miss, wdir_miss, wspd_miss, uwnd, &
+ vwnd, altim, palt, oerr, qobs, qerr, qsat, rh, slp_miss, elev_miss
+
+! in the input file you should find:
+character(len=MXSTRLEN), allocatable :: obs_qty(:), hdr_typ(:), hdr_sid(:), hdr_vld(:)
+real(r8), allocatable :: obs_arr(:,:), hdr_arr(:,:)
+
+! we are going to compute these:
+real(r8), allocatable :: lat(:), lon(:), pres(:), qc(:), stat_elev(:)
+real(r8), allocatable :: obs_val(:), obs_err(:), obs_elev(:)
+integer, allocatable :: obs_typ(:)
+
+! FIXME: leftovers - may not be needed
+integer, allocatable :: tobs(:), plid(:), tused(:), used(:), sorted_used(:)
+real(r8), allocatable :: sfcp(:), tair(:), slp(:), tdew(:), wdir(:), wspd(:)
+integer, allocatable :: qc_sfcp(:), qc_slp(:), qc_tair(:), qc_tdew(:), qc_wdir(:), qc_wspd(:)
+
+type(obs_sequence_type) :: obs_seq
+type(obs_type) :: obs, prev_obs
+type(time_type) :: time_obs, prev_time, time_ref
+
+
+! start of executable code
+call initialize_utilities('convert_pb_netcdf')
+
+! use the normal calendar
+call set_calendar_type(GREGORIAN)
+
+first_obs = .true.
+
+call nc_check( nf90_open(pb_netcdf_file, nf90_nowrite, ncid), &
+ 'convert_pb_netcdf', 'opening file '//trim(pb_netcdf_file) )
+
+call getdimlen(ncid, "nobs", nobs)
+call getdimlen(ncid, "nhdr", nhdr)
+call getdimlen(ncid, "mxstr", mxstr)
+call getdimlen(ncid, "hdr_arr_len", hdr_arr_len)
+call getdimlen(ncid, "obs_arr_len", obs_arr_len)
+
+print *, 'getting dimensions: ', mxstr, hdr_arr_len, obs_arr_len, nobs, nhdr
+
+! FIXME: is there a better way here?
+if (mxstr /= MXSTRLEN) then
+ print *, 'program assumes string lengths are ', MXSTRLEN, ' while file has ', mxstr
+ stop
+endif
+
+! data from the input file
+allocate(obs_qty(nobs), hdr_typ(nhdr), hdr_sid(nhdr), hdr_vld(nhdr))
+allocate(obs_arr(obs_arr_len, nobs), hdr_arr(hdr_arr_len, nhdr))
+
+! things we are going to extract and use
+allocate(lat(nobs), lon(nobs), pres(nobs), qc(nobs), obs_typ(nobs))
+allocate(stat_elev(nobs), obs_elev(nobs))
+allocate(obs_err(nobs), obs_val(nobs))
+allocate(tobs(nobs)) ; allocate(tused(nobs))
+allocate(used(nobs)) ; allocate(sorted_used(nobs))
+
+! read in the data arrays
+call getvar_char (ncid, "obs_qty", obs_qty) ! quality flag
+call getvar_real_2d(ncid, "obs_arr", obs_arr, obs_miss) ! obs values plus vert
+call getvar_char (ncid, "hdr_typ", hdr_typ) ! message type (eg ADPUPA)
+call getvar_char (ncid, "hdr_sid", hdr_sid) ! station id
+call getvar_char (ncid, "hdr_vld", hdr_vld) ! time: YYYYMMDD_HHMMSS
+call getvar_real_2d(ncid, "hdr_arr", hdr_arr, hdr_miss) ! location
+
+call nc_check( nf90_close(ncid), &
+ 'convert_pb_netcdf', 'closing file '//trim(pb_netcdf_file) )
+
+! we want a reference time that is earlier than any time
+! that exists in this file. for now take the first time
+! and subtract 10 days. these should be 6 hour files so
+! that's overkill.
+time_ref = string_to_time(hdr_vld(1))
+time_ref = time_ref - set_time(0, 10)
+
+inloop1: do n = 1, nobs
+ ! FIXME: check obs_miss, hdr_miss and loop if missing
+
+ ! extract header number and use it to index:
+ ! lat, lon, time, elevation if surface obs
+ ! message type and observation value
+print *, n, obs_arr(:, n)
+ hdr = obs_arr(1, n)
+print *, 'f90 hdr = ', hdr+1, ' c hdr = ', hdr
+
+ hdr = hdr + 1
+
+ call get_time(string_to_time(hdr_vld(hdr)) - time_ref, tobs(n))
+
+ qc(n) = string_to_qc(obs_qty(n))
+
+ lat(n) = hdr_arr(1, hdr)
+ lon(n) = hdr_arr(2, hdr)
+ stat_elev(n) = hdr_arr(3, hdr)
+
+ pres(n) = obs_arr(3, n)
+ obs_elev(n) = obs_arr(4, n)
+ obs_val(n) = obs_arr(5, n)
+
+ ! we think:
+ ! obs_typ is a combination of messsage type and grib code
+ ! once we know the type we can call to get the obs error
+
+print *, n, hdr_typ(n), obs_arr(2, n)
+
+print *, lat(n), lon(n), stat_elev(n), qc(n), pres(n), obs_elev(n), obs_val(n)
+call print_date(string_to_time(hdr_vld(hdr)))
+
+
+enddo inloop1
+
+stop
+
+nused = 0
+obsloop1: do n = 1, nobs
+
+ ! check the lat/lon values to see if they are ok
+ if ( lat(n) > 90.0_r8 .or. lat(n) < -90.0_r8 ) cycle obsloop1
+ if ( lon(n) > 180.0_r8 .or. lon(n) < -180.0_r8 ) cycle obsloop1
+
+ ! change lon from -180 to 180 into 0-360
+ if ( lon(n) < 0.0_r8 ) lon(n) = lon(n) + 360.0_r8
+
+! ! Check for duplicate observations
+! do i = 1, nused
+! if ( lon(n) == lon(used(i)) .and. &
+! lat(n) == lat(used(i)) .and. &
+! tobs(n) == tobs(used(i)) ) cycle obsloop1
+! end do
+
+ nused = nused + 1
+ used(nused) = n
+ tused(nused) = tobs(n)
+
+enddo obsloop1
+
+! sort indices only by time
+call index_sort(tused, sorted_used, nused)
+
+! either read existing obs_seq or create a new one
+call static_init_obs_sequence()
+call init_obs(obs, num_copies, num_qc)
+call init_obs(prev_obs, num_copies, num_qc)
+
+inquire(file=pb_out_file, exist=file_exist)
+
+if ( file_exist ) then
+
+ ! existing file found, append to it
+ call read_obs_seq(pb_out_file, 0, 0, nvars*nobs, obs_seq)
+
+else
+
+ ! create a new one
+ call init_obs_sequence(obs_seq, num_copies, num_qc, nvars*nobs)
+ do i = 1, num_copies
+ call set_copy_meta_data(obs_seq, i, 'Observation')
+ end do
+ do i = 1, num_qc
+ call set_qc_meta_data(obs_seq, i, 'Data QC')
+ end do
+
+endif
+
+obsloop2: do i = 1, nused
+
+ ! get the next unique observation in sorted time order
+ n = used(sorted_used(i))
+
+ ! convert offset in seconds to a real time type again
+ time_obs = increment_time(time_ref, tobs(n))
+
+! if ( elev(n) /= elev_miss ) then
+! palt = pres_alt_to_pres(elev(n)) * 0.01_r8
+! else
+! palt = pres_alt_to_pres(def_elev) * 0.01_r8
+! endif
+
+ ! extract actual time of observation in file into oday, osec.
+ call get_time(time_obs, osec, oday)
+
+! ! add altimeter data to obs_seq
+! if ( sfcp(n) /= sfcp_miss .and. qc_sfcp(n) == 0 .and. elev(n) /= elev_miss ) then
+!
+! altim = compute_altimeter(sfcp(n) * 0.01_r8, elev(n))
+! if ( plid(n) == 0 ) then
+! oerr = fixed_marine_pres_error(palt)
+! else
+! oerr = moving_marine_pres_error(palt)
+! endif
+
+! if ( altim >= 890.0_r8 .and. altim <= 1100.0_r8 .and. oerr /= missing_r8 ) then
+!
+! call create_3d_obs(lat(n), lon(n), elev(n), VERTISSURFACE, altim, &
+! MARINE_SFC_ALTIMETER, oerr, oday, osec, qc(n), obs)
+! call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
+!
+! endif
+!
+! ! if surface pressure and elevation do not exist, use SLP.
+! else if ( slp(n) /= slp_miss .and. qc_slp(n) == 0 ) then
+!
+! altim = compute_altimeter(slp(n) * 0.01_r8, 0.0_r8)
+! if ( plid(n) == 0 ) then
+! oerr = fixed_marine_pres_error(palt)
+! else
+! oerr = moving_marine_pres_error(palt)
+! endif
+!
+
+ call create_3d_obs(lat(n), lon(n), pres(n), VERTISPRESSURE, uwnd, &
+ RADIOSONDE_U_WIND_COMPONENT, oerr, oday, osec, qc(n), obs)
+ call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
+
+ call create_3d_obs(lat(n), lon(n), pres(n), VERTISPRESSURE, vwnd, &
+ RADIOSONDE_V_WIND_COMPONENT, oerr, oday, osec, qc(n), obs)
+ call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
+
+
+100 continue
+
+end do obsloop2
+
+! if we added any obs to the sequence, write it now.
+if ( get_num_obs(obs_seq) > 0 ) call write_obs_seq(obs_seq, pb_out_file)
+
+! end of main program
+call finalize_utilities()
+
+contains
+
+function string_to_time(str_time)
+ character(len=*), intent(in) :: str_time
+ type(time_type) :: string_to_time
+
+integer :: yr, mo, dy, hr, mn, sc
+integer :: rc
+
+read(str_time, "(I4,I2,I2,X,I2,I2,I2)", iostat=rc) yr, mo, dy, hr, mn, sc
+if (rc /= 0) then
+ print *, 'error converting string to time: '//trim(str_time)
+ string_to_time = set_time_missing()
+ return
+endif
+
+string_to_time = set_date(yr, mo, dy, hr, mn, sc)
+
+end function string_to_time
+
+
+function string_to_qc(str_qc)
+ character(len=*), intent(in) :: str_qc
+ real(r8) :: string_to_qc
+
+integer :: qc_val, rc
+
+read(str_qc, "(I2)", iostat=rc) qc_val
+if (rc /= 0) then
+ print *, 'error converting string to qc: '//trim(str_qc)
+ string_to_qc = 99
+ return
+endif
+
+string_to_qc = qc_val
+
+end function string_to_qc
+
+subroutine look_up_grib_code(grib_type, var_type)
+! Find the variable type from
+! http://www.nco.ncep.noaa.gov/pmb/docs/on388/table2.html
+ integer, intent(in) :: grib_type
+ character(len=*), intent(out) :: var_type
+
+select case (grib_type)
+! case(2)
+! var_type = 'MSLP'
+ case(7)
+ var_type = 'GEOPOTENTIAL_HGT'
+ case(11)
+ var_type = 'TEMPERATURE'
+ case(17)
+ var_type = 'DEWPOINT'
+! case(32)
+! var_type = 'WIND_SPEED'
+ case(33)
+ var_type = 'U_WIND_COMPONENT'
+ case(34)
+ var_type = 'V_WIND_COMPONENT'
+ case(51)
+ var_type = 'SPECIFIC_HUMIDITY'
+ case(52)
+ var_type = 'RELATIVE_HUMIDITY'
+! case(53)
+! var_type = 'HUMIDITY MIXING RATIO'
+ case(54)
+ var_type = 'PRECIPITABLE_WATER'
+ case default
+ var_type = 'NOT_SUPPORTED'
+end select
+
+end subroutine look_up_grib_code
+
+subroutine look_up_message_type(msg_type, obstype)
+! Find observation type from
+! http://www.emc.ncep.noaa.gov/mmb/data_processing/prepbufr.doc/table_4.htm
+ character(len=6), intent(in) :: msg_type
+ character(len=*), intent(out) :: obstype
+
+select case (msg_type)
+ case ('ADPUPA')
+ obstype = 'RADIOSONDE' ! FIXME: DROPSONDE, too.
+ case ('AIRCAR')
+ obstype = 'ACARS'
+ case ('AIRCFT')
+ obstype = 'AIRCRAFT'
+ case ('SATWND')
+ obstype = 'SAT'
+ case ('PROFLR')
+ obstype = 'PROFILER'
+ case ('ADPSFC')
+ obstype = 'METAR' ! FIXME: SYNOP, too.
+ case ('MSONET')
+ obstype = 'LAND_SFC'
+ case ('SFCSHP')
+ obstype = 'MARINE'
+ case ('GPSIPW')
+ obstype = 'GPS'
+ case ('QKSWND')
+ obstype = 'QKSWND'
+ case default
+ obstype = 'UNKNOWN'
+end select
+
+end subroutine look_up_message_type
+
+subroutine look_up_obs_type(msg_type, grib_type, dart_obs_type)
+ character(len=*), intent(in) :: msg_type
+ integer, intent(in) :: grib_type
+ integer, intent(out) :: dart_obs_type
+
+select case (msg_type)
+ case ('ADPUPA')
+ ! t, q, p, u, v, sst
+ select case(grib_type)
+ case (11)
+ dart_obs_type = RADIOSONDE_TEMPERATURE
+ case (12)
+ dart_obs_type = RADIOSONDE_TEMPERATURE
+ case default
+ dart_obs_type = -1
+ end select
+ case ('AIRCAR')
+ case ('AIRCFT')
+ case ('SATWND')
+ case ('PROFLR')
+ case ('VADWND')
+ case ('SATEMP')
+ case ('ADPSFC')
+ case ('SFCSHP')
+ case ('SFCBOG')
+ case ('SPSSMI')
+ case ('SYNDAT')
+ case ('ERS1DA')
+ case ('GOESND')
+ case ('QKSWND')
+ case ('MSONET')
+ case ('GPSIPW')
+ case ('RASSDA')
+ case ('WDSATR')
+ case ('ASCATW')
+ case default
+ print *, 'unknown message type: '//trim(msg_type)
+end select
+
+end subroutine look_up_obs_type
+
+end program convert_pb_netcdf
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/observations/obs_converters/NCEP/netcdf/data/README b/observations/obs_converters/NCEP/netcdf/data/README
new file mode 100644
index 0000000000..7488ba125c
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/data/README
@@ -0,0 +1,14 @@
+# 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
+#
+# DART $Id$
+
+Download an example data file here from the NCAR RDA.
+Dataset number 337.0 now has options to download in
+both prepbufr and netcdf format. Get a netcdf format file.
+
+#
+# $URL$
+# $Revision$
+# $Date$
diff --git a/observations/obs_converters/NCEP/netcdf/meteor_mod.f90 b/observations/obs_converters/NCEP/netcdf/meteor_mod.f90
new file mode 100644
index 0000000000..9c24004f3c
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/meteor_mod.f90
@@ -0,0 +1,299 @@
+! 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$
+
+module meteor_mod
+
+use types_mod, only : r8, deg2rad
+
+implicit none
+private
+
+public :: invert_altimeter, &
+ pres_alt_to_pres, &
+ sat_vapor_pressure, &
+ specific_humidity, &
+ theta_to_temp, &
+ wind_dirspd_to_uv, &
+ rh_and_temp_to_dewpoint, &
+ temp_and_dewpoint_to_rh
+
+real(r8), parameter :: grav = 9.81_r8, & ! gravitational constant
+ Cp = 1004.5_r8, &
+ Rd = 287.0_r8, &
+ Rv = 461.6_r8, &
+ Lvap = 2500000.0_r8, &
+ R_earth = 6370.0_r8, &
+ Pref = 100000.0, & ! reference pressure
+ Pralt = 101325.0, & ! altimeter reference P
+ Talt = 288.15, & ! altimeter reference T
+ es0C = 611.0_r8, & ! vapor pressure at 0 C (Pa)
+ Tfrez = 273.15_r8, & ! water freezing point (K)
+ RvRd = Rv/Rd, & ! Rv/Rd
+ RdRv = Rd/Rv, & ! Rd/Rv added 11/2009
+ kappa = Rd/Cp, & ! kappa for pot. temp
+ dTdzsta =0.0065 ! standard atmosphere lapse rate K/m
+
+contains
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! invert_altimeter - function that computes the surface pressure
+! given an altimeter setting and the station
+! elevation.
+!
+! altimeter_setting - altimeter setting (hPa)
+! elevation - elevation of station (m)
+! invert_altimeter - surface pressure value (hPa)
+!
+! created Dec. 2007 Ryan Torn, NCAR/MMM
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function invert_altimeter(altimeter_setting, elevation)
+
+use types_mod, only : r8
+
+implicit none
+
+real(r8), parameter :: k1 = 0.190284_r8
+real(r8), parameter :: k2 = 8.4228807E-5_r8
+
+real(r8), intent(in) :: altimeter_setting, elevation
+
+real(r8) :: invert_altimeter ! (hPa)
+
+invert_altimeter = (altimeter_setting ** k1 - k2 * elevation) ** (1 / k1) + 0.3_r8
+
+return
+end function invert_altimeter
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! pres_alt_to_pres - function that computes the pressure level given
+! the pressure altitude. Used mostly for ACARS
+! observations.
+!
+! hght - pressure-height level (m)
+!
+! created Oct. 2007 Ryan Torn, NCAR/MMM
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function pres_alt_to_pres(hght)
+
+real(r8), parameter :: Po = 101325.0_r8
+real(r8), intent(in) :: hght
+
+real(r8) :: C1, pres_alt_to_pres
+
+C1 = grav / (dTdzsta * Rd)
+pres_alt_to_pres = Po * exp( C1 * log( 1 - (dTdzsta * hght) / Talt) )
+
+end function pres_alt_to_pres
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! sat_vapor_pressure - function that computes the water vapor
+! saturation vapor pressure given a temperature.
+!
+! tmpk - temperature (K)
+!
+! created Oct. 2007 Ryan Torn, NCAR/MMM
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function sat_vapor_pressure(tmpk)
+
+real(r8), intent(in) :: tmpk
+
+real(r8) :: sat_vapor_pressure
+! Clausius-Clapeyron w/ constant Lv in Pa
+sat_vapor_pressure = es0C * exp((Lvap/Rv)*(1.0_r8/Tfrez - 1.0_r8/tmpk))
+
+return
+end function sat_vapor_pressure
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! specific_humidity - function that computes the specific humidity
+! given the vapor pressure and atmospheric dry
+! air pressure.
+!
+! vapor_pres - vapor pressure (Pa)
+! pres - atmospheric pressure (Pa)
+!
+! created Dec. 2007 Ryan Torn, NCAR/MMM
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function specific_humidity(vapor_pres, pres)
+
+real(r8), intent(in) :: vapor_pres, pres
+
+real(r8) :: specific_humidity
+
+! 11/2009 changed to Emanuel (1994) eqn 4.1.4
+ specific_humidity = (RdRv * vapor_pres) / (pres - vapor_pres*(1.0_r8-RdRv))
+
+return
+end function specific_humidity
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! theta_to_temp - function that computes the temperature given a
+! potential temperature and the pressure level.
+!
+! thta - potential temperature (K)
+! pres - pressure (Pa)
+!
+! created Oct. 2007 Ryan Torn, NCAR/MMM
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function theta_to_temp(thta, pres)
+
+real(r8), intent(in) :: thta, pres
+
+real(r8) :: theta_to_temp
+
+theta_to_temp = thta * (Pref/pres) ** (-kappa)
+
+return
+end function theta_to_temp
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! wind_dirspd_to_uv - subroutine that converts a wind direction and
+! wind speed to a zonal and meridional wind
+! component.
+!
+! wdir - wind direction
+! wspd - wind speed (m/s)
+! uwnd - u component of the wind (m/s)
+! vwnd - v component of the wind (m/s)
+!
+! created Oct. 2007 Ryan Torn, NCAR/MMM
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+subroutine wind_dirspd_to_uv(wdir, wspd, uwnd, vwnd)
+
+real(r8), intent(in) :: wdir, wspd
+real(r8), intent(out) :: uwnd, vwnd
+
+uwnd = wspd * cos(deg2rad * (90.0_r8 + wdir))
+vwnd = -wspd * sin(deg2rad * (90.0_r8 + wdir))
+
+return
+end subroutine wind_dirspd_to_uv
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! sat_vapor_press_bolton - function that uses Bolton's approximation to
+! compute saturation vapor pressure given
+! temperature.
+!
+! reference: Bolton 1980, MWR, 1046-1053
+!
+! sat_vapor_press_bolton - saturation vapor pressure (Pa)
+! tmpk - temperature (K)
+!
+! created Dec. 2008 David Dowell, NCAR/MMM
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function sat_vapor_press_bolton(tmpk)
+
+real(r8) :: sat_vapor_press_bolton
+real(r8), intent(in) :: tmpk
+
+real(r8) :: tmpc ! temperature (Celsius)
+
+tmpc = tmpk - Tfrez
+if ( tmpc <= -200.0_r8 ) then
+ print*,'sat_vapor_press_bolton: tmpc too low ',tmpc
+ stop
+end if
+sat_vapor_press_bolton = es0C * exp( 17.67_r8 * tmpc / (tmpc + 243.5_r8) )
+
+return
+end function sat_vapor_press_bolton
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! temp_and_dewpoint_to_rh - function that computes the relative humidity
+! given temperature and dewpoint
+!
+! temp_and_dewpoint_to_rh - relative humidity (0.00 - 1.00)
+! tmpk - temperature (Kelvin)
+! dptk - dewpoint (Kelvin)
+!
+! created Dec. 2008 David Dowell, NCAR/MMM
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function temp_and_dewpoint_to_rh(tmpk, dptk)
+
+real(r8) :: temp_and_dewpoint_to_rh
+real(r8), intent(in) :: tmpk
+real(r8), intent(in) :: dptk
+
+real(r8) :: e ! vapor pressure (Pa)
+real(r8) :: es ! saturation vapor pressure (Pa)
+
+e = sat_vapor_press_bolton(dptk)
+es = sat_vapor_press_bolton(tmpk)
+
+temp_and_dewpoint_to_rh = e / es
+
+if (temp_and_dewpoint_to_rh > 1.00_r8) then
+ print*,'rh = ', temp_and_dewpoint_to_rh, ', resetting to 1.00'
+ temp_and_dewpoint_to_rh = 1.00_r8
+end if
+
+return
+end function temp_and_dewpoint_to_rh
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! rh_and_temp_to_dewpoint - function that computes the dewpoint
+! given relative humidity and temperature
+!
+! rh_and_temp_to_dewpoint - dewpoint (Kelvin)
+! rh - relative humidity (0.00 - 1.00)
+! tmpk - temperature (Kelvin)
+!
+! created Dec. 2008 David Dowell, NCAR/MMM
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+function rh_and_temp_to_dewpoint(rh, tmpk)
+
+real(r8) :: rh_and_temp_to_dewpoint
+real(r8), intent(in) :: rh
+real(r8), intent(in) :: tmpk
+
+real(r8) :: e ! vapor pressure (Pa)
+real(r8) :: es ! saturation vapor pressure (Pa)
+real(r8) :: dptc ! dptc (Celsius)
+
+if ( ( rh <= 0.00_r8 ) .or. ( rh > 1.00_r8 ) ) then
+ print*,'rh_and_temp_to_dewpoint: bad rh ',rh
+ stop
+end if
+if ( rh <= 0.01_r8 ) then
+ print*,'rh_and_temp_to_dewpoint: low rh ',rh
+end if
+
+es = sat_vapor_press_bolton(tmpk)
+e = rh * es
+
+dptc = 243.5_r8 / (17.67_r8 / log(e/es0C) - 1.0_r8)
+
+rh_and_temp_to_dewpoint = dptc + Tfrez
+
+return
+end function rh_and_temp_to_dewpoint
+
+
+end module meteor_mod
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/observations/obs_converters/NCEP/netcdf/work/input.nml b/observations/obs_converters/NCEP/netcdf/work/input.nml
new file mode 100644
index 0000000000..fd12b0800f
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/work/input.nml
@@ -0,0 +1,28 @@
+
+&preprocess_nml
+ input_obs_kind_mod_file = '../../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90',
+ output_obs_kind_mod_file = '../../../../../assimilation_code/modules/observations/obs_kind_mod.f90',
+ input_obs_def_mod_file = '../../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90',
+ output_obs_def_mod_file = '../../../../../observations/forward_operators/obs_def_mod.f90',
+ input_files = '../../../../../observations/forward_operators/obs_def_altimeter_mod.f90',
+ '../../../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90',
+ '../../../../../observations/forward_operators/obs_def_metar_mod.f90',
+ '../../../../../observations/forward_operators/obs_def_dew_point_mod.f90',
+ '../../../../../observations/forward_operators/obs_def_gts_mod.f90',
+ '../../../../../observations/forward_operators/obs_def_rel_humidity_mod.f90',
+ /
+
+&obs_kind_nml
+ /
+
+&location_nml
+ /
+
+&utilities_nml
+ module_details = .false.
+ /
+
+&obs_sequence_nml
+ write_binary_obs_sequence = .false.
+ /
+
diff --git a/observations/obs_converters/NCEP/netcdf/work/mkmf_convert_pb_netcdf b/observations/obs_converters/NCEP/netcdf/work/mkmf_convert_pb_netcdf
new file mode 100755
index 0000000000..be30e53d33
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/work/mkmf_convert_pb_netcdf
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../../../build_templates/mkmf -p convert_pb_netcdf -t ../../../../../build_templates/mkmf.template \
+ -a "../../../../.." path_names_convert_pb_netcdf
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/NCEP/netcdf/work/mkmf_preprocess b/observations/obs_converters/NCEP/netcdf/work/mkmf_preprocess
new file mode 100755
index 0000000000..f19d907dfc
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/work/mkmf_preprocess
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../../../build_templates/mkmf -p preprocess -t ../../../../../build_templates/mkmf.template \
+ -a "../../../../.." path_names_preprocess
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/NCEP/netcdf/work/path_names_convert_pb_netcdf b/observations/obs_converters/NCEP/netcdf/work/path_names_convert_pb_netcdf
new file mode 100644
index 0000000000..d2e3133964
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/work/path_names_convert_pb_netcdf
@@ -0,0 +1,34 @@
+assimilation_code/location/threed_sphere/location_mod.f90
+assimilation_code/location/utilities/location_io_mod.f90
+assimilation_code/modules/assimilation/adaptive_inflate_mod.f90
+assimilation_code/modules/assimilation/assim_model_mod.f90
+assimilation_code/modules/assimilation/obs_model_mod.f90
+assimilation_code/modules/assimilation/quality_control_mod.f90
+assimilation_code/modules/io/dart_time_io_mod.f90
+assimilation_code/modules/io/direct_netcdf_mod.f90
+assimilation_code/modules/io/io_filenames_mod.f90
+assimilation_code/modules/io/state_structure_mod.f90
+assimilation_code/modules/io/state_vector_io_mod.f90
+assimilation_code/modules/observations/forward_operator_mod.f90
+assimilation_code/modules/observations/obs_kind_mod.f90
+assimilation_code/modules/observations/obs_sequence_mod.f90
+assimilation_code/modules/utilities/distributed_state_mod.f90
+assimilation_code/modules/utilities/ensemble_manager_mod.f90
+assimilation_code/modules/utilities/netcdf_utilities_mod.f90
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/null_win_mod.f90
+assimilation_code/modules/utilities/options_mod.f90
+assimilation_code/modules/utilities/random_seq_mod.f90
+assimilation_code/modules/utilities/sort_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+models/template/model_mod.f90
+models/utilities/default_model_mod.f90
+observations/forward_operators/obs_def_mod.f90
+observations/forward_operators/obs_def_utilities_mod.f90
+observations/obs_converters/NCEP/netcdf/convert_pb_netcdf.f90
+observations/obs_converters/NCEP/netcdf/meteor_mod.f90
+observations/obs_converters/obs_error/dewpoint_obs_err_mod.f90
+observations/obs_converters/obs_error/ncep_obs_err_mod.f90
+observations/obs_converters/utilities/obs_utilities_mod.f90
diff --git a/observations/obs_converters/NCEP/netcdf/work/path_names_preprocess b/observations/obs_converters/NCEP/netcdf/work/path_names_preprocess
new file mode 100644
index 0000000000..ae8022dafe
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/work/path_names_preprocess
@@ -0,0 +1,5 @@
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/preprocess/preprocess.f90
diff --git a/observations/obs_converters/NCEP/netcdf/work/quickbuild.csh b/observations/obs_converters/NCEP/netcdf/work/quickbuild.csh
new file mode 100755
index 0000000000..398046e5f9
--- /dev/null
+++ b/observations/obs_converters/NCEP/netcdf/work/quickbuild.csh
@@ -0,0 +1,70 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+#
+# compile all converter programs
+
+#----------------------------------------------------------------------
+# 'preprocess' is a program that culls the appropriate sections of the
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
+# so this MUST be run first.
+#----------------------------------------------------------------------
+
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
+\rm -f ../../../obs_def/obs_def_mod.f90
+\rm -f ../../../obs_kind/obs_kind_mod.f90
+
+set MODEL = "NCEP netcdf converter"
+
+@ n = 1
+
+echo
+echo
+echo "---------------------------------------------------------------"
+echo "${MODEL} build number ${n} is preprocess"
+
+csh mkmf_preprocess
+make || exit $n
+
+./preprocess || exit 99
+
+#----------------------------------------------------------------------
+# Build all the single-threaded targets
+#----------------------------------------------------------------------
+
+foreach TARGET ( mkmf_* )
+
+ set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
+
+ switch ( $TARGET )
+ case mkmf_preprocess:
+ breaksw
+ default:
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "${MODEL} build number ${n} is ${PROG}"
+ \rm -f ${PROG}
+ csh $TARGET || exit $n
+ make || exit $n
+ breaksw
+ endsw
+end
+
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
+
+echo "Success: All ${MODEL} programs compiled."
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/NCEP/prep_bufr/install.sh b/observations/obs_converters/NCEP/prep_bufr/install.sh
index 9e6fdd6365..9a338eab8e 100755
--- a/observations/obs_converters/NCEP/prep_bufr/install.sh
+++ b/observations/obs_converters/NCEP/prep_bufr/install.sh
@@ -43,6 +43,7 @@ if [ "$FCOMP" == "" ]; then
#FCOMP=intel
#FCOMP=pgi
#FCOMP=f77
+ #FCOMP=nag # NOT SUPPORTED
fi
# ------------------------------------------------------------------------
@@ -75,6 +76,8 @@ elif [ $FCOMP = pgi ] ; then
ff=pgf90
elif [ $FCOMP = f77 ] ; then
ff=f77
+elif [ $FCOMP = nag ] ; then
+ ff=nagfor ;
else
echo error: unrecognized FCOMP name
exit 1
@@ -84,6 +87,17 @@ if [ $UNDERSCORE = add ] ; then
cc="$cc -DUNDERSCORE"
fi
+# so far this doesn't compile with NAG - too many errors
+# we might be able to coerce it to work - but for now punt.
+if [ $ff = nagfor ]; then
+ echo
+ echo WARNING WARNING WARNING:
+ echo The prepbufr libraries do not successfully compile with NAG fortran.
+ echo Skipping the NCEP prepbufr library builds.
+ echo
+ exit -1
+fi
+
# in any case, add -O for optimized code
cc="$cc -O"
ff="$ff -O"
diff --git a/observations/obs_converters/NCEP/prep_bufr/work/quickbuild.csh b/observations/obs_converters/NCEP/prep_bufr/work/quickbuild.csh
index 874f731d25..d56bbabc8d 100755
--- a/observations/obs_converters/NCEP/prep_bufr/work/quickbuild.csh
+++ b/observations/obs_converters/NCEP/prep_bufr/work/quickbuild.csh
@@ -8,7 +8,8 @@
#
# This script compiles all executables in this directory.
-\rm -f *.o *.mod
+set nonomatch
+\rm -f *.o *.mod Makefile
set MODEL = "prep_bufr"
@@ -25,7 +26,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -33,9 +34,9 @@ foreach TARGET ( mkmf_* )
end
# clean up. comment this out if you want to keep the .o and .mod files around
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml.*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All DART programs compiled."
exit 0
diff --git a/observations/obs_converters/ROMS/convert_roms_obs.f90 b/observations/obs_converters/ROMS/convert_roms_obs.f90
index ff5edb0a5a..c0848479b7 100644
--- a/observations/obs_converters/ROMS/convert_roms_obs.f90
+++ b/observations/obs_converters/ROMS/convert_roms_obs.f90
@@ -19,13 +19,15 @@ program convert_roms_obs
use types_mod, only : r8, missing_r8, obstypelength
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities, &
- error_handler, do_nml_term, do_nml_file, nc_check, &
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
+ error_handler, do_nml_term, do_nml_file, &
E_ERR, E_WARN, E_MSG, logfileunit, nmlfileunit, &
find_namelist_in_file, check_namelist_read, &
open_file, close_file, find_textfile_dims, &
file_to_text, do_output, set_filename_list
+use netcdf_utilities_mod, only : nc_check
+
use time_manager_mod, only : time_type, set_calendar_type, set_date, &
increment_time, get_time, operator(-), GREGORIAN, &
print_time, print_date
diff --git a/observations/obs_converters/ROMS/work/quickbuild.csh b/observations/obs_converters/ROMS/work/quickbuild.csh
index 74772f9359..52ca4faa2a 100755
--- a/observations/obs_converters/ROMS/work/quickbuild.csh
+++ b/observations/obs_converters/ROMS/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/SABER/convert_saber_cdf.f90 b/observations/obs_converters/SABER/convert_saber_cdf.f90
index 6e578b212a..945e254c0c 100644
--- a/observations/obs_converters/SABER/convert_saber_cdf.f90
+++ b/observations/obs_converters/SABER/convert_saber_cdf.f90
@@ -13,8 +13,9 @@ program convert_saber_cdf
use utilities_mod, only : initialize_utilities, find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_nml_file, &
get_next_filename, error_handler, E_ERR, E_MSG, &
- nc_check, find_textfile_dims, finalize_utilities, &
+ find_textfile_dims, finalize_utilities, &
timestamp,do_nml_term
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : VERTISPRESSURE, set_location ! pressure ccordinates for SABER
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
static_init_obs_sequence, init_obs, destroy_obs, &
diff --git a/observations/obs_converters/SABER/work/quickbuild.csh b/observations/obs_converters/SABER/work/quickbuild.csh
index 81f004cee2..f21a805ace 100755
--- a/observations/obs_converters/SABER/work/quickbuild.csh
+++ b/observations/obs_converters/SABER/work/quickbuild.csh
@@ -6,16 +6,17 @@
#
# DART $Id$
#
-# This script compiles all executables in this directory.
+# compile all converter programs
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,10 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-# clean up. comment this out if you want to keep the .o and .mod files around
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/SSEC/convert_ssec_satwnd.f90 b/observations/obs_converters/SSEC/convert_ssec_satwnd.f90
index 48e2aa74be..382bbea8ce 100644
--- a/observations/obs_converters/SSEC/convert_ssec_satwnd.f90
+++ b/observations/obs_converters/SSEC/convert_ssec_satwnd.f90
@@ -30,8 +30,6 @@ program convert_ssec_satwnd
use obs_kind_mod, only : SAT_U_WIND_COMPONENT, SAT_V_WIND_COMPONENT
use obs_utilities_mod, only : create_3d_obs, add_obs_to_seq
-use netcdf
-
implicit none
character(len=16), parameter :: ssec_sat_file = 'satwnd_input.txt'
diff --git a/observations/obs_converters/SSEC/work/quickbuild.csh b/observations/obs_converters/SSEC/work/quickbuild.csh
index b60eb87404..beac565a22 100755
--- a/observations/obs_converters/SSEC/work/quickbuild.csh
+++ b/observations/obs_converters/SSEC/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/SST/SST.html b/observations/obs_converters/SST/SST.html
new file mode 100644
index 0000000000..be5e6c86ea
--- /dev/null
+++ b/observations/obs_converters/SST/SST.html
@@ -0,0 +1,459 @@
+
+
+
+DART sst_to_obs, oi_sst_to_obs
+
+
+
+
+
+
+
There are two gridded SST observation converters in this directory,
+one for data from PODAAC, and one from NOAA/NCDC.
+sst_to_obs converts data from PODAAC and has been used
+by Romain Escudier for regional studies with ROMS.
+oi_sst_to_obs converts data from NOAA/NCDC and has been
+used by Fred Castruccio for global studies with POP.
+
+
+
sst_to_obs -- GHRSST to DART Observation Sequence Converter
+National Centers for Environmental Information. 2016. GHRSST Level 4 AVHRR_OI
+Global Blended Sea Surface Temperature Analysis (GDS version 2) from NCEI.
+Ver. 2.0. PO.DAAC, CA, USA. Dataset accessed [YYYY-MM-DD] at
+http://dx.doi.org/10.5067/GHAAO-4BC02.
+
+
+
Many thanks to Romain Escudier (then at Rutgers) who did the bulk
+of the work and graciously contributed his efforts to the DART project.
+Romain gave us scripts and source code to download the data from the PODAAC
+site, subset the global files to a region of interest, and convert that
+subsetted file to a DART observation sequence file. Those scripts and programs
+have been only lightly modified to work with the Manhattan version of DART
+and contain a bit more documentation.
+
+
+
+The workflow is usually:
+
+
+
compile the converters by running work/quickbuild.csh
+ in the usual way.
+
+
+
customize the shell_scripts/parameters_SST
+ resource file to specify variables used by the rest of the scripting.
+
+
+
run shell_scripts/get_sst_ftp.sh
+ to download the data from PODAAC.
+
+
+
provide a mask for the desired study area.
+
+
+
run shell_scripts/Prepare_SST.sh
+ to subset the PODAAC data and create the DART observation sequence files.
+ Be aware that the Prepare_SST.sh modifies
+ the shell_scripts/input.nml.template file and
+ generates its own input.nml.
+ work/input.nml is not used.
+
+
+
combine all output files for the region and timeframe of interest
+ into one file using the
+ obs_sequence_tool
+
+
+
+
+
Example:
+
+It is worth describing a small example.
+If you configure get_sst_ftp.sh to download the last
+two days of 2010 and then specify the mask to subset for the
+NorthWestAtlantic (NWA) and run
+Prepare_SST.sh your directory structure should look
+like the following:
+
The location of the DART observation sequence files is specified by
+parameter_SST:DIR_OUT_DART.
+That directory should contain the following two files:
+
+
+0[1236] cheyenne6:/<6>v2/Err30 > ls -l
+'total 7104
+-rw-r--r-- 1 thoar p86850054 3626065 Jan 10 11:08 obs_seq.sst.20101230
+-rw-r--r-- 1 thoar p86850054 3626065 Jan 10 11:08 obs_seq.sst.20101231
+
+
+
oi_sst_to_obs -- NOAA/NCDC to DART Observation Sequence Converter
run work/oi_sst_to_obs
+ to create a single DART observation sequence file.
+
+
+
combine all output files for the region and timeframe of interest
+ into one file using the
+ obs_sequence_tool
+
+
+
+
+
+
+
+
+
+
+
sst_to_obs NAMELIST
+
+This namelist is read from the file input.nml.
+Namelists start with an ampersand
+'&' and terminate with a slash '/'.
+Character strings that contain a '/' must be
+enclosed in quotes to prevent them from
+prematurely terminating the namelist.
+
Name of the (usually subsetted) netcdf data file.
+ This may be a relative or absolute filename.
+ If you run the scripts 'as is', this will be something like:
+../ObsData/SST/nwaSST/2010/20101231120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0_NWA.nc
+
+
sst_netcdf_filelist
+
character(len=256)
+
Name of the file that contains a list of
+ (usually subsetted) data files, one per line.
+ You may not specify both sst_netcdf_file AND
+ sst_netcdf_filelist. One of them must be empty.
+
+
+
sst_out_file
+
character(len=256)
+
Name of the output observation sequence file.
+
+
subsample_intv
+
integer
+
It is possible to 'thin' the observations.
+ subsample_intv allows one to take every Nth
+ observation.
+
+
+
sst_rep_error
+
real
+
In DART the observation error variance can be thought of
+ as having two components, an instrument error and a
+ representativeness error. In sst_to_obs
+ the instrument error is specified in the netCDF file by the variable
+ analysis_error. The representativeness error
+ is specified by sst_rep_error, which is
+ specified as a standard deviation. These two values
+ are added together and squared and used as the
+ observation error variance. Note:
+ This algorithm maintains backwards
+ compatibility, but is technically not the right way to combine
+ these two quantities. If they both specified variance, adding them
+ together and then taking the square root would correctly specify a
+ standard deviation. Variances add, standard deviations do not.
+ Since the true observation error variance (in general) is not
+ known, we are content to live with an algorithm that produces
+ useful observation error variances. If your research comes to a
+ more definitive conclusion, please let us know.
+
+
+
debug
+
logical
+
Print extra information during the
+ sst_to_obs execution.
+
+
+
+
+
+
+
oi_sst_to_obs NAMELIST
+
+This namelist is read from the file input.nml.
+Namelists start with an ampersand
+'&' and terminate with a slash '/'.
+Character strings that contain a '/' must be
+enclosed in quotes to prevent them from
+prematurely terminating the namelist.
+
Name of the input netcdf data file.
+ This may be a relative or absolute filename.
+ If you run the scripts 'as is', this will be something like:
+../ObsData/SST/nwaSST/2010/20101231120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0_NWA.nc
+
+
output_file_base
+
character(len=256)
+
Partial filename for the output file.
+ The date and time are appended to output_file_base
+ to construct a unique filename reflecting the time of the
+ observations in the file.
+
+
+
subsample_intv
+
integer
+
It is possible to 'thin' the observations.
+ subsample_intv allows one to take every Nth
+ observation.
+
+
+
sst_error_std
+
real
+
This is the total observation error standard deviation.
+
+
+
debug
+
logical
+
Print extra information during the
+ oi_sst_to_obs execution.
+
+
+
+
+
+
+
+
+
+
+
DECISIONS YOU MIGHT NEED TO MAKE
+
+
+See the general discussion in the
+observations introduction
+page about what options are available for the things you need to
+specify. These include setting a time, specifying an expected error,
+setting a location, and an observation type.
+
+
+
+
+
+
+
+
+
KNOWN BUGS
+
+I do not believe sst_to_obs will work correctly
+if given multiple files in sst_netcdf_filelist.
+The number of observation used to declare the length of the output
+observation sequence is based on a single file ... yet seems to be used
+by many. I have not tested this configuration, since the scripting does
+not use the sst_netcdf_filelist mechanism.
+
+
+
+
+
+
diff --git a/observations/obs_converters/SST/data/sst.jan1.2004.nc b/observations/obs_converters/SST/data/sst.jan1.2004.nc
new file mode 100644
index 0000000000..dd961a79a2
Binary files /dev/null and b/observations/obs_converters/SST/data/sst.jan1.2004.nc differ
diff --git a/observations/obs_converters/SST/masks/Mask_NWA-NCDC-L4LRblend-GLOB-v01-fv02_0-AVHRR_OI.nc b/observations/obs_converters/SST/masks/Mask_NWA-NCDC-L4LRblend-GLOB-v01-fv02_0-AVHRR_OI.nc
new file mode 100644
index 0000000000..da4f33f0c8
Binary files /dev/null and b/observations/obs_converters/SST/masks/Mask_NWA-NCDC-L4LRblend-GLOB-v01-fv02_0-AVHRR_OI.nc differ
diff --git a/observations/obs_converters/SST/masks/Mask_NWA120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0.nc b/observations/obs_converters/SST/masks/Mask_NWA120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0.nc
new file mode 100644
index 0000000000..da4f33f0c8
Binary files /dev/null and b/observations/obs_converters/SST/masks/Mask_NWA120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0.nc differ
diff --git a/observations/obs_converters/SST/oi_sst_to_obs.f90 b/observations/obs_converters/SST/oi_sst_to_obs.f90
new file mode 100644
index 0000000000..fdcf613634
--- /dev/null
+++ b/observations/obs_converters/SST/oi_sst_to_obs.f90
@@ -0,0 +1,264 @@
+! 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
+!
+! DART $Id$
+
+program oi_sst_to_obs
+
+!> title = "NOAA High-resolution Blended Analysis: Daily Values using AVHRR only" ;
+!> institution = "NOAA/NCDC" ;
+!> source = "NOAA/NCDC ftp://eclipse.ncdc.noaa.gov/pub/OI-daily-v2/" ;
+!> comment = "Reynolds, et al., 2007:
+!> Daily High-Resolution-Blended Analyses for Sea Surface Temperature.
+!> J. Climate, 20, 5473-5496.
+!> Climatology is based on 1971-2000 OI.v2 SST,
+!> Satellite data: Navy NOAA17 NOAA18 AVHRR, Ice data: NCEP ice." ;
+!> references = "https://www.esrl.noaa.gov/psd/data/gridded/data.noaa.oisst.v2.highres.html" ;
+!> dataset_title = "NOAA Daily Optimum Interpolation Sea Surface Temperature" ;
+
+! float sst(time, lat, lon) ;
+! sst:long_name = "Daily Sea Surface Temperature" ;
+! sst:units = "degC" ;
+! sst:valid_range = -3.f, 45.f ;
+! sst:missing_value = -9.96921e+36f ;
+! sst:precision = 2.f ;
+! sst:dataset = "NOAA High-resolution Blended Analysis" ;
+! sst:var_desc = "Sea Surface Temperature" ;
+! sst:level_desc = "Surface" ;
+! sst:statistic = "Mean" ;
+! sst:parent_stat = "Individual Observations" ;
+! sst:actual_range = -1.8f, 35.54f ;
+
+use types_mod, only : r8, digits12
+
+use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, &
+ set_time, get_time, print_time, &
+ set_date, get_date, print_date, &
+ operator(+), operator(-)
+
+use utilities_mod, only : initialize_utilities, find_namelist_in_file, &
+ check_namelist_read, nmlfileunit, &
+ error_handler, E_ERR, E_MSG, &
+ finalize_utilities, do_nml_file, do_nml_term
+
+use location_mod, only : VERTISSURFACE, set_location
+
+use obs_sequence_mod, only : obs_type, obs_sequence_type, init_obs, &
+ static_init_obs_sequence, init_obs_sequence, &
+ set_copy_meta_data, set_qc_meta_data, &
+ get_num_obs, write_obs_seq, destroy_obs_sequence
+
+use obs_utilities_mod, only : create_3d_obs, add_obs_to_seq
+
+use obs_kind_mod, only : OI_SEA_SURFACE_TEMPERATURE
+
+use netcdf_utilities_mod, only : nc_check, nc_open_file_readonly, nc_close_file, &
+ nc_get_variable, nc_get_attribute_from_variable, &
+ nc_get_dimension_size, nc_get_variable_size
+
+use netcdf
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=*), parameter :: source = &
+ '$URL$'
+character(len=*), parameter :: revision = '$Revision$'
+character(len=*), parameter :: revdate = '$Date$'
+character(len=*), parameter :: routine = 'oi_sst_to_obs'
+
+integer, parameter :: num_copies = 1, & ! number of copies in sequence
+ num_qc = 1 ! number of QC entries
+
+real(r8), parameter :: qc = 0.0_r8
+
+character(len=256) :: output_file
+character(len=512) :: string1, string2
+
+integer :: ncid, varid, io, iunit
+integer :: oday, osec, iday, isec
+integer :: year, month, day, hour, minutes, seconds
+integer :: num_new_obs, nmissing
+integer :: i, j, nlat, nlon, ndays
+integer :: itime
+
+logical :: first_obs
+
+type(obs_sequence_type) :: obs_seq
+type(obs_type) :: obs, prev_obs
+type(time_type) :: obs_time, prev_time
+type(time_type) :: base_time, delta_time
+
+real(digits12), allocatable :: time(:)
+real(r8), allocatable :: lat(:), lon(:)
+real(r8), allocatable :: sst(:,:)
+real(r8) :: missing_value
+
+!------------------------------------------------------------------------
+! Declare namelist parameters
+
+! sst_error_std ... instrument and representativeness error (std)
+
+real(r8) :: sst_error_std = 0.3_r8
+character(len=256) :: input_file = '1234567.nc'
+character(len=256) :: output_file_base = 'obs_seq.sst'
+logical :: debug = .false.
+integer :: subsample_intv = 1
+
+namelist /oi_sst_to_obs_nml/ input_file, output_file_base, &
+ debug, subsample_intv, sst_error_std
+
+!------------------------------------------------------------------------
+! start of executable code
+!------------------------------------------------------------------------
+
+! Read and Record the necessary parameters from input.nml
+call initialize_utilities()
+call find_namelist_in_file('input.nml', 'oi_sst_to_obs_nml', iunit)
+read(iunit, nml = oi_sst_to_obs_nml, iostat = io)
+
+if (do_nml_file()) write(nmlfileunit, nml=oi_sst_to_obs_nml)
+if (do_nml_term()) write( * , nml=oi_sst_to_obs_nml)
+
+call set_calendar_type(GREGORIAN)
+
+ncid = nc_open_file_readonly(input_file, routine)
+ndays = nc_get_dimension_size(ncid, 'time', routine)
+nlat = nc_get_dimension_size(ncid, 'lat', routine)
+nlon = nc_get_dimension_size(ncid, 'lon', routine)
+
+allocate(time(ndays), lat(nlat), lon(nlon))
+
+call nc_get_variable(ncid, 'time', time, routine)
+call nc_get_variable(ncid, 'lat', lat, routine)
+call nc_get_variable(ncid, 'lon', lon, routine)
+
+! ensure longitudes are [0,360]
+where(lon < 0.0_r8) lon = lon + 360.0_r8
+
+base_time = set_base_time(ncid)
+
+num_new_obs = nlon*nlat
+
+allocate(sst(nlon,nlat))
+
+call static_init_obs_sequence()
+
+io = nf90_inq_varid(ncid, 'sst', varid)
+call nc_check(io, routine, context='getting sst variable ID',ncid=ncid)
+call nc_get_attribute_from_variable(ncid,'sst','missing_value',missing_value,routine)
+
+TIMELOOP: do itime = 1,ndays
+
+ ! time is stored in the file 2 ways: as real(double) seconds since 1981/1/1,
+ ! and as 4 and 2 digit strings for year/mon/day/hr/min
+ ! both of these are variables, not attributes
+
+ ! convert to integer days and seconds, and add on to reference time.
+ iday = time(itime)
+ isec = (time(itime) - iday) * 86400
+ delta_time = set_time(isec, iday)
+ obs_time = base_time + delta_time
+ call get_time(obs_time, osec, oday)
+
+ ! call print_time(obs_time, str='obs time is ')
+ ! call print_date(obs_time, str='obs date is ')
+
+ call get_date(obs_time, year, month, day, hour, minutes, seconds)
+
+ seconds = seconds + (hour*60 + minutes)*60
+
+ write(string1,'(i4,''-'',i2.2,''-'',i2.2,''-'',i5.5)') year,month,day,seconds
+ write(output_file,*) trim(output_file_base)//'.'//trim(string1)
+ write(*,*)'output file is ',trim(output_file)
+
+ io = nf90_get_var(ncid, varid, sst, start=(/1,1,itime/), count=(/nlon,nlat,1/))
+ call nc_check(io, routine, context='get_var sst', ncid=ncid)
+
+ first_obs = .true.
+ nmissing = 0
+ call init_obs( obs, num_copies, num_qc)
+ call init_obs(prev_obs, num_copies, num_qc)
+ call init_obs_sequence(obs_seq, num_copies, num_qc, num_new_obs)
+ call set_copy_meta_data(obs_seq, 1, 'SST observation')
+ call set_qc_meta_data(obs_seq, 1, 'SST QC')
+
+ obslooplat: do j = 1, nlat, subsample_intv
+ obslooplon: do i = 1, nlon, subsample_intv
+
+ if (sst(i,j) == missing_value) then
+ nmissing = nmissing + 1
+ cycle obslooplon
+ endif
+
+ call create_3d_obs(lat(j), lon(i), 0.0_r8, VERTISSURFACE, sst(i,j), &
+ OI_SEA_SURFACE_TEMPERATURE, sst_error_std, oday, osec, qc, obs)
+ call add_obs_to_seq(obs_seq, obs, obs_time, prev_obs, prev_time, first_obs)
+
+ enddo obslooplon
+ enddo obslooplat
+
+ ! if we added any obs to the sequence, write it out to a file now.
+ if ( get_num_obs(obs_seq) > 0 ) then
+ if (debug) print *, 'writing obs_seq, obs_count = ', get_num_obs(obs_seq)
+ if (debug) print *, ' skipping = ', nmissing
+ call write_obs_seq(obs_seq, output_file)
+ else
+ write(string1,*)'no observations for output file'
+ write(string2,*)'"'//trim(output_file)//'"'
+ call error_handler(E_MSG, routine, string1, text2=string2)
+ endif
+
+ call destroy_obs_sequence(obs_seq)
+
+end do TIMELOOP
+
+call nc_close_file(ncid,routine)
+
+call error_handler(E_MSG, routine, 'Finished successfully.')
+call finalize_utilities()
+
+contains
+
+
+!> time:units = "days since 1800-01-01 00:00:00" ;
+
+function set_base_time(ncid)
+
+integer, intent(in) :: ncid
+type(time_type) :: set_base_time
+
+character(len=256) :: timeunits
+integer :: io
+integer :: year, month, day, hour, minute, second
+
+call nc_get_attribute_from_variable(ncid,'time','units',timeunits,'set_base_time')
+
+read(timeunits,100,iostat=io) year, month, day, hour, minute, second
+
+if (io /= 0) then
+ write(string1,*)'unable to read time base'
+ call error_handler(E_ERR, 'set_base_time', string1, &
+ source, revision, revdate, text2=timeunits)
+endif
+
+100 format(11x,i4,5(1x,i2))
+
+set_base_time = set_date(year, month, day, hour, minute, second)
+
+if (debug) then
+ write(*,*)'time units is ',trim(timeunits)
+ call print_time(set_base_time, str='obs time is ')
+ call print_date(set_base_time, str='obs date is ')
+endif
+
+end function set_base_time
+
+end program oi_sst_to_obs
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/observations/obs_converters/SST/oi_sst_to_obs.nml b/observations/obs_converters/SST/oi_sst_to_obs.nml
new file mode 100644
index 0000000000..535ffa801b
--- /dev/null
+++ b/observations/obs_converters/SST/oi_sst_to_obs.nml
@@ -0,0 +1,10 @@
+# the time of the observations is appended to the output_file_base to result in names like
+# obs_seq_oisst.2004-01-03-00000 (the format used by CESM)
+
+&oi_sst_to_obs_nml
+ input_file = 'sst.day.mean.2004.nc'
+ output_file_base = 'obs_seq_oisst'
+ ssterror_std = 0.3
+ subsample_intv = 1
+ debug = .false.
+ /
diff --git a/observations/obs_converters/SST/shell_scripts/Prepare_SST.sh b/observations/obs_converters/SST/shell_scripts/Prepare_SST.sh
new file mode 100755
index 0000000000..f494a45a34
--- /dev/null
+++ b/observations/obs_converters/SST/shell_scripts/Prepare_SST.sh
@@ -0,0 +1,88 @@
+#!/bin/bash
+#
+# 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
+#
+# This script is based on code donated to DART by Romain Escudier
+# who was at Rutgers at the time. Thanks Romain!
+#
+# DART $Id$
+
+. ./parameters_SST
+. functions.sh
+
+# module purge
+# module load netcdf/4.3.0-gcc4.4.7
+# module load gsl/2.1-gcc4.4.7 nco/4.6.1
+
+echo " "
+echo "generating netcdf files in : ${DIR_OUT}"
+echo "generating dart files in : ${DIR_OUT_DART}"
+echo "representation error is ${ERROR_REP}"
+echo " "
+
+# Get name of mask
+mask_file=../masks/Mask_${REGION}${FILE_SUFF}.nc
+
+# Create directory for outputs
+mkdir -p ${DIR_OUT_DART}
+
+# Get the number of days to prepare
+n_days=$(get_timediff_dates ${STARTDATE} ${ENDDATE})
+
+# Loop on days
+for i_day in $( seq 0 $(($n_days)) ) ; do
+
+ # Get date of this loop iteration
+ my_date=$(get_date_from_cycle ${i_day} $STARTDATE 1)
+ my_year=${my_date:0:4} # Year
+ echo "Preparing date : ${my_date}"
+ mkdir -p ${DIR_OUT}/${my_year}
+
+ # Region selection
+ file_in=${DIR_IN}/${my_year}/${FILE_PREF}${my_date}${FILE_SUFF}.nc
+ file_out=${DIR_OUT}/${my_year}/${FILE_PREF}${my_date}${FILE_SUFF}_${REGION}.nc
+
+ if [ -f ${file_out} ]; then
+ echo "WARNING: Region Selection output file already exists."
+ echo "WARNING: ${file_out}"
+ echo "WARNING: not subsetting again."
+ else
+ echo "input netcdf file in : ${file_in}"
+ echo "subsetted netcdf file in : ${file_out}"
+ echo "using mask : ${mask_file}"
+
+ ./prepare_SST_file_NWA.sh ${file_in} ${file_out} ${mask_file} || exit 1
+
+ echo "Finished prepare_SST_file_NWA.sh"
+ fi
+
+ echo " "
+
+ # Transform to DART format
+ file_dart_out=${DIR_OUT_DART}/${FILE_DART_PREF}${my_date}${FILE_DART_SUFF}
+ if [ -f ${file_dart_out} ]; then
+ echo "WARNING: DART observation sequence file already exists."
+ echo "WARNING: ${file_dart_out}"
+ echo "WARNING: Not creating it again."
+ else
+ echo "creating ${file_dart_out}"
+
+ sed -e "s;;${file_out};g" \
+ -e "s;;${file_dart_out};g" \
+ -e "s;;dart_sst2seq_err${ERROR_REP}_${my_date}.out;g" \
+ -e "s;;temp.nml;g" \
+ -e "s;;${ERROR_REP};g" input.nml.template > input.nml
+
+ ../work/sst_to_obs || exit 2
+ rm -f temp.nml
+ fi
+ echo " "
+done
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/shell_scripts/functions.sh b/observations/obs_converters/SST/shell_scripts/functions.sh
new file mode 100755
index 0000000000..b887f75738
--- /dev/null
+++ b/observations/obs_converters/SST/shell_scripts/functions.sh
@@ -0,0 +1,454 @@
+#!/bin/bash
+#
+# This code was donated to DART by Romain Escudier, who was at Rutgers at the time.
+# It is not protected by the DART copyright agreement. Thanks Romain!
+#
+# DART $Id$
+#
+#---------------------------------------------------------------------------------------------#
+# #
+# Shell functions #
+# #
+#---------------------------------------------------------------------------------------------#
+
+# List of functions
+# Time functions
+# - get_sum_from_array(array) : Compute sum of an array
+# - get_date_from_cycle(cycle,startdate,dt) : Compute date from cycle and start date
+# - get_timediff_dates(date1,date2) : Compute difference in days between two dates
+# - is_leap_year(year) : Determine if year is leap year
+# - print_time_dart(date) : Display date in format (YYYY-MM-DD HH:MM:SS)
+# - print_time_dart_list(date) : Display date in format (YYYY, MM, DD, HH, MM, SS)
+# Netcdf functions
+# - get_param_from_nc(file,var) : Get parameter value from netCDF file
+# - get_ndim_from_nc(file,dim) : Get dimension size from netCDF file
+# Miscellaneous
+# - compute_eq_integer_result(eq) : Compute truncated result of equation
+# - comp_files_md5sum(file1,file2) : Compare md5sum of two files
+# - str2num(str) : Convert string (with padded 0) to num
+# - prog_bar(i,N) : Display a progress bar for loop in codes
+
+
+nb_days_months=(31 28 31 30 31 30 31 31 30 31 30 31)
+
+#---------------------------------------------------------------------------------------------#
+# Compute sum of an array
+
+get_sum_from_array() {
+
+declare -i TOTAL=0
+for vari in $*; do
+ TOTAL=${TOTAL}+${vari}
+done
+echo ${TOTAL}
+
+}
+
+#---------------------------------------------------------------------------------------------#
+# Compute date from cycle and start date
+
+get_date_from_cycle() { CYCLE=$1 ; STARTDATE=$2 ; DTCYCLE=$3
+
+ if (( ${CYCLE}<0 )); then
+ get_date_from_cycle_neg ${CYCLE} ${STARTDATE} ${DTCYCLE}
+ elif (( ${CYCLE}==0 )); then
+ echo ${STARTDATE}
+ else
+
+ # Local variable
+ declare -i ISTP_TMP=$(( ${CYCLE}*$DTCYCLE )) # Remaining number of days
+ declare -i YEAR_START=$(str2num ${STARTDATE:0:4})
+ declare -i YEAR_TMP=$(str2num ${YEAR_START})
+ declare -i MONT_TMP=$(str2num ${STARTDATE:4:2})
+ declare -i DAYS_TMP=$(str2num ${STARTDATE:6:2})
+
+ #######################################################
+ # FIND WHICH YEAR FOR CYCLE
+ #######################################################
+
+ while ((${ISTP_TMP}>=0))
+ do
+ declare -i NDAYS=365
+ # check if it is a leap year
+ IS_LEAP=$(is_leap_year ${YEAR_TMP})
+ if [ "${IS_LEAP}" = true ] ; then
+ NDAYS=366
+ fi
+
+ # Different if it is the first year (may not start on Jan 1st)
+ if ((${YEAR_TMP} == ${YEAR_START})) ; then
+ if ((${MONT_TMP}>3)) || [ "${IS_LEAP}" = false ]; then
+ NDAYS=$(get_sum_from_array ${nb_days_months[*]:${MONT_TMP}-1})-${DAYS_TMP}+1
+ else
+ NDAYS=$(get_sum_from_array ${nb_days_months[*]:${MONT_TMP}-1})-${DAYS_TMP}+2
+ fi
+ fi
+ ISTP_TMP=${ISTP_TMP}-${NDAYS}
+ YEAR_TMP=YEAR_TMP+1
+ done
+
+ YEAR_TMP=YEAR_TMP-1
+ if ((${YEAR_TMP} != ${YEAR_START})) ; then
+ MONT_TMP=1
+ DAYS_TMP=1
+ fi
+
+ ISTP_TMP=$((${ISTP_TMP}+${NDAYS}+$DAYS_TMP))
+
+ #######################################################
+ # FIND WHICH MONTH FOR CYCLE
+ #######################################################
+
+ while ((${ISTP_TMP}>0))
+ do
+ NDAYS=${nb_days_months[${MONT_TMP}-1]}
+ if ((${MONT_TMP} == 2)) ; then
+ if [ "${IS_LEAP}" = true ] ; then
+ NDAYS=29
+ fi
+ fi
+ ISTP_TMP=${ISTP_TMP}-${NDAYS}
+ MONT_TMP=MONT_TMP+1
+ done
+
+ MONT_TMP=MONT_TMP-1
+ declare -i DAYS_TMP=$((${ISTP_TMP}+${NDAYS}))
+
+ MONT_DISP=$( printf "%02d" ${MONT_TMP} )
+ DAYS_DISP=$( printf "%02d" ${DAYS_TMP} )
+ echo "${YEAR_TMP}${MONT_DISP}${DAYS_DISP}"
+ fi
+
+}
+
+get_date_from_cycle_neg() { CYCLE=$1 ; STARTDATE=$2 ; DTCYCLE=$3
+
+ # Local variable
+ declare -i ISTP_TMP=$(( ${CYCLE}*$DTCYCLE )) # Remaining number of days
+ declare -i YEAR_START=$(str2num ${STARTDATE:0:4})
+ declare -i YEAR_TMP=$(str2num ${YEAR_START})
+ declare -i MONT_START=$(str2num ${STARTDATE:4:2})
+ declare -i MONT_TMP=$(str2num ${MONT_START})
+ declare -i DAYS_TMP=$(str2num ${STARTDATE:6:2})
+
+ #######################################################
+ # FIND WHICH YEAR FOR CYCLE
+ #######################################################
+
+ while ((${ISTP_TMP}<=0))
+ do
+ declare -i NDAYS=365
+ # check if it is a leap year
+ IS_LEAP=$(is_leap_year ${YEAR_TMP})
+ if [ "${IS_LEAP}" = true ] ; then
+ NDAYS=366
+ fi
+
+ # Different if it is the first year (may not start on Jan 1st)
+ if ((${YEAR_TMP} == ${YEAR_START})) ; then
+ if ((${MONT_TMP}>3)) || [ "${IS_LEAP}" = false ]; then
+ NDAYS=$(get_sum_from_array ${nb_days_months[*]:0:${MONT_TMP}-1})+${DAYS_TMP}
+ else
+ NDAYS=$(get_sum_from_array ${nb_days_months[*]:0:${MONT_TMP}-1})+${DAYS_TMP}-1
+ fi
+ fi
+ ISTP_TMP=${ISTP_TMP}+${NDAYS}
+ YEAR_TMP=YEAR_TMP-1
+ done
+
+ YEAR_TMP=YEAR_TMP+1
+ if ((${YEAR_TMP} != ${YEAR_START})) ; then
+ MONT_TMP=12
+ DAYS_TMP=31
+ fi
+
+ ISTP_TMP=$((${ISTP_TMP}-${NDAYS}))
+
+ #######################################################
+ # FIND WHICH MONTH FOR CYCLE
+ #######################################################
+
+ while ((${ISTP_TMP}<=0))
+ do
+ NDAYS=${nb_days_months[${MONT_TMP}-1]}
+ if ((${MONT_TMP} == ${MONT_START})) ; then
+ NDAYS=${DAYS_TMP}
+ else
+ if ((${MONT_TMP} == 2)) ; then
+ if [ "${IS_LEAP}" = true ] ; then
+ NDAYS=29
+ fi
+ fi
+ fi
+ ISTP_TMP=${ISTP_TMP}+${NDAYS}
+ MONT_TMP=MONT_TMP-1
+ done
+
+ MONT_TMP=MONT_TMP+1
+ declare -i DAYS_TMP=${ISTP_TMP}
+
+ MONT_DISP=$( printf "%02d" ${MONT_TMP} )
+ DAYS_DISP=$( printf "%02d" ${DAYS_TMP} )
+ echo "${YEAR_TMP}${MONT_DISP}${DAYS_DISP}"
+
+}
+
+
+
+#---------------------------------------------------------------------------------------------#
+# Compute difference in days between two dates
+
+get_timediff_dates() { DATE1=$1 ; DATE2=$2
+
+ declare -i YEAR1=${DATE1:0:4} MONT1=$(str2num ${DATE1:4:2}) DAYS1=$(str2num ${DATE1:6:2})
+ declare -i YEAR2=${DATE2:0:4} MONT2=$(str2num ${DATE2:4:2}) DAYS2=$(str2num ${DATE2:6:2})
+
+ declare -i NTIME=0
+
+ #######################################################
+ # Loop on years
+ #######################################################
+ for YEAR_TMP in $( seq ${YEAR1} $((${YEAR2}-1)) ) ; do
+ declare -i NDAYS=365
+ # check if it is a leap year
+ IS_LEAP=$(is_leap_year ${YEAR_TMP})
+
+ if [ "${IS_LEAP}" = true ] ; then
+ NDAYS=366
+ fi
+ NTIME=${NTIME}+${NDAYS}
+
+ done
+
+ #######################################################
+ # Remove year1 days
+ #######################################################
+ LEAP1=$(is_leap_year ${YEAR1})
+ if [[ "${LEAP1}" = true && ((${MONT1} > 2)) ]] ; then
+ NDAYS=$(get_sum_from_array ${nb_days_months[*]:0:$((${MONT1}-1))})+1
+ else
+ NDAYS=$(get_sum_from_array ${nb_days_months[*]:0:$((${MONT1}-1))})
+ fi
+ NDAYS=${NDAYS}+${DAYS1}
+ NTIME=${NTIME}-NDAYS
+
+ #######################################################
+ # Add year2 days
+ #######################################################
+ LEAP2=$(is_leap_year ${YEAR2})
+ if [[ "${LEAP2}" = true && ((${MONT2} > 2)) ]] ; then
+ NDAYS=$(get_sum_from_array ${nb_days_months[*]:0:$((${MONT2}-1))})+1
+ else
+ NDAYS=$(get_sum_from_array ${nb_days_months[*]:0:$((${MONT2}-1))})
+ fi
+ NDAYS=${NDAYS}+${DAYS2}
+ NTIME=${NTIME}+NDAYS
+
+ echo ${NTIME}
+}
+
+
+
+#---------------------------------------------------------------------------------------------#
+# Determine if year is leap year
+
+is_leap_year() { YEAR_TMP=$1
+
+ IS_LEAP=false
+ # check if it is a leap year
+ declare -i B4=0
+ declare -i B100=0
+ declare -i B400=0
+ B4=$((${YEAR_TMP}/4))
+ B4=$(($B4*4))
+ B100=$((${YEAR_TMP}/100))
+ B100=$(($B100*100))
+ B400=$((${YEAR_TMP}/400))
+ B400=$(($B400*400))
+ if ((${YEAR_TMP} == $B4 )) ; then
+ if ((${YEAR_TMP} == $B100)) ; then
+ if ((${YEAR_TMP} == $B400)) ; then
+ IS_LEAP=true
+ fi
+ else
+ IS_LEAP=true
+ fi
+ fi
+ echo $IS_LEAP
+}
+
+
+#---------------------------------------------------------------------------------------------#
+# Compute difference in seconds between two standard dates
+
+get_timediff_dates_std() { DATE1=$1 ; DATE2=$2
+
+ YEAR1=${DATE1:0:4} MONT1=${DATE1:5:2} DAYS1=${DATE1:8:2}
+ YEAR2=${DATE2:0:4} MONT2=${DATE2:5:2} DAYS2=${DATE2:8:2}
+ declare -i HOUR1=$(str2num ${DATE1:11:2}) MIN1=$(str2num ${DATE1:14:2}) SEC1=$(str2num ${DATE1:17:2})
+ declare -i HOUR2=$(str2num ${DATE2:11:2}) MIN2=$(str2num ${DATE2:14:2}) SEC2=$(str2num ${DATE2:17:2})
+
+ NDAYS=$(get_timediff_dates $YEAR1$MONT1$DAYS1 $YEAR2$MONT2$DAYS2)
+
+ NSEC1AFTER=$(( (24-$HOUR1-1) * 3600 + (60-$MIN1-1) * 60 + (60-$SEC1) ))
+ NSEC2BEFOR=$(( $HOUR2 * 3600 + $MIN2 * 60 + $SEC2 ))
+
+ NSEC_TOT=$(( $NSEC1AFTER+$NSEC2BEFOR+($NDAYS-1)*86400 ))
+
+ echo $NSEC_TOT
+}
+
+
+#---------------------------------------------------------------------------------------------#
+# Get parameter value from netCDF file
+
+get_param_from_nc() { FILENAME=$1 ; VARNAME=$2
+
+ VARVALUE=$(ncdump -v ${VARNAME} ${FILENAME} | awk -F "data:" 'RS="ceci1est8une9valeur5impossible" {print $2}' | \
+ awk -F "[=,;]" '{print $2}' | xargs);
+ echo ${VARVALUE}
+
+}
+
+#---------------------------------------------------------------------------------------------#
+# Get dimension size from netCDF file
+
+get_ndim_from_nc() { FILENAME=$1 ; DIMNAME=$2
+
+ DIMLINE=$(ncdump -h ${FILENAME} | awk -F "variables:" 'RS="ceci1est8une9valeur5impossible" {print $1}' | \
+ grep ${DIMNAME})
+ NDIM=$(awk -F "[=,;]" '{print $2}' <<< $DIMLINE | xargs)
+ if [ "$NDIM" == "UNLIMITED" ]; then
+ NDIM=$(awk -F "[(,)]" '{print $2}' <<< $DIMLINE | awk '{print $1}' | xargs)
+ fi
+ echo ${NDIM}
+
+}
+
+#---------------------------------------------------------------------------------------------#
+# Display date in dart format for namelists (YYYY-MM-DD HH:MM:SS)
+
+print_time_dart() { MYDATE=$1
+
+ MYYEAR=${MYDATE:0:4}
+ MYMONTH=${MYDATE:4:2}
+ MYDAY=${MYDATE:6:2}
+
+ MYHR=${MYDATE:8:2}
+ MYMN=${MYDATE:10:2}
+ MYSC=${MYDATE:12:2}
+ if [ -z $MYHR ] ; then
+ DATEOUT="${MYYEAR}-${MYMONTH}-${MYDAY} 00:00:00"
+ else
+ if [ -z $MYMN ] ; then
+ DATEOUT="${MYYEAR}-${MYMONTH}-${MYDAY} ${MYHR}:00:00"
+ else
+ if [ -z $MYSC ] ; then
+ DATEOUT="${MYYEAR}-${MYMONTH}-${MYDAY} ${MYHR}:${MYMN}:00"
+ else
+ DATEOUT="${MYYEAR}-${MYMONTH}-${MYDAY} ${MYHR}:${MYMN}:${MYSC}"
+ fi
+ fi
+ fi
+ echo ${DATEOUT}
+
+}
+
+
+#---------------------------------------------------------------------------------------------#
+# Display date in dart list format for namelists (YYYY, MM, DD, HH, MM, SS)
+
+print_time_dart_list() { MYDATE=$1
+
+ MYYEAR=${MYDATE:0:4}
+ MYMONTH=${MYDATE:4:2}
+ MYDAY=${MYDATE:6:2}
+
+ MYHR=${MYDATE:8:2}
+ MYMN=${MYDATE:10:2}
+ MYSC=${MYDATE:12:2}
+ if [ -z $MYHR ] ; then
+ DATEOUT="${MYYEAR}, ${MYMONTH}, ${MYDAY}, 0, 0, 0"
+ else
+ if [ -z $MYMN ] ; then
+ DATEOUT="${MYYEAR}, ${MYMONTH}, ${MYDAY}, ${MYHR}, 0, 0"
+ else
+ if [ -z $MYSC ] ; then
+ DATEOUT="${MYYEAR}, ${MYMONTH}, ${MYDAY}, ${MYHR}, ${MYMN}, 0"
+ else
+ DATEOUT="${MYYEAR}, ${MYMONTH}, ${MYDAY}, ${MYHR}, ${MYMN}, ${MYSC}"
+ fi
+ fi
+ fi
+
+ echo ${DATEOUT}
+
+}
+
+#---------------------------------------------------------------------------------------------#
+# Compute truncated result of equation
+
+compute_eq_integer_result() { EQUATION=$1
+
+ res=$(echo "scale=0; $1" | bc -l)
+ echo ${res%.*}
+
+}
+
+#---------------------------------------------------------------------------------------------#
+# Compare md5sum of two files
+
+comp_files_md5sum() { FILE1=$1 ; FILE2=$2
+
+ sum1=$( md5sum ${FILE1} ); sum1=${sum1%${FILE1}}
+ sum2=$( md5sum ${FILE2} ); sum2=${sum2%${FILE2}}
+
+ if [ "${sum1}" == "${sum2}" ] ; then
+ echo "true"
+ else
+ echo "false"
+ fi
+
+}
+
+#---------------------------------------------------------------------------------------------#
+# Convert string (with padded 0) to num
+
+str2num() { STR=$1
+
+echo $(( 10#$STR ))
+
+}
+
+
+
+#---------------------------------------------------------------------------------------------#
+# Disp progress bar
+
+plot_bar() { I=$1; N_TOT=$2
+
+repl() { printf "$1"'%.s' $(eval "echo {1.."$(($2))"}"); }
+
+if (( $I % $(($N_TOT/100)) == 0 )); then
+ perc=$(($I*100/$N_TOT))
+ size=$(($(tput cols)*6/10))
+ if (( perc > 0 )); then
+ size_bar=$(($size*perc/100))
+ bar=$(repl "#" $size_bar )
+ size_blank=$(($size-$size_bar))
+ blank=$(repl "_" $size_blank)
+ disp="["$bar$blank"]\t($perc%)\t \r"
+ else
+ blank=$(repl "_" $size)
+ disp="["$blank"]\t($perc%)\t \r"
+ fi
+ echo -ne $disp
+fi
+
+}
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/shell_scripts/get_sst_ftp.sh b/observations/obs_converters/SST/shell_scripts/get_sst_ftp.sh
new file mode 100755
index 0000000000..2995421c51
--- /dev/null
+++ b/observations/obs_converters/SST/shell_scripts/get_sst_ftp.sh
@@ -0,0 +1,44 @@
+#!/bin/bash
+#
+# This code was donated to DART by Romain Escudier, who was at Rutgers at the time.
+# It is not protected by the DART copyright agreement. Thanks Romain!
+#
+# DART $Id$
+
+if [ $# -gt 0 ]; then
+ YEAR=$1
+else
+ echo "must supply a year as an argument"
+ exit 1
+fi
+
+. ./parameters_SST
+
+mkdir -p ${DIR_IN}/${YEAR}
+cd ${DIR_IN}/${YEAR}
+
+for i_day in $( seq 1 366 ) ; do
+ printf -v DDAY "%03d" $i_day
+
+ wget ${FTP_ADDRESS}/${YEAR}/${DDAY}/*.nc*
+ cmd_status=$?
+
+ if (( cmd_status==0 )); then
+ file_tmp=$(ls *.nc.md5 | awk -F ".md5" '{print $1}')
+ md5file=$(md5sum ${file_tmp} | awk '{print $1}')
+ md5veri=$(cat ${file_tmp}.md5 | awk '{print $1}')
+ if [ "$md5file" != "$md5veri" ]; then
+ echo "Error! Files md5 not matching!"
+ break
+ fi
+ rm ${file_tmp}.md5
+ bunzip2 ${file_tmp}
+ fi
+
+done
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/shell_scripts/input.nml.template b/observations/obs_converters/SST/shell_scripts/input.nml.template
new file mode 100644
index 0000000000..af05a3ea3f
--- /dev/null
+++ b/observations/obs_converters/SST/shell_scripts/input.nml.template
@@ -0,0 +1,47 @@
+! local operator does not do ray-path reconstruction
+! obs levels are in kilometers
+! flist contains a list of input filenames to convert into a single
+! output file
+&sst_to_obs_nml
+ sst_netcdf_file = '',
+ sst_netcdf_filelist = '',
+ sst_out_file = ''
+ subsample_intv = 1
+ sst_rep_error =
+ /
+
+&utilities_nml
+ TERMLEVEL = 1
+ module_details = .false.
+ logfilename = ''
+ nmlfilename = ''
+ print_debug = .false.
+ write_nml = 'file'
+ /
+
+&obs_sequence_nml
+ write_binary_obs_sequence = .false.
+ /
+
+&location_nml
+ horiz_dist_only = .false.
+ vert_normalization_pressure = 100000.0
+ vert_normalization_height = 10000.0
+ vert_normalization_level = 20.0
+ vert_normalization_scale_height = 5.0
+ approximate_distance = .false.
+ nlon = 71
+ nlat = 36
+ output_box_info = .true.
+ print_box_level = 0
+ special_vert_normalization_obs_types = 'null'
+ special_vert_normalization_pressures = 100000.0
+ special_vert_normalization_heights = 10000.0
+ special_vert_normalization_levels = 20.0
+ special_vert_normalization_scale_heights = 5.0
+ /
+
+&obs_kind_nml
+ /
+
+
diff --git a/observations/obs_converters/SST/shell_scripts/parameters_SST b/observations/obs_converters/SST/shell_scripts/parameters_SST
new file mode 100644
index 0000000000..d346595184
--- /dev/null
+++ b/observations/obs_converters/SST/shell_scripts/parameters_SST
@@ -0,0 +1,55 @@
+#!/bin/bash
+#
+# This code was donated to DART by Romain Escudier, who was at Rutgers at the time.
+# It is not protected by the DART copyright agreement. Thanks Romain!
+#
+# DART $Id$
+
+######################################################################
+# Global parameters
+######################################################################
+
+# PERIOD
+STARTDATE=20101230
+ENDDATE=20101231
+
+# ERROR OF REPRESENTATIVITY
+ERROR_REP=3.0
+
+######################################################################
+# Select region
+######################################################################
+
+# AREA OF STUDY
+REGION=NWA
+
+######################################################################
+# Directories
+######################################################################
+
+FTP_ADDRESS=ftp://podaac-ftp.jpl.nasa.gov/allData/ghrsst/data/GDS2/L4/GLOB/NCEI/AVHRR_OI/v2
+
+# FILES DIRECTORY
+DIR_IN=../ObsData/SST/ncfile
+DIR_OUT=../ObsData/SST/nwaSST
+
+# FILES NAMES
+FILE_PREF=
+FILE_SUFF=120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0
+
+######################################################################
+# Transform to DART format
+######################################################################
+
+# FILES DIRECTORY
+DIR_OUT_DART=/glade/scratch/${USER}/ObsData/SST/obsSEQ/v2/Err30
+
+# FILES NAMES
+FILE_DART_PREF=obs_seq.sst.
+FILE_DART_SUFF=
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/shell_scripts/prepare_SST_file_NWA.sh b/observations/obs_converters/SST/shell_scripts/prepare_SST_file_NWA.sh
new file mode 100755
index 0000000000..8414e2b423
--- /dev/null
+++ b/observations/obs_converters/SST/shell_scripts/prepare_SST_file_NWA.sh
@@ -0,0 +1,53 @@
+#!/bin/bash
+#
+# This code was donated to DART by Romain Escudier, who was at Rutgers at the time.
+# It is not protected by the DART copyright agreement. Thanks Romain!
+#
+# DART $Id$
+
+#---------------------------------------------------------------------------------------------#
+# Get parameter value from netCDF file
+
+get_param_from_nc() { FILENAME=$1 ; VARNAME=$2
+ VARVALUE=$(ncdump -v ${VARNAME} ${FILENAME} | awk '{FS="data:"; RS="ceci1est8une9valeur5impossible"; print $2}');
+ VARVALUE=${VARVALUE#*=}; VARVALUE=${VARVALUE%;*\}}
+ echo ${VARVALUE}
+}
+
+#---------------------------------------------------------------------------------------------#
+# Main program
+
+set -e
+
+SST_file_in=$1
+SST_file_out=$2
+mask_NWA=$3
+
+if [ ! -f ${SST_file_out} ]; then
+
+ #module load gsl/2.1-gcc4.4.7 nco/4.6.1 2> /dev/null
+ # Create output file
+ cp ${SST_file_in} ${SST_file_out}
+
+ # Get time from infile (will be erased by append in ncks)
+ my_time=$(get_param_from_nc ${SST_file_out} time)
+
+ # Append the ROMS mask to output file
+ ncks -A -v mask_roms ${mask_NWA} ${SST_file_out}
+
+ ## Compute the composite mask
+ ncap2 -O -s "mask=mask_roms*mask" ${SST_file_out} ${SST_file_out}
+
+ # Select area
+ ncks -O -x -v mask_roms -d lon,-102.66,-43.81 -d lat,7.78,54.83 ${SST_file_out} ${SST_file_out}
+
+ # Put the correct time
+ ncap2 -O -s "time[time]=time-time+${my_time}" ${SST_file_out} ${SST_file_out}
+
+fi
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/sst_to_obs.f90 b/observations/obs_converters/SST/sst_to_obs.f90
new file mode 100644
index 0000000000..2c8fbbb289
--- /dev/null
+++ b/observations/obs_converters/SST/sst_to_obs.f90
@@ -0,0 +1,359 @@
+! 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
+!
+! DART $Id$
+
+program sst_to_obs
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! sst_to_obs -
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+use types_mod, only : r8, MISSING_R8
+
+use time_manager_mod, only : time_type, set_calendar_type, GREGORIAN, set_time, &
+ increment_time, get_time, set_date, operator(-), &
+ print_date, operator(+)
+
+use utilities_mod, only : initialize_utilities, find_namelist_in_file, &
+ check_namelist_read, nmlfileunit, do_output, &
+ get_next_filename, error_handler, E_ERR, E_MSG, &
+ find_textfile_dims, finalize_utilities, &
+ do_nml_file, do_nml_term
+
+use netcdf_utilities_mod, only : nc_check
+
+use location_mod, only : VERTISSURFACE, set_location
+
+use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
+ static_init_obs_sequence, init_obs, destroy_obs, &
+ write_obs_seq, init_obs_sequence, get_num_obs, &
+ insert_obs_in_seq, destroy_obs_sequence, &
+ set_copy_meta_data, set_qc_meta_data, set_qc, &
+ set_obs_values, set_obs_def, insert_obs_in_seq
+
+use obs_def_mod, only : obs_def_type, &
+ set_obs_def_key, &
+ set_obs_def_time, &
+ set_obs_def_type_of_obs, &
+ set_obs_def_error_variance, &
+ set_obs_def_location
+
+use obs_kind_mod, only : QTY_TEMPERATURE, SATELLITE_INFRARED_SST
+
+use netcdf
+
+implicit none
+
+! version controlled file description for error handling, do not edit
+character(len=*), parameter :: source = &
+ '$URL$'
+character(len=*), parameter :: revision = '$Revision$'
+character(len=*), parameter :: revdate = '$Date$'
+
+integer, parameter :: num_copies = 1, & ! number of copies in sequence
+ num_qc = 1 ! number of QC entries
+
+character(len=256) :: next_infile
+character(len=512) :: string1, string2
+
+integer :: ncid, varid, io, iunit, filenum
+integer :: oday, osec, iday, isec
+integer :: num_new_obs, obs_num
+integer :: i, j, k, nlat, nlon
+integer :: i_base, j_base, tmp_day
+
+logical :: first_obs, from_list = .false.
+
+real(r8) :: obs_val(1), qc_val(1), d_qc(1), dtime
+
+type(obs_def_type) :: obs_def
+type(obs_sequence_type) :: obs_seq
+type(obs_type) :: obs, prev_obs
+type(time_type) :: obs_time, base_time, delta_time
+
+real(r8), allocatable :: temperature(:,:)
+real(r8), allocatable :: t_err(:,:)
+real(r8), allocatable :: glat(:), glon(:)
+real(r8) :: scale_factor, add_offset
+real(r8) :: tmp_qc
+
+integer, allocatable :: t_qc(:,:)
+integer, allocatable :: t_mask(:,:)
+
+!------------------------------------------------------------------------
+! Declare namelist parameters
+!------------------------------------------------------------------------
+
+character(len=256) :: sst_netcdf_file = '1234567.nc'
+character(len=256) :: sst_netcdf_filelist = 'sst_to_obs_filelist'
+character(len=256) :: sst_out_file = 'obs_seq.sst'
+logical :: debug = .false.
+integer :: subsample_intv = 1
+
+! representation error, which depends on model/data grid size,
+! is a very small value for NOAA OI SST
+real(r8) :: sst_rep_error = 0.3 ! minimum SST observation error
+
+namelist /sst_to_obs_nml/ sst_netcdf_file, &
+ sst_netcdf_filelist, sst_out_file, &
+ debug, subsample_intv, sst_rep_error
+
+! start of executable code
+
+
+! time is stored relative to Jan 1, 1981 for NOAA OI sst data.
+
+call set_calendar_type(GREGORIAN)
+base_time = set_date(1981, 1, 1, 0, 0, 0)
+
+! read the necessary parameters from input.nml
+call initialize_utilities()
+call find_namelist_in_file('input.nml', 'sst_to_obs_nml', iunit)
+read(iunit, nml = sst_to_obs_nml, iostat = io)
+
+! Record the namelist values used for the run
+if (do_nml_file()) write(nmlfileunit, nml=sst_to_obs_nml)
+if (do_nml_term()) write( * , nml=sst_to_obs_nml)
+
+! cannot have both a single filename and a list;
+! the namelist must shut one off.
+
+if (sst_netcdf_file /= '' .and. sst_netcdf_filelist /= '') then
+ call error_handler(E_ERR, 'sst_to_obs', &
+ 'One of sst_netcdf_file or filelist must be NULL', &
+ source, revision, revdate)
+endif
+if (sst_netcdf_filelist /= '') from_list = .true.
+
+! Get number of observations
+if (from_list) then
+ next_infile = get_next_filename(sst_netcdf_filelist, 1)
+else
+ next_infile = sst_netcdf_file
+endif
+
+call nc_check( nf90_open(next_infile, nf90_nowrite, ncid), 'open '//trim(next_infile))
+call nc_check( nf90_inq_dimid(ncid, 'lon', varid), 'inq dimid lon')
+call nc_check( nf90_inquire_dimension(ncid, varid, len=nlon), 'inq dimlon')
+call nc_check( nf90_inq_dimid(ncid, 'lat', varid), 'inq dimid lat')
+call nc_check( nf90_inquire_dimension(ncid, varid, len=nlat), 'inq dimlat')
+call nc_check( nf90_close(ncid) , 'close file')
+
+!>@todo FIXME ... num_new_obs is only correct if there is only 1 input file
+num_new_obs = nlon*nlat
+
+! Initialize
+allocate(temperature(nlon,nlat))
+allocate( t_err(nlon,nlat))
+allocate( t_qc(nlon,nlat))
+allocate( t_mask(nlon,nlat))
+
+allocate(glat(nlat), glon(nlon))
+
+call static_init_obs_sequence()
+call init_obs(obs, num_copies, num_qc)
+call init_obs(prev_obs, num_copies, num_qc)
+call init_obs_sequence(obs_seq, num_copies, num_qc, num_new_obs)
+
+do k = 1, num_copies
+ call set_copy_meta_data(obs_seq, k, 'SST observation')
+enddo
+
+do k = 1, num_qc
+ call set_qc_meta_data(obs_seq, k, 'SST QC')
+enddo
+
+obs_num = 1
+d_qc(1) = 0.0_r8
+first_obs = .true.
+
+! main loop that does either a single file or a list of files
+
+filenum = 1
+fileloop: do ! until out of files
+
+ ! get the single name, or the next name from a list
+ if (from_list) then
+ next_infile = get_next_filename(sst_netcdf_filelist, filenum)
+ else
+ next_infile = sst_netcdf_file
+ if (filenum > 1) next_infile = ''
+ endif
+ if (next_infile == '') exit fileloop
+
+ ! open the next profile file
+ call nc_check( nf90_open(next_infile, nf90_nowrite, ncid), 'file open', next_infile)
+
+ ! time is stored in the file 2 ways: as real(double) seconds since 1981/1/1,
+ ! and as 4 and 2 digit strings for year/mon/day/hr/min
+ ! both of these are variables, not attributes
+
+ ! start out with converting the real time.
+ call nc_check( nf90_inq_varid(ncid, 'time', varid) ,'inq varid time')
+ call nc_check( nf90_get_var(ncid, varid, dtime) ,'get var time')
+
+ ! convert to integer days and seconds, and add on to reference time.
+ iday = int( dtime / 86400.0_r8)
+ isec = int( dtime - iday * 86400)
+ delta_time = set_time(isec, iday)
+ obs_time = base_time + delta_time
+ call get_time(obs_time, osec, oday)
+
+ ! get the lat/lon arrays
+
+ io = nf90_inq_varid(ncid, 'lon', varid)
+ call nc_check(io,'inq_varid "lon"')
+
+ io = nf90_get_var(ncid, varid, glon)
+ call nc_check(io, 'get_var "lon"')
+
+ ! ensure longitudes are [0,360]
+ where(glon < 0.0_r8) glon = glon + 360.0_r8
+
+ io = nf90_inq_varid(ncid, 'lat', varid)
+ call nc_check(io, 'inq_varid "lat"')
+
+ io = nf90_get_var(ncid, varid, glat)
+ call nc_check(io, 'get_var "lat"')
+
+ ! if present, the data values from 'temperature'
+ io = nf90_inq_varid(ncid, 'analysed_sst', varid)
+
+ if (io /= nf90_noerr ) then
+ call error_handler(E_MSG, 'sst_to_obs', trim(next_infile)//' has no sst')
+ cycle fileloop
+ endif
+
+ ! Get temperature, scale and offset
+
+ io = nf90_get_var(ncid, varid, temperature, &
+ start=(/1,1,1/), count=(/nlon,nlat,1/))
+ call nc_check(io, 'get_var analysed_sst')
+
+ io = nf90_get_att(ncid, varid, 'scale_factor',scale_factor)
+ call nc_check(io, 'get_att analysed_sst scale_factor')
+
+ io = nf90_get_att(ncid, varid, 'add_offset', add_offset)
+ call nc_check(io, 'get_att analysed_sst add_offset')
+
+ temperature = temperature * scale_factor + add_offset
+
+ ! Get analysis_error, scale and offset
+
+ io = nf90_inq_varid(ncid,'analysis_error',varid)
+ call nc_check(io,'inq_varid analysis_error')
+
+ io = nf90_get_var(ncid, varid, t_qc, &
+ start=(/1,1,1/), count=(/nlon,nlat,1/))
+ call nc_check(io, 'get_var analysis_error')
+
+ io = nf90_get_att(ncid, varid, 'scale_factor', scale_factor)
+ call nc_check(io, 'get att analysis_error scale_factor')
+
+ io = nf90_get_att(ncid, varid, 'add_offset', add_offset)
+ call nc_check(io, 'get att analysis_error add_offset')
+
+ t_qc = t_qc * scale_factor + add_offset
+
+ ! Get data mask
+
+ io = nf90_inq_varid(ncid, 'mask', varid)
+ call nc_check(io, 'inq_varid mask')
+
+ io = nf90_get_var(ncid, varid, t_mask, start=(/1,1,1/), count=(/nlon,nlat,1/))
+ call nc_check(io, 'get_var mask')
+
+ call nc_check( nf90_close(ncid) , 'closing "'//trim(next_infile)//'"')
+
+ tmp_day = mod( oday,subsample_intv*subsample_intv )
+ if( tmp_day == 0 ) tmp_day = subsample_intv*subsample_intv
+ j_base = 1 + int((tmp_day-1)/subsample_intv)
+ i_base = mod(tmp_day,subsample_intv)
+ if( i_base == 0 ) i_base = subsample_intv
+
+ obslooplat: do j = j_base, nlat, subsample_intv
+ obslooplon: do i = i_base, nlon, subsample_intv
+
+ ! check qc here. if bad, skip the rest of this block
+ ! we want small observation error smaller than 1 degree C
+ tmp_qc = t_qc(i,j) + sst_rep_error
+
+ if (tmp_qc < 20.0_r8 .and. t_mask(i,j) == 1.0_r8) then
+
+ ! set qc to a good dart val
+ d_qc(1) = 0.0 ! for dart, a QC of 0 is good
+
+ call set_obs_def_location(obs_def, &
+ set_location(glon(i), glat(j), 0.0_r8, VERTISSURFACE))
+ call set_obs_def_type_of_obs(obs_def, SATELLITE_INFRARED_SST)
+ call set_obs_def_time(obs_def, set_time(osec, oday))
+ call set_obs_def_error_variance(obs_def, tmp_qc * tmp_qc)
+ call set_obs_def_key(obs_def, obs_num)
+ call set_obs_def(obs, obs_def)
+
+ obs_val(1) = temperature(i,j) - 273.15_r8
+ call set_obs_values(obs, obs_val)
+ qc_val(1) = d_qc(1)
+ call set_qc(obs, qc_val)
+
+ ! first one, insert with no prev. otherwise, since all times are the
+ ! same for this column, insert with the prev obs as the starting point.
+ ! (the first insert with no prev means it will search for the right
+ ! time ordered starting point.)
+ if (first_obs) then
+ call insert_obs_in_seq(obs_seq, obs)
+ first_obs = .false.
+ else
+ call insert_obs_in_seq(obs_seq, obs, prev_obs)
+ endif
+ obs_num = obs_num+1
+ prev_obs = obs
+
+ if (obs_num > num_new_obs) then
+ write(string1,*)'reached maximum number of observations while'
+ write(string2,*)'reading file # ',filenum,' "'//trim(next_infile)//'"'
+ call error_handler(E_ERR, 'sst_to_obs', string1, &
+ source, revision, revdate, text2=string2)
+ endif
+
+ endif
+
+ enddo obslooplon
+ enddo obslooplat
+
+ filenum = filenum + 1
+
+end do fileloop
+
+! done with main loop. if we added any obs to the sequence, write it out.
+if (obs_num > 0) then
+ print *, 'ready to write, nobs = ', get_num_obs(obs_seq)
+ if (get_num_obs(obs_seq) > 0) &
+ call write_obs_seq(obs_seq, sst_out_file)
+
+ ! minor stab at cleanup, in the off chance this will someday get turned
+ ! into a subroutine in a module. probably not all that needs to be done,
+ ! but a start.
+ call destroy_obs(obs)
+ !call destroy_obs(prev_obs) ! is this identical to obs?
+ ! get core dumps here, not sure why?
+ if (get_num_obs(obs_seq) > 0) call destroy_obs_sequence(obs_seq)
+else
+ call error_handler(E_ERR,'sst_to_obs','no obs converted', &
+ source, revision,revdate)
+endif
+
+call error_handler(E_MSG,'sst_to_obs','Finished successfully.')
+call finalize_utilities()
+
+end program sst_to_obs
+
+!
+! $URL$
+! $Id$
+! $Revision$
+! $Date$
diff --git a/observations/obs_converters/SST/sst_to_obs.nml b/observations/obs_converters/SST/sst_to_obs.nml
new file mode 100644
index 0000000000..fc8102d429
--- /dev/null
+++ b/observations/obs_converters/SST/sst_to_obs.nml
@@ -0,0 +1,9 @@
+&sst_to_obs_nml
+ sst_netcdf_file = '20121231120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0_NWA.nc'
+ sst_netcdf_filelist = ''
+ sst_out_file = 'obs_seq.sst'
+ subsample_intv = 1
+ sst_rep_error = 3.0
+ debug = .false.
+ /
+
diff --git a/observations/obs_converters/SST/work/input.nml b/observations/obs_converters/SST/work/input.nml
new file mode 100644
index 0000000000..4e157b8afe
--- /dev/null
+++ b/observations/obs_converters/SST/work/input.nml
@@ -0,0 +1,60 @@
+
+&preprocess_nml
+ overwrite_output = .true.
+ input_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
+ output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90'
+ input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
+ output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90'
+ input_files = '../../../../observations/forward_operators/obs_def_ocean_mod.f90'
+ /
+
+&sst_to_obs_nml
+ sst_netcdf_file = ''
+ sst_netcdf_filelist = ''
+ sst_out_file = ''
+ /
+
+# the time of the observations is appended to the output_file_base to result in names like
+# obs_seq_oisst.2004-01-03-00000 (the format used by CESM)
+# full year here:
+# input_file = '/glade/p/univ/cmia0001/Observations/OI.SST.v2/sst.day.mean.2004.nc'
+
+&oi_sst_to_obs_nml
+ input_file = '../data/sst.jan1.2004.nc'
+ output_file_base = 'obs_seq_oisst'
+ sst_error_std = 0.3
+ subsample_intv = 2
+ debug = .true.
+ /
+
+&obs_kind_nml
+ /
+
+&obs_def_gps_nml
+ /
+
+&location_nml
+ /
+
+&utilities_nml
+ module_details = .false.
+ /
+
+&obs_sequence_nml
+ write_binary_obs_sequence = .false.
+ /
+
+&obs_sequence_tool_nml
+ num_input_files = 2
+ filename_seq = '/t1/scratch/bjchoi/DART/ObsData/SST/obsSEQ/obs_seq.sst1.20111231'
+ '/t1/scratch/bjchoi/DART/ObsData/GTSPP/obsSEQ/obs_seq.gtspp201112.100km'
+ filename_out = '/t1/scratch/bjchoi/DART/ObsData/MERGEDobsSEQ/obs_seq.sst1_gtspp20111231'
+ print_only = .false.
+ gregorian_cal = .true.
+ synonymous_copy_list = 'GTSPP observation', 'SST observation', 'observation'
+ synonymous_qc_list = 'GTSPP QC', 'SST QC', 'QC'
+ first_obs_days = 150113
+ first_obs_seconds = 0
+ last_obs_days = 150114
+ last_obs_seconds = 86399
+ /
diff --git a/observations/obs_converters/SST/work/mkmf_advance_time b/observations/obs_converters/SST/work/mkmf_advance_time
new file mode 100755
index 0000000000..dea700d8c8
--- /dev/null
+++ b/observations/obs_converters/SST/work/mkmf_advance_time
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../../build_templates/mkmf -p advance_time -t ../../../../build_templates/mkmf.template \
+ -a "../../../.." path_names_advance_time
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/work/mkmf_obs_sequence_tool b/observations/obs_converters/SST/work/mkmf_obs_sequence_tool
new file mode 100755
index 0000000000..09a1f5ffee
--- /dev/null
+++ b/observations/obs_converters/SST/work/mkmf_obs_sequence_tool
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../../build_templates/mkmf -p obs_sequence_tool -t ../../../../build_templates/mkmf.template \
+ -a "../../../.." path_names_obs_sequence_tool
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/work/mkmf_oi_sst_to_obs b/observations/obs_converters/SST/work/mkmf_oi_sst_to_obs
new file mode 100755
index 0000000000..7da86d3147
--- /dev/null
+++ b/observations/obs_converters/SST/work/mkmf_oi_sst_to_obs
@@ -0,0 +1,19 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+ ../../../../build_templates/mkmf -p oi_sst_to_obs \
+ -t ../../../../build_templates/mkmf.template \
+ -a "../../../.." path_names_oi_sst_to_obs
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/work/mkmf_preprocess b/observations/obs_converters/SST/work/mkmf_preprocess
new file mode 100755
index 0000000000..ce35969343
--- /dev/null
+++ b/observations/obs_converters/SST/work/mkmf_preprocess
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../../build_templates/mkmf -p preprocess -t ../../../../build_templates/mkmf.template \
+ -a "../../../.." path_names_preprocess
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/work/mkmf_sst_to_obs b/observations/obs_converters/SST/work/mkmf_sst_to_obs
new file mode 100755
index 0000000000..dd63459188
--- /dev/null
+++ b/observations/obs_converters/SST/work/mkmf_sst_to_obs
@@ -0,0 +1,19 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+ ../../../../build_templates/mkmf -p sst_to_obs \
+ -t ../../../../build_templates/mkmf.template \
+ -a "../../../.." path_names_sst_to_obs
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SST/work/path_names_advance_time b/observations/obs_converters/SST/work/path_names_advance_time
new file mode 100644
index 0000000000..0c5aca12cb
--- /dev/null
+++ b/observations/obs_converters/SST/work/path_names_advance_time
@@ -0,0 +1,6 @@
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/parse_args_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/advance_time/advance_time.f90
diff --git a/observations/obs_converters/cice/work/path_names_seaice_thickness_to_obs_netcdf b/observations/obs_converters/SST/work/path_names_obs_sequence_tool
similarity index 95%
rename from observations/obs_converters/cice/work/path_names_seaice_thickness_to_obs_netcdf
rename to observations/obs_converters/SST/work/path_names_obs_sequence_tool
index 30db34af81..af3cd58e87 100644
--- a/observations/obs_converters/cice/work/path_names_seaice_thickness_to_obs_netcdf
+++ b/observations/obs_converters/SST/work/path_names_obs_sequence_tool
@@ -19,9 +19,9 @@ assimilation_code/modules/utilities/sort_mod.f90
assimilation_code/modules/utilities/time_manager_mod.f90
assimilation_code/modules/utilities/types_mod.f90
assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/obs_sequence_tool/obs_sequence_tool.f90
models/template/model_mod.f90
models/utilities/default_model_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
-observations/obs_converters/cice/seaice_thickness_to_obs_netcdf.f90
observations/obs_converters/utilities/obs_utilities_mod.f90
diff --git a/observations/obs_converters/cice/work/path_names_seaice_fy_to_obs_netcdf b/observations/obs_converters/SST/work/path_names_oi_sst_to_obs
similarity index 95%
rename from observations/obs_converters/cice/work/path_names_seaice_fy_to_obs_netcdf
rename to observations/obs_converters/SST/work/path_names_oi_sst_to_obs
index 595b16c686..8252316f2f 100644
--- a/observations/obs_converters/cice/work/path_names_seaice_fy_to_obs_netcdf
+++ b/observations/obs_converters/SST/work/path_names_oi_sst_to_obs
@@ -23,5 +23,5 @@ models/template/model_mod.f90
models/utilities/default_model_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
-observations/obs_converters/cice/seaice_fy_to_obs_netcdf.f90
observations/obs_converters/utilities/obs_utilities_mod.f90
+observations/obs_converters/SST/oi_sst_to_obs.f90
diff --git a/observations/obs_converters/SST/work/path_names_preprocess b/observations/obs_converters/SST/work/path_names_preprocess
new file mode 100644
index 0000000000..ae8022dafe
--- /dev/null
+++ b/observations/obs_converters/SST/work/path_names_preprocess
@@ -0,0 +1,5 @@
+assimilation_code/modules/utilities/null_mpi_utilities_mod.f90
+assimilation_code/modules/utilities/time_manager_mod.f90
+assimilation_code/modules/utilities/types_mod.f90
+assimilation_code/modules/utilities/utilities_mod.f90
+assimilation_code/programs/preprocess/preprocess.f90
diff --git a/observations/obs_converters/cice/work/path_names_seaice_sat_to_obs_netcdf b/observations/obs_converters/SST/work/path_names_sst_to_obs
similarity index 95%
rename from observations/obs_converters/cice/work/path_names_seaice_sat_to_obs_netcdf
rename to observations/obs_converters/SST/work/path_names_sst_to_obs
index 36995bf3be..8006d2693d 100644
--- a/observations/obs_converters/cice/work/path_names_seaice_sat_to_obs_netcdf
+++ b/observations/obs_converters/SST/work/path_names_sst_to_obs
@@ -23,5 +23,5 @@ models/template/model_mod.f90
models/utilities/default_model_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
-observations/obs_converters/cice/seaice_sat_to_obs_netcdf.f90
observations/obs_converters/utilities/obs_utilities_mod.f90
+observations/obs_converters/SST/sst_to_obs.f90
diff --git a/observations/obs_converters/SST/work/quickbuild.csh b/observations/obs_converters/SST/work/quickbuild.csh
new file mode 100755
index 0000000000..13cc8b207e
--- /dev/null
+++ b/observations/obs_converters/SST/work/quickbuild.csh
@@ -0,0 +1,70 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+#
+# compile all converter programs
+
+#----------------------------------------------------------------------
+# 'preprocess' is a program that culls the appropriate sections of the
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
+# so this MUST be run first.
+#----------------------------------------------------------------------
+
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
+\rm -f ../../../obs_def/obs_def_mod.f90
+\rm -f ../../../obs_kind/obs_kind_mod.f90
+
+set MODEL = "sst_to_obs"
+
+@ n = 1
+
+echo
+echo
+echo "---------------------------------------------------------------"
+echo "${MODEL} build number ${n} is preprocess"
+
+csh mkmf_preprocess
+make || exit $n
+
+./preprocess || exit 99
+
+#----------------------------------------------------------------------
+# Build all the single-threaded targets
+#----------------------------------------------------------------------
+
+foreach TARGET ( mkmf_* )
+
+ set PROG = `echo $TARGET | sed -e 's#mkmf_##'`
+
+ switch ( $TARGET )
+ case mkmf_preprocess:
+ breaksw
+ default:
+ @ n = $n + 1
+ echo
+ echo "---------------------------------------------------"
+ echo "${MODEL} build number ${n} is ${PROG}"
+ \rm -f ${PROG}
+ csh $TARGET || exit $n
+ make || exit $n
+ breaksw
+ endsw
+end
+
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
+
+echo "Success: All ${MODEL} programs compiled."
+
+exit 0
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/SSUSI/convert_f16_edr_dsk.f90 b/observations/obs_converters/SSUSI/convert_f16_edr_dsk.f90
index 6a8b31cd8e..aeaba066f3 100644
--- a/observations/obs_converters/SSUSI/convert_f16_edr_dsk.f90
+++ b/observations/obs_converters/SSUSI/convert_f16_edr_dsk.f90
@@ -30,10 +30,12 @@ program convert_f16_edr_dsk
use types_mod, only : r8, MISSING_R8, digits12
-use utilities_mod, only : nc_check, initialize_utilities, finalize_utilities, &
+use utilities_mod, only : initialize_utilities, finalize_utilities, &
find_namelist_in_file, check_namelist_read, do_output, &
error_handler, E_ERR, E_MSG
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file
+
use time_manager_mod, only : time_type, set_calendar_type, set_date, GREGORIAN, &
get_time, set_time, print_time, print_date
@@ -49,15 +51,13 @@ program convert_f16_edr_dsk
use obs_utilities_mod, only : getdimlen, getvar_real, getvar_real_2d, &
getvar_int, getvar_int_2d, add_obs_to_seq, create_3d_obs
-use netcdf
-
implicit none
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
'$URL$'
-character(len=32 ), parameter :: revision = '$Revision$'
-character(len=128), parameter :: revdate = '$Date$'
+character(len=*), parameter :: revision = '$Revision$'
+character(len=*), parameter :: revdate = '$Date$'
integer, parameter :: num_copies = 1, & ! number of copies in sequence
@@ -113,8 +113,7 @@ program convert_f16_edr_dsk
read(iunit, nml = convert_f16_edr_dsk_nml, iostat = io)
call check_namelist_read(iunit, io, 'convert_f16_edr_dsk_nml')
-call nc_check(nf90_open(input_netcdf_file, nf90_nowrite, ncid), &
- 'convert_f16_edr_dsk', 'opening file ['//trim(input_netcdf_file)//']')
+ncid = nc_open_file_readonly(input_netcdf_file, 'convert_f16_edr_dsk')
call getdimlen(ncid,"N_PIX_ALONG_DAY", n_pix_along_day)
call getdimlen(ncid,"N_PIX_ACROSS_DAY", n_pix_across_day)
@@ -152,8 +151,7 @@ program convert_f16_edr_dsk
where (ON2_uncertainty == org_missing) ON2_uncertainty = MISSING_R8
-call nc_check(nf90_close(ncid) , &
- 'convert_f16_edr_dsk', 'closing file '//trim(input_netcdf_file))
+call nc_close_file(ncid, 'convert_f16_edr_dsk')
! Ensure latitudes are within [-90,90]
where( latitude < -90.0_r8 ) latitude = -90.0_r8
diff --git a/observations/obs_converters/SSUSI/work/quickbuild.csh b/observations/obs_converters/SSUSI/work/quickbuild.csh
index 73127a7d44..8b6335f309 100755
--- a/observations/obs_converters/SSUSI/work/quickbuild.csh
+++ b/observations/obs_converters/SSUSI/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,20 +49,17 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
-
- \rm -f *.o *.mod
-
csh $TARGET || exit $n
make || exit $n
breaksw
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/WOD/wod_to_obs.f90 b/observations/obs_converters/WOD/wod_to_obs.f90
index e851639dc5..56b90acbd8 100644
--- a/observations/obs_converters/WOD/wod_to_obs.f90
+++ b/observations/obs_converters/WOD/wod_to_obs.f90
@@ -23,7 +23,7 @@ program wod_to_obs
use utilities_mod, only : initialize_utilities, find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_output, &
get_next_filename, error_handler, E_ERR, E_MSG, &
- nc_check, find_textfile_dims, finalize_utilities, &
+ find_textfile_dims, finalize_utilities, &
open_file, close_file
use location_mod, only : VERTISHEIGHT, set_location
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
diff --git a/observations/obs_converters/WOD/work/quickbuild.csh b/observations/obs_converters/WOD/work/quickbuild.csh
index 7810aecd44..9a73f3064c 100755
--- a/observations/obs_converters/WOD/work/quickbuild.csh
+++ b/observations/obs_converters/WOD/work/quickbuild.csh
@@ -6,16 +6,17 @@
#
# DART $Id$
#
-# This script compiles all executables in this directory.
+# compile all converter programs
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/cice/cice_to_obs.f90 b/observations/obs_converters/cice/cice_to_obs.f90
index 66d9d042d1..8ac1d50a21 100644
--- a/observations/obs_converters/cice/cice_to_obs.f90
+++ b/observations/obs_converters/cice/cice_to_obs.f90
@@ -28,15 +28,18 @@ program cice_to_obs
! ; *uint8
! ;=====================================================================================
+!>@todo right now no code uses netcdf or nc_check, so it's commented out.
+
use types_mod, only : r8, i2, i4, missing_r8
use utilities_mod, only : initialize_utilities, finalize_utilities, &
open_file, close_file, error_handler, E_ERR, &
do_nml_file, do_nml_term, nmlfileunit, &
find_namelist_in_file, check_namelist_read, &
- nc_check, get_unit
+ get_unit
+!use netcdf_utilities_mod, only : nc_check
use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
- operator(>=), increment_time, get_date, get_time, &
- operator(-), GREGORIAN, operator(+), print_date
+ get_date, get_time, GREGORIAN, &
+ operator(>=), operator(-), operator(+)
use location_mod, only : VERTISLEVEL, VERTISUNDEF
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
static_init_obs_sequence, init_obs, write_obs_seq, &
@@ -55,7 +58,7 @@ program cice_to_obs
SAT_SEAICE_SNOWVOLUME
-!> @todo FIXME - originally i thought we needed to read the netcdf file
+!>@todo FIXME - originally i thought we needed to read the netcdf file
!> which contained the model land mask. but creating observations from
!> the binary files is unrelated to the model grid so this code is
!> currently commented out and probably should be removed. BUT: it could
@@ -69,25 +72,26 @@ program cice_to_obs
implicit none
-character(len=11), parameter :: routine ='cice_to_obs'
+character(len=*), parameter :: routine ='cice_to_obs'
! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source = &
+character(len=*), parameter :: source = &
"$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate = "$Date$"
! this is based on the model, not on the satellite grid.
! ignore this for now. LANDMASK
!character(len=256) :: land_mask_file = 'cice_hist.nc'
-character(len=256) :: input_line, input_filename, next_file, out_file
+character(len=256) :: next_file
character(len=512) :: msgstring, msgstring1
-integer :: oday, osec, rcio, iunit, otype, io, rc
+integer :: oday, osec, iunit, io, rc
integer :: year, month, day, hour, minute, second
-integer :: num_copies, num_qc, max_obs, ilon, ilat, i, j
-integer :: start_index, ncid, varid
+integer :: num_copies, num_qc, max_obs, ilon, ilat
+integer :: start_index
+! integer :: ncid, varid
logical :: file_exist, first_obs
@@ -102,12 +106,8 @@ program cice_to_obs
type(obs_type) :: obs, prev_obs
type(time_type) :: time_obs, prev_time, curr_time, end_time, one_day
-! land_mask_file, &
-!> namelist items
-!> @todo : check that these defaults are reasonable
-
-!> these are determined by the format of the binary data files
-!> and probably shouldn't be changed.
+! these are determined by the format of the binary data files
+! and probably shouldn't be changed.
character(len=256) :: cice_lat_file = 'psn25lats_v3.dat'
character(len=256) :: cice_lon_file = 'psn25lons_v3.dat'
integer :: num_latitudes = 448
@@ -315,7 +315,7 @@ program cice_to_obs
if (append_to_existing_file .and. .not. use_obsseq_filename_pattern) then
call read_obs_seq(obsseq_out_file, 0, 0, max_obs, obs_seq)
else
- !> @todo FIXME tell user we are ignoring existing file and why
+ !>@todo FIXME tell user we are ignoring existing file and why
endif
endif
@@ -329,7 +329,7 @@ program cice_to_obs
call fix_filename(data_filename_pattern, next_file, year, month, day)
else
next_file = cice_data_file
- !> @todo make sure start_time = end_time if you aren't
+ !>@todo make sure start_time = end_time if you aren't
!> generating the filenames by pattern.
curr_time = end_time
endif
@@ -337,7 +337,7 @@ program cice_to_obs
if (use_obsseq_filename_pattern) then
call fix_filename(obsseq_filename_pattern, obsseq_out_file, year, month, day)
- !> @todo FIXME open the new output file?
+ !>@todo FIXME open the new output file?
! create a new, empty obs_seq. you must give a max limit
! on number of obs. increase the size if too small.
@@ -348,12 +348,11 @@ program cice_to_obs
! second needs the string 'QC'.
call set_copy_meta_data(obs_seq, 1, 'observation')
call set_qc_meta_data(obs_seq, 1, 'Data QC')
-
else
! the obsseq_out_file already has the right value
!obsseq_out_file = obsseq_data_file
- !> @todo make sure start_time = end_time if you aren't
+ !>@todo make sure start_time = end_time if you aren't
!> generating the filenames by pattern.
curr_time = end_time
endif
@@ -361,15 +360,7 @@ program cice_to_obs
! read in concentration data
!> see comment in cice_lat_file section
iunit = open_file(next_file, 'unformatted', 'read', 'stream')
- !iunit = get_unit()
- !open (iunit, file=trim(next_file), form='unformatted', action='read', &
- ! position='rewind', access='stream', status='old', iostat=rc)
- if (rc /= 0) then
- write(msgstring,*)'Cannot open file "'//trim(next_file)//'" for reading'
- write(msgstring1,*)'Error code was ', rc
- call error_handler(E_ERR, 'open_file: ', msgstring, source, revision, revdate, &
- text2=msgstring1)
- endif
+
if (debug) print *, 'opened data file ' // trim(next_file)
read(iunit) rawdata_i2
percent(:,:) = reshape(real(rawdata_i2, r8) / data_scale_factor, (/ num_latitudes, num_longitudes /) )
@@ -425,7 +416,7 @@ program cice_to_obs
! here is where we decide to loop again for another day or exit if
! we have converted the last day's file.
- !> @todo FIXME: here if we're looping over the output, write the
+ !>@todo FIXME: here if we're looping over the output, write the
!> obs_seq file and open a new one
! if we added any obs to the sequence, write it out to a file now.
@@ -434,7 +425,7 @@ program cice_to_obs
call write_obs_seq(obs_seq, obsseq_out_file)
endif
- !> destroy the obs_seq so we don't have a mem leak
+ ! destroy the obs_seq so we don't have a mem leak
call destroy_obs_sequence(obs_seq)
if (curr_time >= end_time) exit obsloop
@@ -450,7 +441,7 @@ program cice_to_obs
call write_obs_seq(obs_seq, obsseq_out_file)
endif
-!> clean up
+! clean up
call destroy_obs_sequence(obs_seq)
! LANDMASK
@@ -463,6 +454,7 @@ program cice_to_obs
contains
+!-----------------------------------------------------------------------
!> take a character string which must contain YYYY, MM, and DD
!> and substitute the year, month and day. it is an error to
!> have a pattern without all 3 items.
@@ -479,8 +471,8 @@ subroutine fix_filename(inpattern, outstring, year, month, day)
outstring = inpattern
-!> substitute year for YYYY, month for MM, day for DD
-!> @todo add error handling
+! substitute year for YYYY, month for MM, day for DD
+!>@todo add error handling
start_index = index(outstring, 'YYYY')
if (start_index < 0) then
diff --git a/observations/obs_converters/cice/make_obs_aggre.ncl b/observations/obs_converters/cice/make_obs_aggre.ncl
new file mode 100644
index 0000000000..bfc81be1af
--- /dev/null
+++ b/observations/obs_converters/cice/make_obs_aggre.ncl
@@ -0,0 +1,150 @@
+; 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
+;
+; DART $Id$
+
+case = "free_rsnw_2005to2010"
+
+tmember = 30 ;pick one of the ensemble members as truth
+
+dom = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+
+year = 2005
+
+filedir = "/glade/scratch_new/yfzhang/archive/cesm2_0_alpha06n/truth/"
+
+outdir = "/$WORK/observations/syn/cesm2/"+case+"/t"+tmember+"/"
+
+ncdfhead = addfile("/$WORK/headfiles/cice_hist.nc","r")
+
+lat = ncdfhead->TLAT
+lon = ncdfhead->TLON
+
+printVarSummary(lat)
+
+ni = 320
+nj = 384
+
+lat!0 = "nj"
+lat!1 = "ni"
+
+lon!0 = "nj"
+lon!1 = "ni"
+
+ncat = 5
+
+miu = 0
+sigma = 0.1
+
+rseed1 = toint(systemfunc(" date +%s"))
+rseed2 = toint((12345l*rseed1)%2147483398l)
+random_setallseed(rseed1, rseed2)
+
+
+do imonth = 3,9
+
+ month = sprinti("%0.2i",imonth+1)
+
+ if (year.eq.2005 .and. imonth.eq.3) then
+ days = 1
+ else
+ days = 0
+ end if
+
+ do iday = days, dom(imonth)-1
+
+ day = sprinti("%0.2i",iday+1)
+
+ date = year+"-"+month+"-"+day
+
+ ncdf_t = addfile(filedir+case+".cice_00"+tmember+".r."+date+"-00000.nc","r")
+
+ aicen = doubletofloat(ncdf_t->aicen)
+
+ aice = dim_sum_n(aicen,0)
+
+ aice_obs = new((/nj,ni/),float)
+
+ do ilat = 0, nj -1
+
+ do ilon = 0, ni - 1
+
+ noise_add = new(1,float)
+
+ if (aice(ilat,ilon).gt.0.01) then
+
+ if (.not.ismissing(lat(ilat,ilon)) .and. lat(ilat,ilon).gt.40) then
+
+ if (aice(ilat,ilon).gt.0) then
+
+ err = aice(ilat,ilon)*sigma
+
+ noise_add = random_normal(miu,err,1)
+
+ aice_obs(ilat,ilon) = noise_add + aice(ilat,ilon)
+
+ else
+
+ aice_obs(ilat,ilon) = aice(ilat,ilon)
+
+ end if
+
+ end if
+ end if
+
+ end do
+
+ end do
+
+
+ aice_obs!0 = "nj"
+ aice_obs!1 = "ni"
+
+ aice_obs = where(aice_obs.gt.1,1,aice_obs)
+ aice_obs = where(aice_obs.lt.0,0,aice_obs)
+
+
+ fileout = outdir+"/synthetic_obs.aice."+date+".nc"
+
+ system("rm -rf "+fileout)
+
+ ncdfout = addfile(fileout,"c")
+
+ fAtt = True
+ fAtt@title ="Obs for perfect model experiments; only observations northern to 40 degreen North are converted"
+ fAtt@source_file ="Restart files from a CICE5 openloop case"
+ fAtt@Conventions ="None"
+ fAtt@creation_data=systemfunc("date")
+
+ dimNames =(/"nj","ni"/)
+ dimSizes =(/nj,ni/)
+ dimUnlim =(/ False, False/)
+ filedimdef(ncdfout,dimNames,dimSizes,dimUnlim)
+
+ filevardef(ncdfout, "lat", typeof(lat), getvardims(lat))
+ filevardef(ncdfout, "lon", typeof(lon), getvardims(lon))
+ filevardef(ncdfout, "aice", typeof(aice_obs), getvardims(aice_obs))
+
+ filevarattdef(ncdfout,"lat" ,lat)
+ filevarattdef(ncdfout,"lon" ,lon)
+ filevarattdef(ncdfout,"aice" ,aice_obs)
+
+ setfileoption(ncdfout,"DefineMode",False)
+
+ ncdfout->lat = (/lat/)
+ ncdfout->lon = (/lon/)
+ ncdfout->aice = (/aice_obs/)
+ delete(aice_obs)
+
+ end do
+
+ print(year + month+" finished")
+
+end do
+
+;
+; $URL$
+; $Revision$
+; $Date$
+
diff --git a/observations/obs_converters/cice/modis_ist_to_obs_netcdf.f90 b/observations/obs_converters/cice/modis_ist_to_obs_netcdf.f90
index 2a4b00f2a4..8501f6575d 100644
--- a/observations/obs_converters/cice/modis_ist_to_obs_netcdf.f90
+++ b/observations/obs_converters/cice/modis_ist_to_obs_netcdf.f90
@@ -5,23 +5,38 @@
! DART $Id$
!-----------------------------------------------------------------------
-!> modis_ist_to_obs_netcdf - input is a seaice-coverage file that has been
-!> converted from HDF to netCDF with an automated tool. this
-!> program then takes the unsigned byte/integer(1) data and
-!> converts it into a seaice coverage obs_seq file.
+!> modis_ist_to_obs_netcdf - input is a seaice temperature file that has
+!> been converted from HDF to netCDF with 'ncl_convert2nc'.
+!> This program then reads the netCDF file and creates an
+!> observation sequence file of the seaice temperatures.
!>
-!> Credits: Yongfei Zhang - University of Washington.
+!> Converter Credits: Yongfei Zhang - University of Washington.
+!>
+!> The data come from https://nsidc.org/data/MOD29E1D/versions/6#
+!> MODIS/Terra Sea Ice Extent and IST Daily L3 Global 4km EASE-Grid Day, Version 6
+!> "The MODIS/Terra Sea Ice Extent and IST Daily L3 Global 4km EASE-Grid Day
+!> (MOD29E1D) data set contains Northern and Southern Hemisphere daily sea ice
+!> extent and ice surface temperature (IST), gridded to a 4 km resolution
+!> Equal Area Scalable Earth Grid (EASE-Grid)."
+!>
+!> Please make sure you cite the data in accordance to the agreement:
+!>
+!> Hall, D. K. and G. A. Riggs. 2015. MODIS/Terra Sea Ice Extent and IST Daily
+!> L3 Global 4km EASE-Grid Day, Version 6. [MOD29E1D]. Boulder, Colorado USA.
+!> NASA National Snow and Ice Data Center Distributed Active Archive Center.
+!> doi: https://doi.org/10.5067/MODIS/MOD29E1D.006. [Date Accessed].
+!-----------------------------------------------------------------------
program modis_ist_to_obs_netcdf
-use types_mod, only : r8, PI, DEG2RAD
+use types_mod, only : r8
use utilities_mod, only : initialize_utilities, finalize_utilities, &
- open_file, close_file, find_namelist_in_file, &
+ find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_nml_file, &
- do_nml_term, nc_check
-use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
- operator(>=), increment_time, get_time, &
- operator(-), GREGORIAN, operator(+), print_date
+ do_nml_term
+use time_manager_mod, only : time_type, set_calendar_type, &
+ set_date, set_time, get_time, GREGORIAN, &
+ operator(>=), operator(-), operator(+)
use location_mod, only : VERTISSURFACE
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
static_init_obs_sequence, init_obs, &
@@ -30,11 +45,13 @@ program modis_ist_to_obs_netcdf
use obs_utilities_mod, only : create_3d_obs, add_obs_to_seq, getdimlen
use obs_kind_mod, only : SAT_SEAICE_AGREG_SURFACETEMP
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file, nc_check
+
use netcdf
implicit none
-character(len=64), parameter :: routine = 'modis_ist_to_obs_netcdf'
+character(len=*), parameter :: routine = 'modis_ist_to_obs_netcdf'
integer :: n, i, j, oday, osec, rcio, iunit, otype, io
integer :: num_copies, num_qc, max_obs, iacc, ialo, ncid, varid
@@ -56,17 +73,17 @@ program modis_ist_to_obs_netcdf
type(obs_type) :: obs, prev_obs
type(time_type) :: comp_day0, time_obs, prev_time
+! namelist with default values
+
integer :: year = 2000
integer :: doy = 1
-real(r8) :: terr = 3.0_r8
+real(r8) :: terr = 3.0_r8
+logical :: debug = .false. ! set to .true. to print info
character(len=256) :: seaice_input_file = 'seaicedata.input'
character(len=256) :: obs_out_file = 'obs_seq.out'
-character(len=256) :: maskfile = 'cice_hist.nc'
-logical :: debug = .false. ! set to .true. to print info
namelist /modis_ist_to_obs_nc_nml/ year, doy, terr, &
- seaice_input_file, obs_out_file, &
- maskfile, debug
+ seaice_input_file, obs_out_file, debug
! ------------------------
! start of executable code
@@ -82,40 +99,40 @@ program modis_ist_to_obs_netcdf
if (do_nml_file()) write(nmlfileunit, nml=modis_ist_to_obs_nc_nml)
if (do_nml_term()) write( * , nml=modis_ist_to_obs_nc_nml)
-! open netcdf file here.
-call nc_check( nf90_open(seaice_input_file, nf90_nowrite, ncid), &
- routine, 'opening file '//trim(seaice_input_file))
+ncid = nc_open_file_readonly(seaice_input_file, routine)
-! get dims along the swath path, and across the swath path. the rest of
-! the data arrays use these for their dimensions
+! get dims along and across the swath path
call getdimlen(ncid, 'nlon', axdim)
call getdimlen(ncid, 'nlat', aydim)
! remember that when you ncdump the netcdf file, the dimensions are
! listed in C order. when you allocate them for fortran, reverse the order.
allocate(seaice_temperature(axdim, aydim))
-allocate(lon(axdim,aydim), lat(axdim,aydim))
-allocate(qc_array(axdim,aydim))
-allocate(tmask(axdim,aydim))
+allocate( lat(axdim, aydim))
+allocate( lon(axdim, aydim))
+allocate( tmask(axdim, aydim))
+allocate( qc_array(axdim, aydim))
varname = 'tsfc'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, seaice_temperature), &
- routine, 'getting var '// trim(varname))
+io = nf90_inq_varid(ncid, varname, varid)
+call nc_check(io, routine, 'nf90_inq_varid "'//trim(varname)//'"')
+io = nf90_get_var(ncid, varid, seaice_temperature)
+call nc_check(io, routine, 'nf90_get_var "'//trim(varname)//'"')
!! obtain lat and lon
varname = 'lat'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lat), &
- routine, 'getting var '// trim(varname))
+io = nf90_inq_varid(ncid, varname, varid)
+call nc_check(io, routine, 'nf90_inq_varid "'//trim(varname)//'"')
+io = nf90_get_var(ncid, varid, lat)
+call nc_check(io, routine, 'nf90_get_var "'//trim(varname)//'"')
varname = 'lon'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lon), &
- routine, 'getting var '// trim(varname))
+io = nf90_inq_varid(ncid, varname, varid)
+call nc_check(io, routine, 'nf90_inq_varid "'//trim(varname)//'"')
+io = nf90_get_var(ncid, varid, lon)
+call nc_check(io, routine, 'nf90_get_var "'//trim(varname)//'"')
+
+call nc_close_file(ncid, routine, 'data file')
! convert -180/180 to 0/360
where (lon < 0.0_r8) lon = lon + 360.0_r8
@@ -174,34 +191,37 @@ program modis_ist_to_obs_netcdf
qc_array = 0 ! making synthetic observations so assume every observation is good
alongloop: do j = 1, aydim
-
acrossloop: do i = 1, axdim
-if (debug) print *, 'start of main loop, ', iacc, ialo
+ if (debug) print *, 'start of main loop, ', iacc, ialo
!! check the lat/lon values to see if they are ok
- if ( lat(i,j) > 90.0_r8 .or. lat(i,j) < 40.0_r8 ) cycle acrossloop
+ if ( lat(i,j) > 90.0_r8 .or. lat(i,j) < 40.0_r8 ) cycle acrossloop
if ( lon(i,j) < 0.0_r8 .or. lon(i,j) > 360.0_r8 ) cycle acrossloop
! the actual data values are denser, so inner loop here
- if (qc_array(i,j) /= 0) cycle acrossloop !reserve for future quality control
- if (seaice_temperature(i,j).gt.0.00_r8) cycle acrossloop !FIXME temporary do not assimilate
- !when observed sea ice is 0 coverage
- ! compute the lat/lon for this obs FIXME: this isn't right
- if (seaice_temperature(i,j).lt.-63.15_r8) cycle acrossloop
- thislat = lat(i,j)
+ if (qc_array(i,j) /= 0) cycle acrossloop !reserve for future quality control
+
+ !>@todo possibly use a higher QC value for suspicious observations
+ ! One strategy would be to assign suspicious observations a higher
+ ! QC value - this would allow the "input_qc_threshold" namelist to control
+ ! whether or not the observation would be assimilated as opposed to having
+ ! to modify source code and create multiple versions of the obs_seq file.
- thislon = lon(i,j)
+ if (seaice_temperature(i,j) > 0.00_r8) cycle acrossloop
+ if (seaice_temperature(i,j) < -63.15_r8) cycle acrossloop
- thiserr = terr
+ thislat = lat(i,j)
+ thislon = lon(i,j)
+ thiserr = terr
- ! make an obs derived type, and then add it to the sequence
- call create_3d_obs(thislat, thislon, 0.0_r8, VERTISSURFACE, seaice_temperature(i,j), &
- SAT_SEAICE_AGREG_SURFACETEMP, thiserr, oday, osec, qc, obs)
- call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
+ ! make an obs derived type, and then add it to the sequence
+ call create_3d_obs(thislat, thislon, 0.0_r8, VERTISSURFACE, seaice_temperature(i,j), &
+ SAT_SEAICE_AGREG_SURFACETEMP, thiserr, oday, osec, qc, obs)
+ call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
- if (debug) print *, 'added seaice obs to output seq'
+ if (debug) print *, 'added seaice obs to output seq'
end do acrossloop
end do alongloop
@@ -212,6 +232,8 @@ program modis_ist_to_obs_netcdf
call write_obs_seq(obs_seq, obs_out_file)
endif
+deallocate(seaice_temperature, lon, lat, qc_array, tmask)
+
! end of main program
call finalize_utilities()
diff --git a/observations/obs_converters/cice/seaice_syn_to_obs_netcdf.nml b/observations/obs_converters/cice/modis_ist_to_obs_netcdf.nml
similarity index 59%
rename from observations/obs_converters/cice/seaice_syn_to_obs_netcdf.nml
rename to observations/obs_converters/cice/modis_ist_to_obs_netcdf.nml
index 3b7510d67b..f191519d53 100644
--- a/observations/obs_converters/cice/seaice_syn_to_obs_netcdf.nml
+++ b/observations/obs_converters/cice/modis_ist_to_obs_netcdf.nml
@@ -1,12 +1,10 @@
-&seaice_to_obs_nc_nml
+&modis_ist_to_obs_nc_nml
year = 2000
doy = 1
- terr = 0.1
- cat = 1.0
+ terr = 3.0
seaice_input_file = 'seaicedata.input'
obs_out_file = 'obs_seq.out'
- maskfile = 'cice_hist.nc'
debug = .false.
/
diff --git a/observations/obs_converters/cice/seaice_sat_to_obs_netcdf.f90 b/observations/obs_converters/cice/seaice_aggre_to_obs_netcdf.f90
similarity index 54%
rename from observations/obs_converters/cice/seaice_sat_to_obs_netcdf.f90
rename to observations/obs_converters/cice/seaice_aggre_to_obs_netcdf.f90
index 6de3d12bb8..af2c99217c 100644
--- a/observations/obs_converters/cice/seaice_sat_to_obs_netcdf.f90
+++ b/observations/obs_converters/cice/seaice_aggre_to_obs_netcdf.f90
@@ -5,23 +5,31 @@
! DART $Id$
!-----------------------------------------------------------------------
-!> seaice_sat_to_obs_netcdf - input is a seaice-coverage file that has been
-!> converted from HDF to netCDF with an automated tool. this
-!> program then takes the unsigned byte/integer(1) data and
-!> converts it into a seaice coverage obs_seq file.
+!> seaice_aggre_to_obs_netcdf
+!> This program creates an observation sequence file that has a synthetic
+!> observation at every location in the netCDF file.
+!> 'make_obs_aggre.ncl' was used to add noise to a cice state which is
+!> then used as input to this program.
+!>
+!> An alternative method would be to use this program to create an
+!> observation sequence file with dummy values at each location and use the
+!> resulting 'obs_seq.in' as input for running 'perfect_model_obs'.
+!> This method would not require the use of ncl, but would require running
+!> 'perfect_model_obs'.
!>
!> Credits: Yongfei Zhang - University of Washington.
+!-----------------------------------------------------------------------
-program seaice_sat_to_obs_netcdf
+program seaice_aggre_to_obs_netcdf
-use types_mod, only : r8, PI, DEG2RAD
+use types_mod, only : r8
use utilities_mod, only : initialize_utilities, finalize_utilities, &
- open_file, close_file, find_namelist_in_file, &
+ find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_nml_file, &
- do_nml_term, nc_check
-use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
- operator(>=), increment_time, get_time, &
- operator(-), GREGORIAN, operator(+), print_date
+ do_nml_term
+use time_manager_mod, only : time_type, set_calendar_type, &
+ set_date, set_time, get_time, GREGORIAN, &
+ operator(>=), operator(-), operator(+)
use location_mod, only : VERTISSURFACE
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
static_init_obs_sequence, init_obs, &
@@ -30,11 +38,13 @@ program seaice_sat_to_obs_netcdf
use obs_utilities_mod, only : create_3d_obs, add_obs_to_seq, getdimlen
use obs_kind_mod, only : SAT_SEAICE_AGREG_CONCENTR
+use netcdf_utilities_mod, only : nc_open_file_readonly, nc_close_file, nc_check
+
use netcdf
implicit none
-character(len=24), parameter :: routine = 'seaice_sat_to_obs_netcdf'
+character(len=*), parameter :: routine = 'seaice_aggre_to_obs_netcdf'
integer :: n, i, j, oday, osec, rcio, iunit, otype, io
integer :: num_copies, num_qc, max_obs, iacc, ialo, ncid, varid
@@ -56,6 +66,8 @@ program seaice_sat_to_obs_netcdf
type(obs_type) :: obs, prev_obs
type(time_type) :: comp_day0, time_obs, prev_time
+! namelist with default values
+
integer :: year = 2000
integer :: doy = 1
real(r8) :: terr = 0.15_r8
@@ -64,7 +76,7 @@ program seaice_sat_to_obs_netcdf
character(len=256) :: maskfile = 'cice_hist.nc'
logical :: debug = .false. ! set to .true. to print info
-namelist /seaice_sat_to_obs_nc_nml/ year, doy, terr, &
+namelist /seaice_aggre_to_obs_nc_nml/ year, doy, terr, &
seaice_input_file, obs_out_file, &
maskfile, debug
@@ -74,57 +86,59 @@ program seaice_sat_to_obs_netcdf
call initialize_utilities(routine)
-call find_namelist_in_file('input.nml', 'seaice_sat_to_obs_nc_nml', iunit)
-read(iunit, nml = seaice_sat_to_obs_nc_nml, iostat = io)
-call check_namelist_read(iunit, io, 'seaice_sat_to_obs_nc_nml')
+call find_namelist_in_file('input.nml', 'seaice_aggre_to_obs_nc_nml', iunit)
+read(iunit, nml = seaice_aggre_to_obs_nc_nml, iostat = io)
+call check_namelist_read(iunit, io, 'seaice_aggre_to_obs_nc_nml')
! Record the namelist values used for the run
-if (do_nml_file()) write(nmlfileunit, nml=seaice_sat_to_obs_nc_nml)
-if (do_nml_term()) write( * , nml=seaice_sat_to_obs_nc_nml)
+if (do_nml_file()) write(nmlfileunit, nml=seaice_aggre_to_obs_nc_nml)
+if (do_nml_term()) write( * , nml=seaice_aggre_to_obs_nc_nml)
-! open netcdf file here.
-call nc_check( nf90_open(seaice_input_file, nf90_nowrite, ncid), &
- routine, 'opening file '//trim(seaice_input_file))
+ncid = nc_open_file_readonly(seaice_input_file, routine)
-! get dims along the swath path, and across the swath path. the rest of
-! the data arrays use these for their dimensions
+! get dims along and across the swath path
call getdimlen(ncid, 'ni', axdim)
call getdimlen(ncid, 'nj', aydim)
! remember that when you ncdump the netcdf file, the dimensions are
! listed in C order. when you allocate them for fortran, reverse the order.
allocate(seaice_concentr(axdim, aydim))
-allocate(lon(axdim,aydim), lat(axdim,aydim))
-allocate(qc_array(axdim,aydim))
-allocate(tmask(axdim,aydim))
+allocate( lat(axdim, aydim))
+allocate( lon(axdim, aydim))
+allocate( tmask(axdim, aydim))
+allocate( qc_array(axdim, aydim))
varname = 'aice'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, seaice_concentr), &
- routine, 'getting var '// trim(varname))
+io = nf90_inq_varid(ncid, varname, varid)
+call nc_check(io, routine, 'nf90_inq_varid "'//trim(varname)//'"')
+io = nf90_get_var(ncid, varid, seaice_concentr)
+call nc_check(io, routine, 'nf90_get_var "'//trim(varname)//'"')
!! obtain lat and lon
varname = 'lat'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lat), &
- routine, 'getting var '// trim(varname))
+io = nf90_inq_varid(ncid, varname, varid)
+call nc_check(io, routine, 'nf90_inq_varid "'//trim(varname)//'"')
+io = nf90_get_var(ncid, varid, lat)
+call nc_check(io, routine, 'nf90_get_var "'//trim(varname)//'"')
varname = 'lon'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lon), &
- routine, 'getting var '// trim(varname))
+io = nf90_inq_varid(ncid, varname, varid)
+call nc_check(io, routine, 'nf90_inq_varid "'//trim(varname)//'"')
+io = nf90_get_var(ncid, varid, lon)
+call nc_check(io, routine, 'nf90_get_var "'//trim(varname)//'"')
+
+call nc_close_file(ncid, routine, 'data file')
+
+! read in ocean/land mask from a different file.
+ncid = nc_open_file_readonly(maskfile, routine)
-! read in ocean/land mask
varname = 'tmask'
-call nc_check( nf90_open(maskfile,nf90_nowrite,ncid), &
- routine,'opening file'//trim(maskfile))
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, tmask), &
- routine, 'getting var '// trim(varname))
+io = nf90_inq_varid(ncid, varname, varid)
+call nc_check(io, routine, 'nf90_inq_varid "'//trim(varname)//'"')
+io = nf90_get_var(ncid, varid, tmask)
+call nc_check(io, routine, 'nf90_get_var "'//trim(varname)//'"')
+
+call nc_close_file(ncid, routine, 'mask file')
! convert -180/180 to 0/360
where (lon < 0.0_r8) lon = lon + 360.0_r8
@@ -182,38 +196,44 @@ program seaice_sat_to_obs_netcdf
qc_array = 0 ! making synthetic observations so assume every observation is good
+seaice_concentr = seaice_concentr/100.0_r8
alongloop: do j = 1, aydim
-
acrossloop: do i = 1, axdim
-if (debug) print *, 'start of main loop, ', iacc, ialo
+ if (debug) print *, 'start of main loop, ', iacc, ialo
!! check the lat/lon values to see if they are ok
- if ( lat(i,j) > 90.0_r8 .or. lat(i,j) < 40.0_r8 ) cycle acrossloop
+ if ( lat(i,j) > 90.0_r8 .or. lat(i,j) < 40.0_r8 ) cycle acrossloop
if ( lon(i,j) < 0.0_r8 .or. lon(i,j) > 360.0_r8 ) cycle acrossloop
- if ( seaice_concentr(i,j).gt.1) cycle acrossloop
+ if ( seaice_concentr(i,j) > 1 ) cycle acrossloop
! the actual data values are denser, so inner loop here
- if ( qc_array(i,j) /= 0) cycle acrossloop !reserve for future quality control
- if ( tmask(i,j) < 0.5_r8) cycle acrossloop !do not convert if it's a land grid
- ! if (seaice_concentr(i,j).lt.0.01_r8 .or. seaice_concentr(i,j).gt.1.0_r8) cycle acrossloop !FIXME temporary do not assimilate
- !when observed sea ice is 0 coverage
- ! compute the lat/lon for this obs FIXME: this isn't right
+ if ( qc_array(i,j) /= 0) cycle acrossloop !reserve for future quality control
+ if ( tmask(i,j) < 0.5_r8) cycle acrossloop !do not convert if it's a land grid
+
+ !>@todo possibly use a higher QC value for suspicious observations
+ ! One strategy would be to assign suspicious observations a higher
+ ! QC value - this would allow the "input_qc_threshold" namelist to control
+ ! whether or not the observation would be assimilated as opposed to having
+ ! to modify source code and create multiple versions of the obs_seq file.
- thislat = lat(i,j)
+ ! if (seaice_concentr(i,j) < 0.01_r8 .or. seaice_concentr(i,j) > 1.0_r8) cycle acrossloop
- thislon = lon(i,j)
+ thislat = lat(i,j)
+ thislon = lon(i,j)
- thiserr = seaice_concentr(i,j)*terr
- if (seaice_concentr(i,j).eq.0) thiserr = 0.05
+ !>@todo maybe thiserr = max(seaice_concentr(i,j)*terr, 0.05_r8)
- ! make an obs derived type, and then add it to the sequence
- call create_3d_obs(thislat, thislon, 0.0_r8, VERTISSURFACE, seaice_concentr(i,j), &
- SAT_SEAICE_AGREG_CONCENTR, thiserr, oday, osec, qc, obs)
- call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
+ thiserr = seaice_concentr(i,j)*terr
+ if (seaice_concentr(i,j) == 0.0_r8) thiserr = 0.05_r8
- if (debug) print *, 'added seaice obs to output seq'
+ ! make an obs derived type, and then add it to the sequence
+ call create_3d_obs(thislat, thislon, 0.0_r8, VERTISSURFACE, seaice_concentr(i,j), &
+ SAT_SEAICE_AGREG_CONCENTR, thiserr, oday, osec, qc, obs)
+ call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
+
+ if (debug) print *, 'added seaice obs to output seq'
end do acrossloop
end do alongloop
@@ -224,10 +244,12 @@ program seaice_sat_to_obs_netcdf
call write_obs_seq(obs_seq, obs_out_file)
endif
+deallocate(seaice_concentr, lon, lat, qc_array, tmask)
+
! end of main program
call finalize_utilities()
-end program seaice_sat_to_obs_netcdf
+end program seaice_aggre_to_obs_netcdf
!
! $URL$
diff --git a/observations/obs_converters/cice/seaice_sat_to_obs_netcdf.nml b/observations/obs_converters/cice/seaice_aggre_to_obs_netcdf.nml
similarity index 78%
rename from observations/obs_converters/cice/seaice_sat_to_obs_netcdf.nml
rename to observations/obs_converters/cice/seaice_aggre_to_obs_netcdf.nml
index 4dd9641573..8c2c3761ac 100644
--- a/observations/obs_converters/cice/seaice_sat_to_obs_netcdf.nml
+++ b/observations/obs_converters/cice/seaice_aggre_to_obs_netcdf.nml
@@ -1,8 +1,8 @@
-&seaice_sat_to_obs_nc_nml
+&seaice_aggre_to_obs_nc_nml
year = 2000
doy = 1
- terr = 0.1
+ terr = 0.15
seaice_input_file = 'seaicedata.input'
obs_out_file = 'obs_seq.out'
maskfile = 'cice_hist.nc'
diff --git a/observations/obs_converters/cice/seaice_fy_to_obs_netcdf.f90 b/observations/obs_converters/cice/seaice_fy_to_obs_netcdf.f90
deleted file mode 100644
index 8eb82436a2..0000000000
--- a/observations/obs_converters/cice/seaice_fy_to_obs_netcdf.f90
+++ /dev/null
@@ -1,234 +0,0 @@
-! 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
-!
-! DART $Id$
-
-!-----------------------------------------------------------------------
-!> seaice_fy_to_obs_netcdf - input is a seaice-coverage file that has been
-!> converted from HDF to netCDF with an automated tool. this
-!> program then takes the unsigned byte/integer(1) data and
-!> converts it into a seaice coverage obs_seq file.
-!>
-!> Credits: Yongfei Zhang - University of Washington.
-
-program seaice_fy_to_obs_netcdf
-
-use types_mod, only : r8, PI, DEG2RAD
-use utilities_mod, only : initialize_utilities, finalize_utilities, &
- open_file, close_file, find_namelist_in_file, &
- check_namelist_read, nmlfileunit, do_nml_file, &
- do_nml_term, nc_check
-use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
- operator(>=), increment_time, get_time, &
- operator(-), GREGORIAN, operator(+), print_date
-use location_mod, only : VERTISSURFACE
-use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
- static_init_obs_sequence, init_obs, &
- write_obs_seq, init_obs_sequence, get_num_obs, &
- set_copy_meta_data, set_qc_meta_data
-use obs_utilities_mod, only : create_3d_obs, add_obs_to_seq, getdimlen
-use obs_kind_mod, only : SAT_SEAICE_AGREG_FY
-
-use netcdf
-
-implicit none
-
-character(len=23), parameter :: routine = 'seaice_fy_to_obs_netcdf'
-
-integer :: n, i, j, oday, osec, rcio, iunit, otype, io
-integer :: num_copies, num_qc, max_obs, iacc, ialo, ncid, varid
-integer :: axdim, aydim
-integer :: along_base, across_base
-integer, allocatable :: qc_array(:,:)
-real(r8), allocatable :: tmask(:,:) ! float tmask:comment = "0 = land, 1 = ocean" ;
-character(len=128) :: varname
-
-logical :: file_exist, first_obs
-
-real(r8) :: temp, qc, wdir, wspeed, werr, thiserr
-real(r8) :: uwnd, uerr, vwnd, verr
-real(r8) :: dlon, dlat, thislon, thislat
-real(r8), allocatable :: lat(:,:), lon(:,:)
-real(r8), allocatable :: seaice_fy(:,:)
-
-type(obs_sequence_type) :: obs_seq
-type(obs_type) :: obs, prev_obs
-type(time_type) :: comp_day0, time_obs, prev_time
-
-integer :: year = 2000
-integer :: doy = 1
-real(r8) :: terr = 0.15_r8
-character(len=256) :: seaice_input_file = 'seaicedata.input'
-character(len=256) :: obs_out_file = 'obs_seq.out'
-character(len=256) :: maskfile = 'cice_hist.nc'
-logical :: debug = .false. ! set to .true. to print info
-
-namelist /seaice_fy_to_obs_nc_nml/ year, doy, terr, &
- seaice_input_file, obs_out_file, &
- maskfile, debug
-
-! ------------------------
-! start of executable code
-! ------------------------
-
-call initialize_utilities(routine)
-
-call find_namelist_in_file('input.nml', 'seaice_fy_to_obs_nc_nml', iunit)
-read(iunit, nml = seaice_fy_to_obs_nc_nml, iostat = io)
-call check_namelist_read(iunit, io, 'seaice_fy_to_obs_nc_nml')
-
-! Record the namelist values used for the run
-if (do_nml_file()) write(nmlfileunit, nml=seaice_fy_to_obs_nc_nml)
-if (do_nml_term()) write( * , nml=seaice_fy_to_obs_nc_nml)
-
-! open netcdf file here.
-call nc_check( nf90_open(seaice_input_file, nf90_nowrite, ncid), &
- routine, 'opening file '//trim(seaice_input_file))
-
-! get dims along the swath path, and across the swath path. the rest of
-! the data arrays use these for their dimensions
-call getdimlen(ncid, 'ni', axdim)
-call getdimlen(ncid, 'nj', aydim)
-
-! remember that when you ncdump the netcdf file, the dimensions are
-! listed in C order. when you allocate them for fortran, reverse the order.
-allocate(seaice_fy(axdim, aydim))
-allocate(lon(axdim,aydim), lat(axdim,aydim))
-allocate(qc_array(axdim,aydim))
-allocate(tmask(axdim,aydim))
-
-varname = 'fy'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, seaice_fy), &
- routine, 'getting var '// trim(varname))
-
-!! obtain lat and lon
-varname = 'lat'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lat), &
- routine, 'getting var '// trim(varname))
-
-varname = 'lon'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lon), &
- routine, 'getting var '// trim(varname))
-
-! read in ocean/land mask
-varname = 'tmask'
-call nc_check( nf90_open(maskfile,nf90_nowrite,ncid), &
- routine,'opening file'//trim(maskfile))
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, tmask), &
- routine, 'getting var '// trim(varname))
-
-! convert -180/180 to 0/360
-where (lon < 0.0_r8) lon = lon + 360.0_r8
-
-! time setup
-call set_calendar_type(GREGORIAN)
-
-!! all obs in a single file are the same time.
-comp_day0 = set_date(year, 1, 1, 0, 0, 0)
-time_obs = comp_day0 + set_time(0, doy)
-
-! extract time of observation into gregorian day, sec.
-call get_time(time_obs, osec, oday)
-
-! There's no actual "vertical" layers. But the 3rd dimension in seaice is category.
-
-! -------------------------
-
-! each observation in this series will have a single observation value
-! and a quality control flag. the max possible number of obs needs to
-! be specified but it will only write out the actual number created.
-max_obs = axdim*aydim
-num_copies = 1
-num_qc = 1
-
-! call the initialization code, and initialize two empty observation types
-call static_init_obs_sequence()
-call init_obs(obs, num_copies, num_qc)
-call init_obs(prev_obs, num_copies, num_qc)
-first_obs = .true.
-
-! create a new, empty obs_seq file. you must give a max limit
-! on number of obs. increase the size if too small.
-call init_obs_sequence(obs_seq, num_copies, num_qc, max_obs)
-
-! the first one needs to contain the string 'observation' and the
-! second needs the string 'QC'.
-call set_copy_meta_data(obs_seq, 1, 'observation')
-call set_qc_meta_data(obs_seq, 1, 'Data QC')
-
-! if you want to append to existing files (e.g. you have a lot of
-! small text files you want to combine), you can do it this way,
-! or you can use the obs_sequence_tool to merge a list of files
-! once they are in DART obs_seq format.
-
-! ! existing file found, append to it
-! inquire(file=obs_out_file, exist=file_exist)
-! if ( file_exist ) then
-! call read_obs_seq(obs_out_file, 0, 0, max_obs, obs_seq)
-! endif
-
-! we have to pick an error range. since this is a seaice cover fraction
-! observation, the valid values should go from 0 to 1.0, so pick 0.1 for now.
-qc = 0.0_r8 ! we will reject anything with a bad qc
-
-qc_array = 0 ! making synthetic observations so assume every observation is good
-
-alongloop: do j = 1, aydim
-
- acrossloop: do i = 1, axdim
-
-if (debug) print *, 'start of main loop, ', iacc, ialo
-
- !! check the lat/lon values to see if they are ok
- if ( lat(i,j) > 90.0_r8 .or. lat(i,j) < 40.0_r8 ) cycle acrossloop
- if ( lon(i,j) < 0.0_r8 .or. lon(i,j) > 360.0_r8 ) cycle acrossloop
-
- ! the actual data values are denser, so inner loop here
-
- if ( qc_array(i,j) /= 0) cycle acrossloop !reserve for future quality control
- if ( tmask(i,j) < 0.5_r8) cycle acrossloop !do not convert if it's a land grid
- if (seaice_fy(i,j) < 0.01_r8) cycle acrossloop !FIXME temporary do not assimilate
- !when observed sea ice is 0 coverage
- ! compute the lat/lon for this obs FIXME: this isn't right
-
- thislat = lat(i,j)
-
- thislon = lon(i,j)
-
- thiserr = terr*seaice_fy(i,j)
-
- ! make an obs derived type, and then add it to the sequence
- call create_3d_obs(thislat, thislon, 0.0_r8, VERTISSURFACE, seaice_fy(i,j), &
- SAT_SEAICE_AGREG_FY, thiserr, oday, osec, qc, obs)
- call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
-
- if (debug) print *, 'added seaice obs to output seq'
-
- end do acrossloop
-end do alongloop
-
-! if we added any obs to the sequence, write it out to a file now.
-if ( get_num_obs(obs_seq) > 0 ) then
- if (debug) print *, 'writing obs_seq, obs_count = ', get_num_obs(obs_seq)
- call write_obs_seq(obs_seq, obs_out_file)
-endif
-
-! end of main program
-call finalize_utilities()
-
-end program seaice_fy_to_obs_netcdf
-
-!
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
diff --git a/observations/obs_converters/cice/seaice_syn_to_obs_netcdf.f90 b/observations/obs_converters/cice/seaice_syn_to_obs_netcdf.f90
deleted file mode 100644
index 2a3205191d..0000000000
--- a/observations/obs_converters/cice/seaice_syn_to_obs_netcdf.f90
+++ /dev/null
@@ -1,235 +0,0 @@
-! 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
-!
-! DART $Id$
-
-!-----------------------------------------------------------------------
-!> seaice_syn_to_obs_netcdf - input is a seaice-coverage file that has been
-!> converted from HDF to netCDF with an automated tool. this
-!> program then takes the unsigned byte/integer(1) data and
-!> converts it into a seaice coverage obs_seq file.
-!>
-!> Credits: Yongfei Zhang - University of Washington.
-
-program seaice_syn_to_obs_netcdf
-
-use types_mod, only : r8, PI, DEG2RAD
-use utilities_mod, only : initialize_utilities, finalize_utilities, &
- open_file, close_file, find_namelist_in_file, &
- check_namelist_read, nmlfileunit, do_nml_file, &
- do_nml_term, nc_check
-use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
- operator(>=), increment_time, get_time, &
- operator(-), GREGORIAN, operator(+), print_date
-use location_mod, only : VERTISLEVEL
-use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
- static_init_obs_sequence, init_obs, &
- write_obs_seq, init_obs_sequence, get_num_obs, &
- set_copy_meta_data, set_qc_meta_data
-use obs_utilities_mod, only : create_3d_obs, add_obs_to_seq, getdimlen
-use obs_kind_mod, only : SYN_SEAICE_CONCENTR
-
-use netcdf
-
-implicit none
-
-character(len=24), parameter :: routine = 'seaice_syn_to_obs_netcdf'
-
-integer :: n, i, j, oday, osec, rcio, iunit, otype, io
-integer :: num_copies, num_qc, max_obs, iacc, ialo, ncid, varid
-integer :: axdim, aydim
-integer :: along_base, across_base
-integer, allocatable :: qc_array(:,:)
-real(r8), allocatable :: tmask(:,:) ! float tmask:comment = "0 = land, 1 = ocean" ;
-character(len=128) :: varname
-
-logical :: file_exist, first_obs
-
-real(r8) :: temp, qc, wdir, wspeed, werr,thiserr
-real(r8) :: uwnd, uerr, vwnd, verr
-real(r8) :: dlon, dlat, thislon, thislat
-real(r8), allocatable :: lat(:,:), lon(:,:)
-real(r8), allocatable :: seaice_concentr(:,:)
-
-type(obs_sequence_type) :: obs_seq
-type(obs_type) :: obs, prev_obs
-type(time_type) :: comp_day0, time_obs, prev_time
-
-integer :: year = 2000
-integer :: doy = 1
-real(r8) :: terr = 0.15_r8
-real(r8) :: cat = 1_r8
-character(len=256) :: seaice_input_file = 'seaicedata.input'
-character(len=256) :: obs_out_file = 'obs_seq.out'
-character(len=256) :: maskfile = 'cice_hist.nc'
-logical :: debug = .false. ! set to .true. to print info
-
-namelist /seaice_syn_to_obs_nc_nml/ year, doy, cat, terr, &
- seaice_input_file, obs_out_file, &
- maskfile, debug
-
-! ------------------------
-! start of executable code
-! ------------------------
-
-call initialize_utilities(routine)
-
-call find_namelist_in_file('input.nml', 'seaice_syn_to_obs_nc_nml', iunit)
-read(iunit, nml = seaice_syn_to_obs_nc_nml, iostat = io)
-call check_namelist_read(iunit, io, 'seaice_syn_to_obs_nc_nml')
-
-! Record the namelist values used for the run
-if (do_nml_file()) write(nmlfileunit, nml=seaice_syn_to_obs_nc_nml)
-if (do_nml_term()) write( * , nml=seaice_syn_to_obs_nc_nml)
-
-! open netcdf file here.
-call nc_check( nf90_open(seaice_input_file, nf90_nowrite, ncid), &
- routine, 'opening file '//trim(seaice_input_file))
-
-! get dims along the swath path, and across the swath path. the rest of
-! the data arrays use these for their dimensions
-call getdimlen(ncid, 'ni', axdim)
-call getdimlen(ncid, 'nj', aydim)
-
-! remember that when you ncdump the netcdf file, the dimensions are
-! listed in C order. when you allocate them for fortran, reverse the order.
-allocate(seaice_concentr(axdim, aydim))
-allocate(lon(axdim,aydim), lat(axdim,aydim))
-allocate(qc_array(axdim,aydim))
-allocate(tmask(axdim,aydim))
-
-varname = 'aicen'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, seaice_concentr), &
- routine, 'getting var '// trim(varname))
-
-!! obtain lat and lon
-varname = 'lat'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lat), &
- routine, 'getting var '// trim(varname))
-
-varname = 'lon'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lon), &
- routine, 'getting var '// trim(varname))
-
-! read in ocean/land mask
-varname = 'tmask'
-call nc_check( nf90_open(maskfile,nf90_nowrite,ncid), &
- routine,'opening file'//trim(maskfile))
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, tmask), &
- routine, 'getting var '// trim(varname))
-
-! convert -180/180 to 0/360
-where (lon < 0.0_r8) lon = lon + 360.0_r8
-
-! time setup
-call set_calendar_type(GREGORIAN)
-
-!! all obs in a single file are the same time.
-comp_day0 = set_date(year, 1, 1, 0, 0, 0)
-time_obs = comp_day0 + set_time(0, doy)
-
-! extract time of observation into gregorian day, sec.
-call get_time(time_obs, osec, oday)
-
-! There's no actual "vertical" layers. But the 3rd dimension in seaice is category.
-
-! -------------------------
-
-! each observation in this series will have a single observation value
-! and a quality control flag. the max possible number of obs needs to
-! be specified but it will only write out the actual number created.
-max_obs = axdim*aydim
-num_copies = 1
-num_qc = 1
-
-! call the initialization code, and initialize two empty observation types
-call static_init_obs_sequence()
-call init_obs(obs, num_copies, num_qc)
-call init_obs(prev_obs, num_copies, num_qc)
-first_obs = .true.
-
-! create a new, empty obs_seq file. you must give a max limit
-! on number of obs. increase the size if too small.
-call init_obs_sequence(obs_seq, num_copies, num_qc, max_obs)
-
-! the first one needs to contain the string 'observation' and the
-! second needs the string 'QC'.
-call set_copy_meta_data(obs_seq, 1, 'observation')
-call set_qc_meta_data(obs_seq, 1, 'Data QC')
-
-! if you want to append to existing files (e.g. you have a lot of
-! small text files you want to combine), you can do it this way,
-! or you can use the obs_sequence_tool to merge a list of files
-! once they are in DART obs_seq format.
-
-! ! existing file found, append to it
-! inquire(file=obs_out_file, exist=file_exist)
-! if ( file_exist ) then
-! call read_obs_seq(obs_out_file, 0, 0, max_obs, obs_seq)
-! endif
-
-! we have to pick an error range. since this is a seaice cover fraction
-! observation, the valid values should go from 0 to 1.0, so pick 0.1 for now.
-qc = 0.0_r8 ! we will reject anything with a bad qc
-
-qc_array = 0 ! making synthetic observations so assume every observation is good
-
-alongloop: do j = 1, aydim
-
- acrossloop: do i = 1, axdim
-
-if (debug) print *, 'start of main loop, ', iacc, ialo
-
- !! check the lat/lon values to see if they are ok
- if ( lat(i,j) > 90.0_r8 .or. lat(i,j) < 40.0_r8 ) cycle acrossloop
- if ( lon(i,j) < 0.0_r8 .or. lon(i,j) > 360.0_r8 ) cycle acrossloop
-
- ! the actual data values are denser, so inner loop here
-
- if ( qc_array(i,j) /= 0) cycle acrossloop !reserve for future quality control
- if ( tmask(i,j) < 0.5_r8) cycle acrossloop !do not convert if it's a land grid
- if (seaice_concentr(i,j).lt.0.01_r8 .or. seaice_concentr(i,j).gt.1.0_r8) cycle acrossloop !FIXME temporary do not assimilate
- !when observed sea ice is 0 coverage
- ! compute the lat/lon for this obs FIXME: this isn't right
-
- thislat = lat(i,j)
-
- thislon = lon(i,j)
-
- thiserr = terr* seaice_concentr(i,j)
-
- ! make an obs derived type, and then add it to the sequence
- call create_3d_obs(thislat, thislon, cat, VERTISLEVEL, seaice_concentr(i,j), &
- SYN_SEAICE_CONCENTR, thiserr, oday, osec, qc, obs)
- call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
-
- if (debug) print *, 'added seaice obs to output seq'
-
- end do acrossloop
-end do alongloop
-
-! if we added any obs to the sequence, write it out to a file now.
-if ( get_num_obs(obs_seq) > 0 ) then
- if (debug) print *, 'writing obs_seq, obs_count = ', get_num_obs(obs_seq)
- call write_obs_seq(obs_seq, obs_out_file)
-endif
-
-! end of main program
-call finalize_utilities()
-
-end program seaice_syn_to_obs_netcdf
-
-!
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
diff --git a/observations/obs_converters/cice/seaice_temperature_to_obs_netcdf.f90 b/observations/obs_converters/cice/seaice_temperature_to_obs_netcdf.f90
deleted file mode 100644
index a81a3de045..0000000000
--- a/observations/obs_converters/cice/seaice_temperature_to_obs_netcdf.f90
+++ /dev/null
@@ -1,234 +0,0 @@
-! 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
-!
-! DART $Id$
-
-!-----------------------------------------------------------------------
-!> seaice_temperature_to_obs_netcdf - input is a seaice-coverage file that has been
-!> converted from HDF to netCDF with an automated tool. this
-!> program then takes the unsigned byte/integer(1) data and
-!> converts it into a seaice coverage obs_seq file.
-!>
-!> Credits: Yongfei Zhang - University of Washington.
-
-program seaice_temperature_to_obs_netcdf
-
-use types_mod, only : r8, PI, DEG2RAD
-use utilities_mod, only : initialize_utilities, finalize_utilities, &
- open_file, close_file, find_namelist_in_file, &
- check_namelist_read, nmlfileunit, do_nml_file, &
- do_nml_term, nc_check
-use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
- operator(>=), increment_time, get_time, &
- operator(-), GREGORIAN, operator(+), print_date
-use location_mod, only : VERTISSURFACE
-use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
- static_init_obs_sequence, init_obs, &
- write_obs_seq, init_obs_sequence, get_num_obs, &
- set_copy_meta_data, set_qc_meta_data
-use obs_utilities_mod, only : create_3d_obs, add_obs_to_seq, getdimlen
-use obs_kind_mod, only : SAT_SEAICE_AGREG_SURFACETEMP
-
-use netcdf
-
-implicit none
-
-character(len=32), parameter :: routine = 'seaice_temperature_to_obs_netcdf'
-
-integer :: n, i, j, oday, osec, rcio, iunit, otype, io
-integer :: num_copies, num_qc, max_obs, iacc, ialo, ncid, varid
-integer :: axdim, aydim
-integer :: along_base, across_base
-integer, allocatable :: qc_array(:,:)
-real(r8), allocatable :: tmask(:,:) ! float tmask:comment = "0 = land, 1 = ocean" ;
-character(len=128) :: varname
-
-logical :: file_exist, first_obs
-
-real(r8) :: temp, qc, wdir, wspeed, werr, thiserr
-real(r8) :: uwnd, uerr, vwnd, verr
-real(r8) :: dlon, dlat, thislon, thislat
-real(r8), allocatable :: lat(:,:), lon(:,:)
-real(r8), allocatable :: seaice_temperature(:,:)
-
-type(obs_sequence_type) :: obs_seq
-type(obs_type) :: obs, prev_obs
-type(time_type) :: comp_day0, time_obs, prev_time
-
-integer :: year = 2000
-integer :: doy = 1
-real(r8) :: terr = 3.0_r8
-character(len=256) :: seaice_input_file = 'seaicedata.input'
-character(len=256) :: obs_out_file = 'obs_seq.out'
-character(len=256) :: maskfile = 'cice_hist.nc'
-logical :: debug = .false. ! set to .true. to print info
-
-namelist /seaice_temperature_to_obs_nc_nml/ year, doy, terr, &
- seaice_input_file, obs_out_file, &
- maskfile, debug
-
-! ------------------------
-! start of executable code
-! ------------------------
-
-call initialize_utilities(routine)
-
-call find_namelist_in_file('input.nml', 'seaice_temperature_to_obs_nc_nml', iunit)
-read(iunit, nml = seaice_temperature_to_obs_nc_nml, iostat = io)
-call check_namelist_read(iunit, io, 'seaice_temperature_to_obs_nc_nml')
-
-! Record the namelist values used for the run
-if (do_nml_file()) write(nmlfileunit, nml=seaice_temperature_to_obs_nc_nml)
-if (do_nml_term()) write( * , nml=seaice_temperature_to_obs_nc_nml)
-
-! open netcdf file here.
-call nc_check( nf90_open(seaice_input_file, nf90_nowrite, ncid), &
- routine, 'opening file '//trim(seaice_input_file))
-
-! get dims along the swath path, and across the swath path. the rest of
-! the data arrays use these for their dimensions
-call getdimlen(ncid, 'ni', axdim)
-call getdimlen(ncid, 'nj', aydim)
-
-! remember that when you ncdump the netcdf file, the dimensions are
-! listed in C order. when you allocate them for fortran, reverse the order.
-allocate(seaice_temperature(axdim, aydim))
-allocate(lon(axdim,aydim), lat(axdim,aydim))
-allocate(qc_array(axdim,aydim))
-allocate(tmask(axdim,aydim))
-
-varname = 'tsfc'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, seaice_temperature), &
- routine, 'getting var '// trim(varname))
-
-!! obtain lat and lon
-varname = 'lat'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lat), &
- routine, 'getting var '// trim(varname))
-
-varname = 'lon'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lon), &
- routine, 'getting var '// trim(varname))
-
-! read in ocean/land mask
-varname = 'tmask'
-call nc_check( nf90_open(maskfile,nf90_nowrite,ncid), &
- routine,'opening file'//trim(maskfile))
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, tmask), &
- routine, 'getting var '// trim(varname))
-
-! convert -180/180 to 0/360
-where (lon < 0.0_r8) lon = lon + 360.0_r8
-
-! time setup
-call set_calendar_type(GREGORIAN)
-
-!! all obs in a single file are the same time.
-comp_day0 = set_date(year, 1, 1, 0, 0, 0)
-time_obs = comp_day0 + set_time(0, doy)
-
-! extract time of observation into gregorian day, sec.
-call get_time(time_obs, osec, oday)
-
-! There's no actual "vertical" layers. But the 3rd dimension in seaice is category.
-
-! -------------------------
-
-! each observation in this series will have a single observation value
-! and a quality control flag. the max possible number of obs needs to
-! be specified but it will only write out the actual number created.
-max_obs = axdim*aydim
-num_copies = 1
-num_qc = 1
-
-! call the initialization code, and initialize two empty observation types
-call static_init_obs_sequence()
-call init_obs(obs, num_copies, num_qc)
-call init_obs(prev_obs, num_copies, num_qc)
-first_obs = .true.
-
-! create a new, empty obs_seq file. you must give a max limit
-! on number of obs. increase the size if too small.
-call init_obs_sequence(obs_seq, num_copies, num_qc, max_obs)
-
-! the first one needs to contain the string 'observation' and the
-! second needs the string 'QC'.
-call set_copy_meta_data(obs_seq, 1, 'observation')
-call set_qc_meta_data(obs_seq, 1, 'Data QC')
-
-! if you want to append to existing files (e.g. you have a lot of
-! small text files you want to combine), you can do it this way,
-! or you can use the obs_sequence_tool to merge a list of files
-! once they are in DART obs_seq format.
-
-! ! existing file found, append to it
-! inquire(file=obs_out_file, exist=file_exist)
-! if ( file_exist ) then
-! call read_obs_seq(obs_out_file, 0, 0, max_obs, obs_seq)
-! endif
-
-! we have to pick an error range. since this is a seaice cover fraction
-! observation, the valid values should go from 0 to 1.0, so pick 0.1 for now.
-qc = 0.0_r8 ! we will reject anything with a bad qc
-
-qc_array = 0 ! making synthetic observations so assume every observation is good
-
-alongloop: do j = 1, aydim
-
- acrossloop: do i = 1, axdim
-
-if (debug) print *, 'start of main loop, ', iacc, ialo
-
- !! check the lat/lon values to see if they are ok
- if ( lat(i,j) > 90.0_r8 .or. lat(i,j) < 40.0_r8 ) cycle acrossloop
- if ( lon(i,j) < 0.0_r8 .or. lon(i,j) > 360.0_r8 ) cycle acrossloop
-
- ! the actual data values are denser, so inner loop here
-
- if ( qc_array(i,j) /= 0) cycle acrossloop !reserve for future quality control
- if ( tmask(i,j) < 0.5_r8) cycle acrossloop !do not convert if it's a land grid
- if (seaice_temperature(i,j).gt.100_r8) cycle acrossloop !FIXME temporary do not assimilate
- !when observed sea ice is 0 coverage
- ! compute the lat/lon for this obs FIXME: this isn't right
-
- thislat = lat(i,j)
-
- thislon = lon(i,j)
-
- thiserr = terr
-
- ! make an obs derived type, and then add it to the sequence
- call create_3d_obs(thislat, thislon, 0.0_r8, VERTISSURFACE, seaice_temperature(i,j), &
- SAT_SEAICE_AGREG_SURFACETEMP, thiserr, oday, osec, qc, obs)
- call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
-
- if (debug) print *, 'added seaice obs to output seq'
-
- end do acrossloop
-end do alongloop
-
-! if we added any obs to the sequence, write it out to a file now.
-if ( get_num_obs(obs_seq) > 0 ) then
- if (debug) print *, 'writing obs_seq, obs_count = ', get_num_obs(obs_seq)
- call write_obs_seq(obs_seq, obs_out_file)
-endif
-
-! end of main program
-call finalize_utilities()
-
-end program seaice_temperature_to_obs_netcdf
-
-!
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
diff --git a/observations/obs_converters/cice/seaice_thickness_to_obs_netcdf.f90 b/observations/obs_converters/cice/seaice_thickness_to_obs_netcdf.f90
deleted file mode 100644
index 79cdc02897..0000000000
--- a/observations/obs_converters/cice/seaice_thickness_to_obs_netcdf.f90
+++ /dev/null
@@ -1,234 +0,0 @@
-! 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
-!
-! DART $Id$
-
-!-----------------------------------------------------------------------
-!> seaice_thickness_to_obs_netcdf - input is a seaice-coverage file that has been
-!> converted from HDF to netCDF with an automated tool. this
-!> program then takes the unsigned byte/integer(1) data and
-!> converts it into a seaice coverage obs_seq file.
-!>
-!> Credits: Yongfei Zhang - University of Washington.
-
-program seaice_thickness_to_obs_netcdf
-
-use types_mod, only : r8, PI, DEG2RAD
-use utilities_mod, only : initialize_utilities, finalize_utilities, &
- open_file, close_file, find_namelist_in_file, &
- check_namelist_read, nmlfileunit, do_nml_file, &
- do_nml_term, nc_check
-use time_manager_mod, only : time_type, set_calendar_type, set_date, set_time, &
- operator(>=), increment_time, get_time, &
- operator(-), GREGORIAN, operator(+), print_date
-use location_mod, only : VERTISSURFACE
-use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
- static_init_obs_sequence, init_obs, &
- write_obs_seq, init_obs_sequence, get_num_obs, &
- set_copy_meta_data, set_qc_meta_data
-use obs_utilities_mod, only : create_3d_obs, add_obs_to_seq, getdimlen
-use obs_kind_mod, only : SAT_SEAICE_AGREG_THICKNESS
-
-use netcdf
-
-implicit none
-
-character(len=30), parameter :: routine = 'seaice_thickness_to_obs_netcdf'
-
-integer :: n, i, j, oday, osec, rcio, iunit, otype, io
-integer :: num_copies, num_qc, max_obs, iacc, ialo, ncid, varid
-integer :: axdim, aydim
-integer :: along_base, across_base
-integer, allocatable :: qc_array(:,:)
-real(r8), allocatable :: tmask(:,:) ! float tmask:comment = "0 = land, 1 = ocean" ;
-character(len=128) :: varname
-
-logical :: file_exist, first_obs
-
-real(r8) :: temp, qc, wdir, wspeed, werr, thiserr
-real(r8) :: uwnd, uerr, vwnd, verr
-real(r8) :: dlon, dlat, thislon, thislat
-real(r8), allocatable :: lat(:,:), lon(:,:)
-real(r8), allocatable :: seaice_thickness(:,:)
-
-type(obs_sequence_type) :: obs_seq
-type(obs_type) :: obs, prev_obs
-type(time_type) :: comp_day0, time_obs, prev_time
-
-integer :: year = 2000
-integer :: doy = 1
-real(r8) :: terr = 0.1_r8
-character(len=256) :: seaice_input_file = 'seaicedata.input'
-character(len=256) :: obs_out_file = 'obs_seq.out'
-character(len=256) :: maskfile = 'cice_hist.nc'
-logical :: debug = .false. ! set to .true. to print info
-
-namelist /seaice_thickness_to_obs_nc_nml/ year, doy, terr, &
- seaice_input_file, obs_out_file, &
- maskfile, debug
-
-! ------------------------
-! start of executable code
-! ------------------------
-
-call initialize_utilities(routine)
-
-call find_namelist_in_file('input.nml', 'seaice_thickness_to_obs_nc_nml', iunit)
-read(iunit, nml = seaice_thickness_to_obs_nc_nml, iostat = io)
-call check_namelist_read(iunit, io, 'seaice_thickness_to_obs_nc_nml')
-
-! Record the namelist values used for the run
-if (do_nml_file()) write(nmlfileunit, nml=seaice_thickness_to_obs_nc_nml)
-if (do_nml_term()) write( * , nml=seaice_thickness_to_obs_nc_nml)
-
-! open netcdf file here.
-call nc_check( nf90_open(seaice_input_file, nf90_nowrite, ncid), &
- routine, 'opening file '//trim(seaice_input_file))
-
-! get dims along the swath path, and across the swath path. the rest of
-! the data arrays use these for their dimensions
-call getdimlen(ncid, 'ni', axdim)
-call getdimlen(ncid, 'nj', aydim)
-
-! remember that when you ncdump the netcdf file, the dimensions are
-! listed in C order. when you allocate them for fortran, reverse the order.
-allocate(seaice_thickness(axdim, aydim))
-allocate(lon(axdim,aydim), lat(axdim,aydim))
-allocate(qc_array(axdim,aydim))
-allocate(tmask(axdim,aydim))
-
-varname = 'hice'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, seaice_thickness), &
- routine, 'getting var '// trim(varname))
-
-!! obtain lat and lon
-varname = 'lat'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lat), &
- routine, 'getting var '// trim(varname))
-
-varname = 'lon'
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, lon), &
- routine, 'getting var '// trim(varname))
-
-! read in ocean/land mask
-varname = 'tmask'
-call nc_check( nf90_open(maskfile,nf90_nowrite,ncid), &
- routine,'opening file'//trim(maskfile))
-call nc_check( nf90_inq_varid(ncid, varname, varid), &
- routine, 'inquire var '// trim(varname))
-call nc_check( nf90_get_var(ncid, varid, tmask), &
- routine, 'getting var '// trim(varname))
-
-! convert -180/180 to 0/360
-where (lon < 0.0_r8) lon = lon + 360.0_r8
-
-! time setup
-call set_calendar_type(GREGORIAN)
-
-!! all obs in a single file are the same time.
-comp_day0 = set_date(year, 1, 1, 0, 0, 0)
-time_obs = comp_day0 + set_time(0, doy)
-
-! extract time of observation into gregorian day, sec.
-call get_time(time_obs, osec, oday)
-
-! There's no actual "vertical" layers. But the 3rd dimension in seaice is category.
-
-! -------------------------
-
-! each observation in this series will have a single observation value
-! and a quality control flag. the max possible number of obs needs to
-! be specified but it will only write out the actual number created.
-max_obs = axdim*aydim
-num_copies = 1
-num_qc = 1
-
-! call the initialization code, and initialize two empty observation types
-call static_init_obs_sequence()
-call init_obs(obs, num_copies, num_qc)
-call init_obs(prev_obs, num_copies, num_qc)
-first_obs = .true.
-
-! create a new, empty obs_seq file. you must give a max limit
-! on number of obs. increase the size if too small.
-call init_obs_sequence(obs_seq, num_copies, num_qc, max_obs)
-
-! the first one needs to contain the string 'observation' and the
-! second needs the string 'QC'.
-call set_copy_meta_data(obs_seq, 1, 'observation')
-call set_qc_meta_data(obs_seq, 1, 'Data QC')
-
-! if you want to append to existing files (e.g. you have a lot of
-! small text files you want to combine), you can do it this way,
-! or you can use the obs_sequence_tool to merge a list of files
-! once they are in DART obs_seq format.
-
-! ! existing file found, append to it
-! inquire(file=obs_out_file, exist=file_exist)
-! if ( file_exist ) then
-! call read_obs_seq(obs_out_file, 0, 0, max_obs, obs_seq)
-! endif
-
-! we have to pick an error range. since this is a seaice cover fraction
-! observation, the valid values should go from 0 to 1.0, so pick 0.1 for now.
-qc = 0.0_r8 ! we will reject anything with a bad qc
-
-qc_array = 0 ! making synthetic observations so assume every observation is good
-
-alongloop: do j = 1, aydim
-
- acrossloop: do i = 1, axdim
-
-if (debug) print *, 'start of main loop, ', iacc, ialo
-
- !! check the lat/lon values to see if they are ok
- if ( lat(i,j) > 90.0_r8 .or. lat(i,j) < 40.0_r8 ) cycle acrossloop
- if ( lon(i,j) < 0.0_r8 .or. lon(i,j) > 360.0_r8 ) cycle acrossloop
-
- ! the actual data values are denser, so inner loop here
-
- if ( qc_array(i,j) /= 0) cycle acrossloop !reserve for future quality control
- if ( tmask(i,j) < 0.5_r8) cycle acrossloop !do not convert if it's a land grid
- ! if (seaice_thickness(i,j).lt.0.01_r8) cycle acrossloop !FIXME temporary do not assimilate
- !when observed sea ice is 0 coverage
- ! compute the lat/lon for this obs FIXME: this isn't right
-
- thislat = lat(i,j)
-
- thislon = lon(i,j)
-
- thiserr = terr
-
- ! make an obs derived type, and then add it to the sequence
- call create_3d_obs(thislat, thislon, 0.0_r8, VERTISSURFACE, seaice_thickness(i,j), &
- SAT_SEAICE_AGREG_THICKNESS, thiserr, oday, osec, qc, obs)
- call add_obs_to_seq(obs_seq, obs, time_obs, prev_obs, prev_time, first_obs)
-
- if (debug) print *, 'added seaice obs to output seq'
-
- end do acrossloop
-end do alongloop
-
-! if we added any obs to the sequence, write it out to a file now.
-if ( get_num_obs(obs_seq) > 0 ) then
- if (debug) print *, 'writing obs_seq, obs_count = ', get_num_obs(obs_seq)
- call write_obs_seq(obs_seq, obs_out_file)
-endif
-
-! end of main program
-call finalize_utilities()
-
-end program seaice_thickness_to_obs_netcdf
-
-!
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
diff --git a/observations/obs_converters/cice/shell_scripts/day_time_loop.csh b/observations/obs_converters/cice/shell_scripts/day_time_loop.csh
deleted file mode 100755
index e59c66e0ef..0000000000
--- a/observations/obs_converters/cice/shell_scripts/day_time_loop.csh
+++ /dev/null
@@ -1,206 +0,0 @@
-#!/bin/csh
-#
-# 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
-#
-# DART $Id$
-#
-# this is a template for a shell script that can loop
-# over multiple hours and can roll over day, month, and
-# even year boundaries. see the section inside the loop
-# for the 'your code goes here' part. look for the string ADDME.
-# this script requires the executable 'advance_time' to be
-# built and exist in the current directory, and advance_time
-# requires an input.nml namelist file.
-
-
-# set this to true if you're planning to pass the start & end times
-# in as command line args. set it to false if you're planning to set
-# the times by editing this file.
-
-set command_line_args = false
-
-# set the first and last times. can roll over day, month and year boundaries.
-# hours go from 0 to 23; days from 1 to 31, months from 1 to 12.
-
-if ($command_line_args == 'true') then
- if ($#argv != 8) then
- echo usage: $0 start_year start_month start_day start_hour end_year end_month end_day end_hour
- exit 1
- endif
- set start_year=$argv[1]
- set start_month=$argv[2]
- set start_day=$argv[3]
- set start_hour=$argv[4]
-
- set end_year=$argv[5]
- set end_month=$argv[6]
- set end_day=$argv[7]
- set end_hour=$argv[8]
-else
- set start_year=2001
- set start_month=01
- set start_day=01
- set start_hour=0
-
- set end_year=2001
- set end_month=08
- set end_day=31
- set end_hour=0
-endif
-
-# put more stuff here if you have user settable options
-
-# end of things you should have to set in this script
-
-# convert the start and stop times to gregorian days, so we can
-# compute total number of days including rolling over month and
-# year boundaries. make sure all values have leading 0s if they
-# are < 10. do the end time first so we can use the same values
-# to set the initial day while we are doing the total day calc.
-
-# the output of advance time with the -g input is:
-# gregorian_day_number seconds
-# use $var[1] to return just the day number
-
-set mon2=`printf $end_month`
-set day2=`printf $end_day`
-set hr2=`printf $end_hour`
-set end_t=(`echo ${end_year}${mon2}${day2}${hr2} 0 -g | ../work/advance_time`)
-
-set mon2=`printf $start_month`
-set day2=`printf $start_day`
-set hr2=`printf $start_hour`
-set start_t=(`echo ${start_year}${mon2}${day2}${hr2} 0 -g | ../work/advance_time`)
-
-# the output of this call is a string YYYYMMDDHH
-# see below for help in how to easily parse this up into words
-set curhr=`echo ${start_year}${mon2}${day2}${hr2} 0 | ../work/advance_time`
-
-# how many total hours are going to be processed (for the loop counter)
-# note that the parens below are necessary; otherwise the computation
-# does total = end - (start+1), or total = end - start - 1, which is
-# not how elementary math is supposed to work.
-if ( $start_t[2] > $end_t[2]) then
- @ end_t[2] += 86400
- @ end_t[1] -= 1
-endif
-@ totaldays = ( $end_t[1] - $start_t[1] + 1 )
-
-# loop over each day
-
-set obsindir = "$WORK/observations/syn/cice5/member10/err5/"
-set obsoutdir = "$WORK/observations/syn/cice5/member10/err5/cat/"
-
-set d = 1
-while ( $d <= $totaldays )
-
- # parse out the parts from a string which is YYYYMMDDHH
- # use cut with the byte option to pull out columns 1-4, 5-6, 7-8, 9-10
- set year=`echo $curhr | cut -b1-4`
- set month=`echo $curhr | cut -b5-6`
- set day=`echo $curhr | cut -b7-8`
- set hour=`echo $curhr | cut -b9-10`
-
- # compute the equivalent gregorian day here.
- set g=(`echo ${year}${month}${day}${hour} 0 -g | ../work/advance_time`)
- set gregday=$g[1]
- set gregsec=$g[2]
-
- # status/debug - comment in or out as desired.
- echo starting processing for ${year} ${month} ${day} ${hour}
- echo which is gregorian day: $gregday, $gregsec
-
-
- # your code goes here.
- # use $year, $month, $day, $hour, and $gregday, $gregsec as needed.
-
- # change the namelist to convert the MODIS ascii file to obs seq file
-
-set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
-echo $month_days
-
-set doy = 0
-set m = 1
-@ month_index = `printf $month | sed 's/^0//'`
- while ( $m < $month_index )
- @ doy = $doy + $month_days[$m]
- @ m = $m + 1
- end
- @ doy = $doy + `printf $day | sed 's/^0//'`
- @ doy_add = $doy - 1
-
- sed "/year/ c\ year = $year" ../work/input.nml >! temp
- mv temp input.nml
- sed "/doy/ c\ doy = $doy_add" input.nml > temp
- mv temp input.nml
-
- set icat = 1
-
- while ( $icat <= 5 )
-
- set cat = `printf %03d $icat`
-
- set filein = "synthetic_obs.aice${cat}.${year}-${month}-${day}.nc"
- set fileout = "obs_seq.aice${cat}.$year-$month-$day-00000"
- echo $filein
- echo $fileout
-
- sed "/ cat / c\ cat = $icat" input.nml > temp
- mv temp input.nml
-
- sed "/seaice_input_file/ c\ seaice_input_file = '${obsindir}/$filein'" \
- input.nml > temp
- mv temp input.nml
-
- sed "/obs_out_file/ c\ obs_out_file = '${obsoutdir}/$fileout'" \
- input.nml > temp
- mv temp input.nml
-
- ../work/seaice_syn_to_obs_netcdf
-
- @ icat = $icat + 1
-
- end
-
- # advance the hour; the output is YYYYMMDDHH
- set curhr=`echo ${year}${month}${day}${hour} +1d | ../work/advance_time`
-
- # advance the loop counter
- @ d += 1
-
-end
-
-exit 0
-
-
-#%# # example of using sed and lists of obs files to automate
-#%# # calling the obs_sequence_tool to split or combine obs_seq files:
-#%#
-#%# # put a list of filenames into 'obstemp' somehow
-#%#
-#%# # remove duplicate filenames
-#%# sort obstemp | uniq > infilelist
-#%# echo 'using input files:'
-#%# cat infilelist
-#%#
-#%# # if the start and stop times are in gregorian format,
-#%# # in $start and $stop, use sed to set the input.nml
-#%# sed -e "s/BDAY/$start[1]/" \
-#%# -e "s/BSEC/$start[2]/" \
-#%# -e "s/ASEC/$stop[2]/" \
-#%# -e "s/ASEC/$stop[2]/" input.nml.template >! input.nml
-#%#
-#%# # run obs_seq_tool
-#%# ./obs_sequence_tool
-#%#
-#%# # move the output someplace
-#%# mv obs_seq.combined obs_seq.$curhr
-#%#
-
-#
-# $URL$
-# $Revision$
-# $Date$
-
diff --git a/observations/obs_converters/cice/shell_scripts/day_time_loop_temperature.csh b/observations/obs_converters/cice/shell_scripts/day_time_loop_aggre.csh
similarity index 58%
rename from observations/obs_converters/cice/shell_scripts/day_time_loop_temperature.csh
rename to observations/obs_converters/cice/shell_scripts/day_time_loop_aggre.csh
index 5df227baf3..b1240ef178 100755
--- a/observations/obs_converters/cice/shell_scripts/day_time_loop_temperature.csh
+++ b/observations/obs_converters/cice/shell_scripts/day_time_loop_aggre.csh
@@ -6,15 +6,14 @@
#
# DART $Id$
#
-# this is a template for a shell script that can loop
-# over multiple hours and can roll over day, month, and
-# even year boundaries. see the section inside the loop
-# for the 'your code goes here' part. look for the string ADDME.
+# This is shell script to create many synthetic observation sequence files
+# by looping over multiple hours and can roll over day, month, and
+# even year boundaries.
+#
# this script requires the executable 'advance_time' to be
# built and exist in the current directory, and advance_time
# requires an input.nml namelist file.
-
# set this to true if you're planning to pass the start & end times
# in as command line args. set it to false if you're planning to set
# the times by editing this file.
@@ -33,20 +32,20 @@ if ($command_line_args == 'true') then
set start_month=$argv[2]
set start_day=$argv[3]
set start_hour=$argv[4]
-
+
set end_year=$argv[5]
set end_month=$argv[6]
set end_day=$argv[7]
set end_hour=$argv[8]
else
- set start_year=2003
+ set start_year=2006
set start_month=01
set start_day=01
set start_hour=0
-
- set end_year=2003
- set end_month=12
- set end_day=31
+
+ set end_year=2006
+ set end_month=06
+ set end_day=30
set end_hour=0
endif
@@ -86,77 +85,76 @@ if ( $start_t[2] > $end_t[2]) then
@ end_t[2] += 86400
@ end_t[1] -= 1
endif
-@ totaldays = ( $end_t[1] - $start_t[1] + 1 )
+@ totaldays = ( $end_t[1] - $start_t[1] + 1 )
# loop over each day
-set obsindir = "$WORK/observations/syn/cice5/member10/"
-set obsoutdir = "/$WORK/observations/syn/cice5/member10/aggre/tsfc"
+set obsindir = "cice5_free_2005to2010/t25"
+set obsoutdir = "${obsindir}/obs_seqs/aice"
set d = 1
while ( $d <= $totaldays )
- # parse out the parts from a string which is YYYYMMDDHH
- # use cut with the byte option to pull out columns 1-4, 5-6, 7-8, 9-10
- set year=`echo $curhr | cut -b1-4`
- set month=`echo $curhr | cut -b5-6`
- set day=`echo $curhr | cut -b7-8`
- set hour=`echo $curhr | cut -b9-10`
-
- # compute the equivalent gregorian day here.
- set g=(`echo ${year}${month}${day}${hour} 0 -g | ../work/advance_time`)
- set gregday=$g[1]
- set gregsec=$g[2]
-
- # status/debug - comment in or out as desired.
- echo starting processing for ${year} ${month} ${day} ${hour}
- echo which is gregorian day: $gregday, $gregsec
-
-
- # your code goes here.
- # use $year, $month, $day, $hour, and $gregday, $gregsec as needed.
-
- # change the namelist to convert the MODIS ascii file to obs seq file
-
-set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
-echo $month_days
-
-set doy = 0
-set m = 1
-@ month_index = `printf $month | sed 's/^0//'`
- while ( $m < $month_index )
- @ doy = $doy + $month_days[$m]
- @ m = $m + 1
- end
- @ doy = $doy + `printf $day | sed 's/^0//'`
- @ doy_add = $doy - 1
-
- sed "/year/ c\ year = $year" ../work/input.nml >! temp
- mv temp input.nml
- sed "/doy/ c\ doy = $doy_add" input.nml > temp
- mv temp input.nml
-
- set filein = "synthetic_obs.tsfc.${year}-${month}-${day}.nc"
- set fileout = "obs_seq.${year}-${month}-${day}-00000"
- echo $obsindir/$filein
- echo $obsoutdir/$fileout
-
- sed "/seaice_input_file/ c\ seaice_input_file = '${obsindir}/$filein'" \
- input.nml > temp
- mv temp input.nml
-
- sed "/obs_out_file/ c\ obs_out_file = '${obsoutdir}/$fileout'" \
- input.nml > temp
- mv temp input.nml
-
- ../work/seaice_temperature_to_obs_netcdf
-
- # advance the hour; the output is YYYYMMDDHH
- set curhr=`echo ${year}${month}${day}${hour} +1d | ../work/advance_time`
-
- # advance the loop counter
- @ d += 1
-
+ # parse out the parts from a string which is YYYYMMDDHH
+ # use cut with the byte option to pull out columns 1-4, 5-6, 7-8, 9-10
+ set year=`echo $curhr | cut -b1-4`
+ set month=`echo $curhr | cut -b5-6`
+ set day=`echo $curhr | cut -b7-8`
+ set hour=`echo $curhr | cut -b9-10`
+
+ # compute the equivalent gregorian day here.
+ set g=(`echo ${year}${month}${day}${hour} 0 -g | ../work/advance_time`)
+ set gregday=$g[1]
+ set gregsec=$g[2]
+
+ # status/debug - comment in or out as desired.
+ echo starting processing for ${year} ${month} ${day} ${hour}
+ echo which is gregorian day: $gregday, $gregsec
+
+ # your code goes here.
+ # use $year, $month, $day, $hour, and $gregday, $gregsec as needed.
+
+ # @todo CHECKME ... TJH thinks there is something disconnected here.
+ # the 'doy' calculated here does not include leap years, but the
+ # gregday from advance_time DOES include leap years.
+ # If this should include leap years, check out day_time_loop_modis_ist.csh
+ # I suppose it all depends on how seaice_aggre_to_obs_netcdf was written.
+
+ set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
+
+ set doy = 0
+ set m = 1
+ @ month_index = `printf $month | sed 's/^0//'`
+
+ while ( $m < $month_index )
+ @ doy = $doy + $month_days[$m]
+ @ m = $m + 1
+ end
+
+ @ doy = $doy + `printf $day | sed 's/^0//'`
+ @ doy_add = $doy - 1
+
+ # change the namelist to create a uniquely-named observation sequence file
+
+ set filein = "synthetic_obs.aice.${year}-${month}-${day}.nc"
+ set fileout = "obs_seq.${year}-${month}-${day}-00000"
+ echo $obsindir/$filein
+ echo $obsoutdir/$fileout
+
+ sed -e "/year/ c\ year = $year" \
+ -e "/doy/ c\ doy = $doy_add" \
+ -e "/seaice_input_file/ c\ seaice_input_file = '${obsindir}/$filein'" \
+ -e "/obs_out_file/ c\ obs_out_file = '${obsoutdir}/$fileout'" input.nml > temp
+ mv temp input.nml
+
+ ../work/seaice_aggre_to_obs_netcdf
+
+ # advance the time by a day; the output is YYYYMMDDHH
+ set curhr=`echo ${year}${month}${day}${hour} +1d | ../work/advance_time`
+
+ # advance the loop counter
+ @ d += 1
+
end
exit 0
@@ -164,27 +162,27 @@ exit 0
#%# # example of using sed and lists of obs files to automate
#%# # calling the obs_sequence_tool to split or combine obs_seq files:
-#%#
+#%#
#%# # put a list of filenames into 'obstemp' somehow
-#%#
+#%#
#%# # remove duplicate filenames
#%# sort obstemp | uniq > infilelist
#%# echo 'using input files:'
#%# cat infilelist
-#%#
+#%#
#%# # if the start and stop times are in gregorian format,
#%# # in $start and $stop, use sed to set the input.nml
#%# sed -e "s/BDAY/$start[1]/" \
#%# -e "s/BSEC/$start[2]/" \
#%# -e "s/ASEC/$stop[2]/" \
#%# -e "s/ASEC/$stop[2]/" input.nml.template >! input.nml
-#%#
+#%#
#%# # run obs_seq_tool
#%# ./obs_sequence_tool
-#%#
+#%#
#%# # move the output someplace
#%# mv obs_seq.combined obs_seq.$curhr
-#%#
+#%#
#
# $URL$
diff --git a/observations/obs_converters/cice/shell_scripts/day_time_loop_fy.csh b/observations/obs_converters/cice/shell_scripts/day_time_loop_fy.csh
deleted file mode 100755
index f061e7b90b..0000000000
--- a/observations/obs_converters/cice/shell_scripts/day_time_loop_fy.csh
+++ /dev/null
@@ -1,193 +0,0 @@
-#!/bin/csh
-#
-# 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
-#
-# DART $Id$
-#
-# this is a template for a shell script that can loop
-# over multiple hours and can roll over day, month, and
-# even year boundaries. see the section inside the loop
-# for the 'your code goes here' part. look for the string ADDME.
-# this script requires the executable 'advance_time' to be
-# built and exist in the current directory, and advance_time
-# requires an input.nml namelist file.
-
-
-# set this to true if you're planning to pass the start & end times
-# in as command line args. set it to false if you're planning to set
-# the times by editing this file.
-
-set command_line_args = false
-
-# set the first and last times. can roll over day, month and year boundaries.
-# hours go from 0 to 23; days from 1 to 31, months from 1 to 12.
-
-if ($command_line_args == 'true') then
- if ($#argv != 8) then
- echo usage: $0 start_year start_month start_day start_hour end_year end_month end_day end_hour
- exit 1
- endif
- set start_year=$argv[1]
- set start_month=$argv[2]
- set start_day=$argv[3]
- set start_hour=$argv[4]
-
- set end_year=$argv[5]
- set end_month=$argv[6]
- set end_day=$argv[7]
- set end_hour=$argv[8]
-else
- set start_year=2001
- set start_month=01
- set start_day=01
- set start_hour=0
-
- set end_year=2003
- set end_month=12
- set end_day=31
- set end_hour=0
-endif
-
-# put more stuff here if you have user settable options
-
-# end of things you should have to set in this script
-
-# convert the start and stop times to gregorian days, so we can
-# compute total number of days including rolling over month and
-# year boundaries. make sure all values have leading 0s if they
-# are < 10. do the end time first so we can use the same values
-# to set the initial day while we are doing the total day calc.
-
-# the output of advance time with the -g input is:
-# gregorian_day_number seconds
-# use $var[1] to return just the day number
-
-set mon2=`printf $end_month`
-set day2=`printf $end_day`
-set hr2=`printf $end_hour`
-set end_t=(`echo ${end_year}${mon2}${day2}${hr2} 0 -g | ../work/advance_time`)
-
-set mon2=`printf $start_month`
-set day2=`printf $start_day`
-set hr2=`printf $start_hour`
-set start_t=(`echo ${start_year}${mon2}${day2}${hr2} 0 -g | ../work/advance_time`)
-
-# the output of this call is a string YYYYMMDDHH
-# see below for help in how to easily parse this up into words
-set curhr=`echo ${start_year}${mon2}${day2}${hr2} 0 | ../work/advance_time`
-
-# how many total hours are going to be processed (for the loop counter)
-# note that the parens below are necessary; otherwise the computation
-# does total = end - (start+1), or total = end - start - 1, which is
-# not how elementary math is supposed to work.
-if ( $start_t[2] > $end_t[2]) then
- @ end_t[2] += 86400
- @ end_t[1] -= 1
-endif
-@ totaldays = ( $end_t[1] - $start_t[1] + 1 )
-
-# loop over each day
-
-set obsindir = "$WORK/observations/syn/cice5/member10/"
-set obsoutdir = "/$WORK/observations/syn/cice5/member10/aggre/fy"
-
-set d = 1
-while ( $d <= $totaldays )
-
- # parse out the parts from a string which is YYYYMMDDHH
- # use cut with the byte option to pull out columns 1-4, 5-6, 7-8, 9-10
- set year=`echo $curhr | cut -b1-4`
- set month=`echo $curhr | cut -b5-6`
- set day=`echo $curhr | cut -b7-8`
- set hour=`echo $curhr | cut -b9-10`
-
- # compute the equivalent gregorian day here.
- set g=(`echo ${year}${month}${day}${hour} 0 -g | ../work/advance_time`)
- set gregday=$g[1]
- set gregsec=$g[2]
-
- # status/debug - comment in or out as desired.
- echo starting processing for ${year} ${month} ${day} ${hour}
- echo which is gregorian day: $gregday, $gregsec
-
-
- # your code goes here.
- # use $year, $month, $day, $hour, and $gregday, $gregsec as needed.
-
- # change the namelist to convert the MODIS ascii file to obs seq file
-
-set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
-echo $month_days
-
-set doy = 0
-set m = 1
-@ month_index = `printf $month | sed 's/^0//'`
- while ( $m < $month_index )
- @ doy = $doy + $month_days[$m]
- @ m = $m + 1
- end
- @ doy = $doy + `printf $day | sed 's/^0//'`
- @ doy_add = $doy - 1
-
- sed "/year/ c\ year = $year" ../work/input.nml >! temp
- mv temp input.nml
- sed "/doy/ c\ doy = $doy_add" input.nml > temp
- mv temp input.nml
-
- set filein = "synthetic_obs.fy.${year}-${month}-${day}.nc"
- set fileout = "obs_seq.${year}-${month}-${day}-00000"
- echo $obsindir/$filein
- echo $obsoutdir/$fileout
-
- sed "/seaice_input_file/ c\ seaice_input_file = '${obsindir}/$filein'" \
- input.nml > temp
- mv temp input.nml
-
- sed "/obs_out_file/ c\ obs_out_file = '${obsoutdir}/$fileout'" \
- input.nml > temp
- mv temp input.nml
-
- ../work/seaice_fy_to_obs_netcdf
-
- # advance the hour; the output is YYYYMMDDHH
- set curhr=`echo ${year}${month}${day}${hour} +1d | ../work/advance_time`
-
- # advance the loop counter
- @ d += 1
-
-end
-
-exit 0
-
-
-#%# # example of using sed and lists of obs files to automate
-#%# # calling the obs_sequence_tool to split or combine obs_seq files:
-#%#
-#%# # put a list of filenames into 'obstemp' somehow
-#%#
-#%# # remove duplicate filenames
-#%# sort obstemp | uniq > infilelist
-#%# echo 'using input files:'
-#%# cat infilelist
-#%#
-#%# # if the start and stop times are in gregorian format,
-#%# # in $start and $stop, use sed to set the input.nml
-#%# sed -e "s/BDAY/$start[1]/" \
-#%# -e "s/BSEC/$start[2]/" \
-#%# -e "s/ASEC/$stop[2]/" \
-#%# -e "s/ASEC/$stop[2]/" input.nml.template >! input.nml
-#%#
-#%# # run obs_seq_tool
-#%# ./obs_sequence_tool
-#%#
-#%# # move the output someplace
-#%# mv obs_seq.combined obs_seq.$curhr
-#%#
-
-#
-# $URL$
-# $Revision$
-# $Date$
-
diff --git a/observations/obs_converters/cice/shell_scripts/day_time_loop_modis_ist.csh b/observations/obs_converters/cice/shell_scripts/day_time_loop_modis_ist.csh
index e0a095b853..58721f0e92 100755
--- a/observations/obs_converters/cice/shell_scripts/day_time_loop_modis_ist.csh
+++ b/observations/obs_converters/cice/shell_scripts/day_time_loop_modis_ist.csh
@@ -14,7 +14,6 @@
# built and exist in the current directory, and advance_time
# requires an input.nml namelist file.
-
# set this to true if you're planning to pass the start & end times
# in as command line args. set it to false if you're planning to set
# the times by editing this file.
@@ -33,7 +32,7 @@ if ($command_line_args == 'true') then
set start_month=$argv[2]
set start_day=$argv[3]
set start_hour=$argv[4]
-
+
set end_year=$argv[5]
set end_month=$argv[6]
set end_day=$argv[7]
@@ -43,7 +42,7 @@ else
set start_month=06
set start_day=01
set start_hour=0
-
+
set end_year=2001
set end_month=12
set end_day=31
@@ -86,77 +85,65 @@ if ( $start_t[2] > $end_t[2]) then
@ end_t[2] += 86400
@ end_t[1] -= 1
endif
-@ totaldays = ( $end_t[1] - $start_t[1] + 1 )
+@ totaldays = ( $end_t[1] - $start_t[1] + 1 )
# loop over each day
-set obsindir = "/glade/p/work/yfzhang/observations/modis-tsfc/" #model_grid/"
-set obsoutdir = "/glade/p/work/yfzhang/observations/modis-tsfc/obs_seqs/" #model_grid/obs_seqs/"
+set obsindir = "/glade/p/work/yfzhang/observations/modis-tsfc"
+set obsoutdir = "/glade/p/work/yfzhang/observations/modis-tsfc/obs_seqs"
set d = 1
while ( $d <= $totaldays )
- # parse out the parts from a string which is YYYYMMDDHH
- # use cut with the byte option to pull out columns 1-4, 5-6, 7-8, 9-10
- set year=`echo $curhr | cut -b1-4`
- set month=`echo $curhr | cut -b5-6`
- set day=`echo $curhr | cut -b7-8`
- set hour=`echo $curhr | cut -b9-10`
-
- # compute the equivalent gregorian day here.
- set g=(`echo ${year}${month}${day}${hour} 0 -g | ../work/advance_time`)
- set gregday=$g[1]
- set gregsec=$g[2]
-
- # status/debug - comment in or out as desired.
- echo starting processing for ${year} ${month} ${day} ${hour}
- echo which is gregorian day: $gregday, $gregsec
-
-
- # your code goes here.
- # use $year, $month, $day, $hour, and $gregday, $gregsec as needed.
-
- # change the namelist to convert the MODIS ascii file to obs seq file
-
-set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
-echo $month_days
-
-set doy = 0
-set m = 1
-@ month_index = `printf $month | sed 's/^0//'`
- while ( $m < $month_index )
- @ doy = $doy + $month_days[$m]
- @ m = $m + 1
- end
- @ doy = $doy + `printf $day | sed 's/^0//'`
- @ doy_add = $doy - 1
-
- sed "/year/ c\ year = $year" ../work/input.nml >! temp
- mv temp input.nml
- sed "/doy/ c\ doy = $doy_add" input.nml > temp
- mv temp input.nml
- set doy_3d = `printf %03d $doy`
- set filein = "MOD29E1D.A${year}${doy_3d}.IST.NH.nc"
- set fileout = "obs_seq.${year}-${month}-${day}-00000"
- echo $obsindir/$filein
- echo $obsoutdir/$fileout
-
- sed "/seaice_input_file/ c\ seaice_input_file = '${obsindir}/$filein'" \
- input.nml > temp
- mv temp input.nml
-
- sed "/obs_out_file/ c\ obs_out_file = '${obsoutdir}/$fileout'" \
- input.nml > temp
- mv temp input.nml
-
- ../work/modis_ist_to_obs_netcdf
-
- # advance the hour; the output is YYYYMMDDHH
- set curhr=`echo ${year}${month}${day}${hour} +1d | ../work/advance_time`
-
- # advance the loop counter
- @ d += 1
-
+ # parse out the parts from a string which is YYYYMMDDHH
+ # use cut with the byte option to pull out columns 1-4, 5-6, 7-8, 9-10
+ set year=`echo $curhr | cut -b1-4`
+ set month=`echo $curhr | cut -b5-6`
+ set day=`echo $curhr | cut -b7-8`
+ set hour=`echo $curhr | cut -b9-10`
+
+ # compute the equivalent gregorian day here.
+ set g=(`echo ${year}${month}${day}${hour} 0 -g | ../work/advance_time`)
+ set gregday=$g[1]
+ set gregsec=$g[2]
+
+ # compute the day of the year here.
+ set julian=(`echo ${year}${month}${day}${hour} 0 -j | ../work/advance_time`)
+ set doy=$julian[2]
+
+ # status/debug - comment in or out as desired.
+ echo starting processing for ${year} ${month} ${day} ${hour}
+ echo which is gregorian day: $gregday, $gregsec
+ echo which is day-of-year: $doy
+
+ # your code goes here.
+ # use $year, $month, $day, $hour, and $gregday, $gregsec as needed.
+
+ # change the namelist to convert the MODIS file to
+ # a uniquely-named observation sequence file.
+
+ @ doy_add = $doy - 1
+
+ set doy_3d = `printf %03d $doy`
+ set filein = "MOD29E1D.A${year}${doy_3d}.IST.NH.nc"
+ set fileout = "obs_seq.${year}-${month}-${day}-00000"
+ echo $obsindir/$filein
+ echo $obsoutdir/$fileout
+
+ sed -e "/year/ c\ year = $year" \
+ -e "/doy/ c\ doy = $doy_add" \
+ -e "/seaice_input_file/ c\ seaice_input_file = '${obsindir}/$filein'" \
+ -e "/obs_out_file/ c\ obs_out_file = '${obsoutdir}/$fileout'" input.nml > temp
+ mv temp input.nml
+
+ ../work/modis_ist_to_obs_netcdf
+
+ # advance the time counter; the output is YYYYMMDDHH
+ set curhr=`echo ${year}${month}${day}${hour} +1d | ../work/advance_time`
+
+ # advance the loop counter
+ @ d += 1
+
end
exit 0
@@ -164,27 +151,27 @@ exit 0
#%# # example of using sed and lists of obs files to automate
#%# # calling the obs_sequence_tool to split or combine obs_seq files:
-#%#
+#%#
#%# # put a list of filenames into 'obstemp' somehow
-#%#
+#%#
#%# # remove duplicate filenames
#%# sort obstemp | uniq > infilelist
#%# echo 'using input files:'
#%# cat infilelist
-#%#
+#%#
#%# # if the start and stop times are in gregorian format,
#%# # in $start and $stop, use sed to set the input.nml
#%# sed -e "s/BDAY/$start[1]/" \
#%# -e "s/BSEC/$start[2]/" \
#%# -e "s/ASEC/$stop[2]/" \
#%# -e "s/ASEC/$stop[2]/" input.nml.template >! input.nml
-#%#
+#%#
#%# # run obs_seq_tool
#%# ./obs_sequence_tool
-#%#
+#%#
#%# # move the output someplace
#%# mv obs_seq.combined obs_seq.$curhr
-#%#
+#%#
#
# $URL$
diff --git a/observations/obs_converters/cice/shell_scripts/day_time_loop_sat.csh b/observations/obs_converters/cice/shell_scripts/day_time_loop_sat.csh
deleted file mode 100755
index 99e5a53d40..0000000000
--- a/observations/obs_converters/cice/shell_scripts/day_time_loop_sat.csh
+++ /dev/null
@@ -1,193 +0,0 @@
-#!/bin/csh
-#
-# 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
-#
-# DART $Id$
-#
-# this is a template for a shell script that can loop
-# over multiple hours and can roll over day, month, and
-# even year boundaries. see the section inside the loop
-# for the 'your code goes here' part. look for the string ADDME.
-# this script requires the executable 'advance_time' to be
-# built and exist in the current directory, and advance_time
-# requires an input.nml namelist file.
-
-
-# set this to true if you're planning to pass the start & end times
-# in as command line args. set it to false if you're planning to set
-# the times by editing this file.
-
-set command_line_args = false
-
-# set the first and last times. can roll over day, month and year boundaries.
-# hours go from 0 to 23; days from 1 to 31, months from 1 to 12.
-
-if ($command_line_args == 'true') then
- if ($#argv != 8) then
- echo usage: $0 start_year start_month start_day start_hour end_year end_month end_day end_hour
- exit 1
- endif
- set start_year=$argv[1]
- set start_month=$argv[2]
- set start_day=$argv[3]
- set start_hour=$argv[4]
-
- set end_year=$argv[5]
- set end_month=$argv[6]
- set end_day=$argv[7]
- set end_hour=$argv[8]
-else
- set start_year=2001
- set start_month=01
- set start_day=01
- set start_hour=0
-
- set end_year=2001
- set end_month=10
- set end_day=31
- set end_hour=0
-endif
-
-# put more stuff here if you have user settable options
-
-# end of things you should have to set in this script
-
-# convert the start and stop times to gregorian days, so we can
-# compute total number of days including rolling over month and
-# year boundaries. make sure all values have leading 0s if they
-# are < 10. do the end time first so we can use the same values
-# to set the initial day while we are doing the total day calc.
-
-# the output of advance time with the -g input is:
-# gregorian_day_number seconds
-# use $var[1] to return just the day number
-
-set mon2=`printf $end_month`
-set day2=`printf $end_day`
-set hr2=`printf $end_hour`
-set end_t=(`echo ${end_year}${mon2}${day2}${hr2} 0 -g | ../work/advance_time`)
-
-set mon2=`printf $start_month`
-set day2=`printf $start_day`
-set hr2=`printf $start_hour`
-set start_t=(`echo ${start_year}${mon2}${day2}${hr2} 0 -g | ../work/advance_time`)
-
-# the output of this call is a string YYYYMMDDHH
-# see below for help in how to easily parse this up into words
-set curhr=`echo ${start_year}${mon2}${day2}${hr2} 0 | ../work/advance_time`
-
-# how many total hours are going to be processed (for the loop counter)
-# note that the parens below are necessary; otherwise the computation
-# does total = end - (start+1), or total = end - start - 1, which is
-# not how elementary math is supposed to work.
-if ( $start_t[2] > $end_t[2]) then
- @ end_t[2] += 86400
- @ end_t[1] -= 1
-endif
-@ totaldays = ( $end_t[1] - $start_t[1] + 1 )
-
-# loop over each day
-
-set obsindir = "$WORK/observations/syn/cice5/dfltpar/err5"
-set obsoutdir = "/$WORK/observations/syn/cice5/dfltpar/err5"
-
-set d = 1
-while ( $d <= $totaldays )
-
- # parse out the parts from a string which is YYYYMMDDHH
- # use cut with the byte option to pull out columns 1-4, 5-6, 7-8, 9-10
- set year=`echo $curhr | cut -b1-4`
- set month=`echo $curhr | cut -b5-6`
- set day=`echo $curhr | cut -b7-8`
- set hour=`echo $curhr | cut -b9-10`
-
- # compute the equivalent gregorian day here.
- set g=(`echo ${year}${month}${day}${hour} 0 -g | ../work/advance_time`)
- set gregday=$g[1]
- set gregsec=$g[2]
-
- # status/debug - comment in or out as desired.
- echo starting processing for ${year} ${month} ${day} ${hour}
- echo which is gregorian day: $gregday, $gregsec
-
-
- # your code goes here.
- # use $year, $month, $day, $hour, and $gregday, $gregsec as needed.
-
- # change the namelist to convert the MODIS ascii file to obs seq file
-
-set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
-echo $month_days
-
-set doy = 0
-set m = 1
-@ month_index = `printf $month | sed 's/^0//'`
- while ( $m < $month_index )
- @ doy = $doy + $month_days[$m]
- @ m = $m + 1
- end
- @ doy = $doy + `printf $day | sed 's/^0//'`
- @ doy_add = $doy - 1
-
- sed "/year/ c\ year = $year" ../work/input.nml >! temp
- mv temp input.nml
- sed "/doy/ c\ doy = $doy_add" input.nml > temp
- mv temp input.nml
-
- set filein = "synthetic_obs.aice.${year}-${month}-${day}.nc"
- set fileout = "obs_seq.${year}-${month}-${day}-00000"
- echo $obsindir/$filein
- echo $obsoutdir/$fileout
-
- sed "/seaice_input_file/ c\ seaice_input_file = '${obsindir}/$filein'" \
- input.nml > temp
- mv temp input.nml
-
- sed "/obs_out_file/ c\ obs_out_file = '${obsoutdir}/$fileout'" \
- input.nml > temp
- mv temp input.nml
-
- ../work/seaice_sat_to_obs_netcdf
-
- # advance the hour; the output is YYYYMMDDHH
- set curhr=`echo ${year}${month}${day}${hour} +1d | ../work/advance_time`
-
- # advance the loop counter
- @ d += 1
-
-end
-
-exit 0
-
-
-#%# # example of using sed and lists of obs files to automate
-#%# # calling the obs_sequence_tool to split or combine obs_seq files:
-#%#
-#%# # put a list of filenames into 'obstemp' somehow
-#%#
-#%# # remove duplicate filenames
-#%# sort obstemp | uniq > infilelist
-#%# echo 'using input files:'
-#%# cat infilelist
-#%#
-#%# # if the start and stop times are in gregorian format,
-#%# # in $start and $stop, use sed to set the input.nml
-#%# sed -e "s/BDAY/$start[1]/" \
-#%# -e "s/BSEC/$start[2]/" \
-#%# -e "s/ASEC/$stop[2]/" \
-#%# -e "s/ASEC/$stop[2]/" input.nml.template >! input.nml
-#%#
-#%# # run obs_seq_tool
-#%# ./obs_sequence_tool
-#%#
-#%# # move the output someplace
-#%# mv obs_seq.combined obs_seq.$curhr
-#%#
-
-#
-# $URL$
-# $Revision$
-# $Date$
-
diff --git a/observations/obs_converters/cice/shell_scripts/day_time_loop_thickness.csh b/observations/obs_converters/cice/shell_scripts/day_time_loop_thickness.csh
deleted file mode 100755
index 8acea0d838..0000000000
--- a/observations/obs_converters/cice/shell_scripts/day_time_loop_thickness.csh
+++ /dev/null
@@ -1,193 +0,0 @@
-#!/bin/csh
-#
-# 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
-#
-# DART $Id$
-#
-# this is a template for a shell script that can loop
-# over multiple hours and can roll over day, month, and
-# even year boundaries. see the section inside the loop
-# for the 'your code goes here' part. look for the string ADDME.
-# this script requires the executable 'advance_time' to be
-# built and exist in the current directory, and advance_time
-# requires an input.nml namelist file.
-
-
-# set this to true if you're planning to pass the start & end times
-# in as command line args. set it to false if you're planning to set
-# the times by editing this file.
-
-set command_line_args = false
-
-# set the first and last times. can roll over day, month and year boundaries.
-# hours go from 0 to 23; days from 1 to 31, months from 1 to 12.
-
-if ($command_line_args == 'true') then
- if ($#argv != 8) then
- echo usage: $0 start_year start_month start_day start_hour end_year end_month end_day end_hour
- exit 1
- endif
- set start_year=$argv[1]
- set start_month=$argv[2]
- set start_day=$argv[3]
- set start_hour=$argv[4]
-
- set end_year=$argv[5]
- set end_month=$argv[6]
- set end_day=$argv[7]
- set end_hour=$argv[8]
-else
- set start_year=2001
- set start_month=01
- set start_day=01
- set start_hour=0
-
- set end_year=2003
- set end_month=12
- set end_day=31
- set end_hour=0
-endif
-
-# put more stuff here if you have user settable options
-
-# end of things you should have to set in this script
-
-# convert the start and stop times to gregorian days, so we can
-# compute total number of days including rolling over month and
-# year boundaries. make sure all values have leading 0s if they
-# are < 10. do the end time first so we can use the same values
-# to set the initial day while we are doing the total day calc.
-
-# the output of advance time with the -g input is:
-# gregorian_day_number seconds
-# use $var[1] to return just the day number
-
-set mon2=`printf $end_month`
-set day2=`printf $end_day`
-set hr2=`printf $end_hour`
-set end_t=(`echo ${end_year}${mon2}${day2}${hr2} 0 -g | ../work/advance_time`)
-
-set mon2=`printf $start_month`
-set day2=`printf $start_day`
-set hr2=`printf $start_hour`
-set start_t=(`echo ${start_year}${mon2}${day2}${hr2} 0 -g | ../work/advance_time`)
-
-# the output of this call is a string YYYYMMDDHH
-# see below for help in how to easily parse this up into words
-set curhr=`echo ${start_year}${mon2}${day2}${hr2} 0 | ../work/advance_time`
-
-# how many total hours are going to be processed (for the loop counter)
-# note that the parens below are necessary; otherwise the computation
-# does total = end - (start+1), or total = end - start - 1, which is
-# not how elementary math is supposed to work.
-if ( $start_t[2] > $end_t[2]) then
- @ end_t[2] += 86400
- @ end_t[1] -= 1
-endif
-@ totaldays = ( $end_t[1] - $start_t[1] + 1 )
-
-# loop over each day
-
-set obsindir = "$WORK/observations/syn/cice5/member10/ZeroObs/"
-set obsoutdir = "/$WORK/observations/syn/cice5/member10/ZeroObs/aggre/hice"
-
-set d = 1
-while ( $d <= $totaldays )
-
- # parse out the parts from a string which is YYYYMMDDHH
- # use cut with the byte option to pull out columns 1-4, 5-6, 7-8, 9-10
- set year=`echo $curhr | cut -b1-4`
- set month=`echo $curhr | cut -b5-6`
- set day=`echo $curhr | cut -b7-8`
- set hour=`echo $curhr | cut -b9-10`
-
- # compute the equivalent gregorian day here.
- set g=(`echo ${year}${month}${day}${hour} 0 -g | ../work/advance_time`)
- set gregday=$g[1]
- set gregsec=$g[2]
-
- # status/debug - comment in or out as desired.
- echo starting processing for ${year} ${month} ${day} ${hour}
- echo which is gregorian day: $gregday, $gregsec
-
-
- # your code goes here.
- # use $year, $month, $day, $hour, and $gregday, $gregsec as needed.
-
- # change the namelist to convert the MODIS ascii file to obs seq file
-
-set month_days = (31 28 31 30 31 30 31 31 30 31 30 31)
-echo $month_days
-
-set doy = 0
-set m = 1
-@ month_index = `printf $month | sed 's/^0//'`
- while ( $m < $month_index )
- @ doy = $doy + $month_days[$m]
- @ m = $m + 1
- end
- @ doy = $doy + `printf $day | sed 's/^0//'`
- @ doy_add = $doy - 1
-
- sed "/year/ c\ year = $year" ../work/input.nml >! temp
- mv temp input.nml
- sed "/doy/ c\ doy = $doy_add" input.nml > temp
- mv temp input.nml
-
- set filein = "synthetic_obs.hice.${year}-${month}-${day}.nc"
- set fileout = "obs_seq.${year}-${month}-${day}-00000"
- echo $obsindir/$filein
- echo $obsoutdir/$fileout
-
- sed "/seaice_input_file/ c\ seaice_input_file = '${obsindir}/$filein'" \
- input.nml > temp
- mv temp input.nml
-
- sed "/obs_out_file/ c\ obs_out_file = '${obsoutdir}/$fileout'" \
- input.nml > temp
- mv temp input.nml
-
- ../work/seaice_thickness_to_obs_netcdf
-
- # advance the hour; the output is YYYYMMDDHH
- set curhr=`echo ${year}${month}${day}${hour} +1d | ../work/advance_time`
-
- # advance the loop counter
- @ d += 1
-
-end
-
-exit 0
-
-
-#%# # example of using sed and lists of obs files to automate
-#%# # calling the obs_sequence_tool to split or combine obs_seq files:
-#%#
-#%# # put a list of filenames into 'obstemp' somehow
-#%#
-#%# # remove duplicate filenames
-#%# sort obstemp | uniq > infilelist
-#%# echo 'using input files:'
-#%# cat infilelist
-#%#
-#%# # if the start and stop times are in gregorian format,
-#%# # in $start and $stop, use sed to set the input.nml
-#%# sed -e "s/BDAY/$start[1]/" \
-#%# -e "s/BSEC/$start[2]/" \
-#%# -e "s/ASEC/$stop[2]/" \
-#%# -e "s/ASEC/$stop[2]/" input.nml.template >! input.nml
-#%#
-#%# # run obs_seq_tool
-#%# ./obs_sequence_tool
-#%#
-#%# # move the output someplace
-#%# mv obs_seq.combined obs_seq.$curhr
-#%#
-
-#
-# $URL$
-# $Revision$
-# $Date$
-
diff --git a/observations/obs_converters/cice/shell_scripts/input.nml b/observations/obs_converters/cice/shell_scripts/input.nml
index 21b21d6ffb..1a6a649b56 100644
--- a/observations/obs_converters/cice/shell_scripts/input.nml
+++ b/observations/obs_converters/cice/shell_scripts/input.nml
@@ -1,35 +1,98 @@
&preprocess_nml
- input_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90',
- output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90',
- input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90',
- output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90',
- input_files = '../../../../observations/forward_operators/obs_def_cice.f90',
- /
+ overwrite_output = .true.
+ input_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
+ output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90'
+ input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
+ output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90'
+ input_files = '../../../../observations/forward_operators/obs_def_cice_mod.f90'
+ /
-&obs_kind_nml
- /
+&obs_sequence_nml
+ write_binary_obs_sequence = .false.
+ /
+
+# The BDAY,BSEC,ADAY,ASEC strings are intented to be replaced by the desired integers.
+# This can be done by hand or with 'sed' in a script (which is the usual method).
+
+&obs_sequence_tool_nml
+ filename_seq = ''
+ filename_seq_list = 'cat.list'
+ filename_out = 'obs_seq.combined'
+ first_obs_days = BDAY
+ first_obs_seconds = BSEC
+ last_obs_days = ADAY
+ last_obs_seconds = ASEC
+ gregorian_cal = .true.
+ /
&location_nml
- /
+ horiz_dist_only = .true.
+ approximate_distance = .false.
+ nlon = 71
+ nlat = 36
+ output_box_info = .true.
+ /
+
+&obs_kind_nml
+ assimilate_these_obs_types = 'SAT_SEAICE_AGREG_CONCENTR',
+ 'SAT_SEAICE_AGREG_THICKNESS'
+ evaluate_these_obs_types = 'null'
+ /
&utilities_nml
+ TERMLEVEL = 1
module_details = .false.
- /
+ /
-&obs_sequence_nml
- write_binary_obs_sequence = .false.
- /
+&seaice_aggre_to_obs_nc_nml
+ year = 2005
+ doy = 303
+ terr = 0.15
+ maskfile = 'cice_hist.nc'
+ debug = .false.
+ seaice_input_file = 'synthetic_seaicedata.nc'
+ obs_out_file = 'obs_seq.2005-10-31-00000'
+ /
+&modis_ist_to_obs_nc_nml
+ year = 2005
+ doy = 303
+ terr = 3
+ debug = .false.
+ seaice_input_file = 'modis_seaice_temperatures.nc'
+ obs_out_file = 'obs_seq.2005-10-31-00000'
+ /
-&obs_sequence_tool_nml
- filename_seq = '',
- filename_out = 'obs_seq.combined',
- filename_seq_list = 'infilelist',
- first_obs_days = -1,
- first_obs_seconds = -1,
- last_obs_days = -1,
- last_obs_seconds = -1,
- gregorian_cal = .true.,
-/
+&cice_to_obs_nml
+ cice_lat_file = '../data/psn25lats_v3.dat'
+ cice_lon_file = '../data/psn25lons_v3.dat'
+ num_latitudes = 448
+ num_longitudes = 304
+ grid_scale_factor = 100000.0
+ data_scale_factor = 10.0
+ land_missing_value = -800
+ pole_missing_value = -100
+ error_factor = 0.15
+ ignore_zero_obs = .false.
+
+ use_data_filename_pattern = .true.
+ data_filename_pattern = 'bt_YYYYMMDD_v02_n.bin'
+ cice_data_file = 'bt_20010101_v02_n.bin'
+
+ use_obsseq_filename_pattern = .true.
+ obsseq_filename_pattern = 'obs_seq.YYYY-MM-DD-00000'
+ obsseq_out_file = 'obs_seq.out'
+
+ year = 2005
+ start_month = 3
+ start_day = 1
+
+ year = 2005
+ end_month = 12
+ end_day = 31
+
+ append_to_existing_file = .false.
+ debug = .true.
+ /
diff --git a/observations/obs_converters/cice/shell_scripts/input.nml.template b/observations/obs_converters/cice/shell_scripts/input.nml.template
deleted file mode 100644
index 164b337542..0000000000
--- a/observations/obs_converters/cice/shell_scripts/input.nml.template
+++ /dev/null
@@ -1,35 +0,0 @@
-
-&preprocess_nml
- input_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90',
- output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90',
- input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90',
- output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90',
- input_files = '../../../../observations/forward_operators/obs_def_cice.f90',
- /
-
-&obs_kind_nml
- /
-
-&location_nml
- /
-
-&utilities_nml
- module_details = .false.
- /
-
-&obs_sequence_nml
- write_binary_obs_sequence = .false.
- /
-
-
-&obs_sequence_tool_nml
- filename_seq = '',
- filename_out = 'obs_seq.combined',
- filename_seq_list = 'infilelist',
- first_obs_days = BDAY,
- first_obs_seconds = BSEC,
- last_obs_days = ADAY,
- last_obs_seconds = ASEC,
- gregorian_cal = .true.,
-/
-
diff --git a/observations/obs_converters/cice/work/input.nml b/observations/obs_converters/cice/work/input.nml
index ed2afcf3d7..1a6a649b56 100644
--- a/observations/obs_converters/cice/work/input.nml
+++ b/observations/obs_converters/cice/work/input.nml
@@ -1,97 +1,67 @@
+
&preprocess_nml
- overwrite_output = .true.
+ overwrite_output = .true.
input_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90'
output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90'
input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90'
input_files = '../../../../observations/forward_operators/obs_def_cice_mod.f90'
- /
+ /
&obs_sequence_nml
write_binary_obs_sequence = .false.
- /
+ /
+
+# The BDAY,BSEC,ADAY,ASEC strings are intented to be replaced by the desired integers.
+# This can be done by hand or with 'sed' in a script (which is the usual method).
+
+&obs_sequence_tool_nml
+ filename_seq = ''
+ filename_seq_list = 'cat.list'
+ filename_out = 'obs_seq.combined'
+ first_obs_days = BDAY
+ first_obs_seconds = BSEC
+ last_obs_days = ADAY
+ last_obs_seconds = ASEC
+ gregorian_cal = .true.
+ /
&location_nml
- horiz_dist_only = .true.
- approximate_distance = .false.
- nlon = 71
- nlat = 36
- output_box_info = .true.
- /
+ horiz_dist_only = .true.
+ approximate_distance = .false.
+ nlon = 71
+ nlat = 36
+ output_box_info = .true.
+ /
&obs_kind_nml
assimilate_these_obs_types = 'SAT_SEAICE_AGREG_CONCENTR',
'SAT_SEAICE_AGREG_THICKNESS'
evaluate_these_obs_types = 'null'
- /
+ /
&utilities_nml
TERMLEVEL = 1
- logfilename = 'dart_log.out'
- nmlfilename = 'dart_log.nml'
module_details = .false.
- print_debug = .false.
- write_nml = 'file'
/
-&seaice_sat_to_obs_nc_nml
- year = 2001
- doy = 364
- terr = 0.05
- seaice_input_file = 'modis-tsfc/MOD29E1D.A2001365.IST.NH.nc'
- obs_out_file = 'modis-tsfc/obs_seqs/obs_seq.2001-12-31-00000'
- maskfile = 'cice_hist.nc'
- debug = .false.
- /
-
-&seaice_thickness_to_obs_nc_nml
- year = 2001
- doy = 364
- terr = 0.1
- seaice_input_file = 'modis-tsfc/MOD29E1D.A2001365.IST.NH.nc'
- obs_out_file = 'modis-tsfc/obs_seqs/obs_seq.2001-12-31-00000'
- maskfile = 'cice_hist.nc'
- debug = .false.
- /
-
-&seaice_temperature_to_obs_nc_nml
- year = 2001
- doy = 364
- terr = 3
- seaice_input_file = 'modis-tsfc/MOD29E1D.A2001365.IST.NH.nc'
- obs_out_file = 'modis-tsfc/obs_seqs/obs_seq.2001-12-31-00000'
- maskfile = 'cice_hist.nc'
- debug = .false.
+&seaice_aggre_to_obs_nc_nml
+ year = 2005
+ doy = 303
+ terr = 0.15
+ maskfile = 'cice_hist.nc'
+ debug = .false.
+ seaice_input_file = 'synthetic_seaicedata.nc'
+ obs_out_file = 'obs_seq.2005-10-31-00000'
/
&modis_ist_to_obs_nc_nml
- year = 2001
- doy = 364
- terr = 3
- seaice_input_file = 'modis-tsfc/MOD29E1D.A2001365.IST.NH.nc'
- obs_out_file = 'modis-tsfc/obs_seqs/obs_seq.2001-12-31-00000'
- debug = .false.
- /
-
-&seaice_fy_to_obs_nc_nml
- year = 2001
- doy = 364
- terr = 0.15
- seaice_input_file = 'modis-tsfc/MOD29E1D.A2001365.IST.NH.nc'
- obs_out_file = 'modis-tsfc/obs_seqs/obs_seq.2001-12-31-00000'
- maskfile = 'cice_hist.nc'
- debug = .false.
- /
-
-&seaice_syn_to_obs_nc_nml
- year = 2001
- doy = 364
- cat = 1
- terr = 0.15
- seaice_input_file = 'modis-tsfc/MOD29E1D.A2001365.IST.NH.nc'
- obs_out_file = 'modis-tsfc/obs_seqs/obs_seq.2001-12-31-00000'
- maskfile = 'cice_hist.nc'
- debug = .false.
+ year = 2005
+ doy = 303
+ terr = 3
+ debug = .false.
+ seaice_input_file = 'modis_seaice_temperatures.nc'
+ obs_out_file = 'obs_seq.2005-10-31-00000'
/
&cice_to_obs_nml
@@ -107,20 +77,20 @@
ignore_zero_obs = .false.
use_data_filename_pattern = .true.
- data_filename_pattern = '../data/bt_YYYYMMDD_n07_v02_n.bin'
- cice_data_file = '../data/bt_19800101_n07_v02_n.bin'
+ data_filename_pattern = 'bt_YYYYMMDD_v02_n.bin'
+ cice_data_file = 'bt_20010101_v02_n.bin'
use_obsseq_filename_pattern = .true.
- obsseq_filename_pattern = 'obs_seq.YYYYMMDD'
+ obsseq_filename_pattern = 'obs_seq.YYYY-MM-DD-00000'
obsseq_out_file = 'obs_seq.out'
- start_year = 1980
- start_month = 1
+ year = 2005
+ start_month = 3
start_day = 1
- end_year = 1980
- end_month = 1
- end_day = 1
+ year = 2005
+ end_month = 12
+ end_day = 31
append_to_existing_file = .false.
debug = .true.
diff --git a/observations/obs_converters/cice/work/mkmf_seaice_aggre_to_obs_netcdf b/observations/obs_converters/cice/work/mkmf_seaice_aggre_to_obs_netcdf
new file mode 100755
index 0000000000..229263d354
--- /dev/null
+++ b/observations/obs_converters/cice/work/mkmf_seaice_aggre_to_obs_netcdf
@@ -0,0 +1,18 @@
+#!/bin/csh
+#
+# 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
+#
+# DART $Id$
+
+../../../../build_templates/mkmf -p seaice_aggre_to_obs_netcdf -t ../../../../build_templates/mkmf.template \
+ -a "../../../.." path_names_seaice_aggre_to_obs_netcdf
+
+exit $status
+
+#
+# $URL$
+# $Revision$
+# $Date$
+
diff --git a/observations/obs_converters/cice/work/mkmf_seaice_syn_to_obs_netcdf b/observations/obs_converters/cice/work/mkmf_seaice_syn_to_obs_netcdf
deleted file mode 100755
index b922660e36..0000000000
--- a/observations/obs_converters/cice/work/mkmf_seaice_syn_to_obs_netcdf
+++ /dev/null
@@ -1,18 +0,0 @@
-#!/bin/csh
-#
-# 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
-#
-# DART $Id$
-
-../../../../build_templates/mkmf -p seaice_syn_to_obs_netcdf -t ../../../../build_templates/mkmf.template \
- -a "../../../.." path_names_seaice_syn_to_obs_netcdf
-
-exit $status
-
-#
-# $URL$
-# $Revision$
-# $Date$
-
diff --git a/observations/obs_converters/cice/work/mkmf_seaice_temperature_to_obs_netcdf b/observations/obs_converters/cice/work/mkmf_seaice_temperature_to_obs_netcdf
deleted file mode 100755
index e358474310..0000000000
--- a/observations/obs_converters/cice/work/mkmf_seaice_temperature_to_obs_netcdf
+++ /dev/null
@@ -1,18 +0,0 @@
-#!/bin/csh
-#
-# 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
-#
-# DART $Id$
-
-../../../../build_templates/mkmf -p seaice_temperature_to_obs_netcdf -t ../../../../build_templates/mkmf.template \
- -a "../../../.." path_names_seaice_temperature_to_obs_netcdf
-
-exit $status
-
-#
-# $URL$
-# $Revision$
-# $Date$
-
diff --git a/observations/obs_converters/cice/work/mkmf_seaice_thickness_to_obs_netcdf b/observations/obs_converters/cice/work/mkmf_seaice_thickness_to_obs_netcdf
deleted file mode 100755
index 16bf0340e7..0000000000
--- a/observations/obs_converters/cice/work/mkmf_seaice_thickness_to_obs_netcdf
+++ /dev/null
@@ -1,18 +0,0 @@
-#!/bin/csh
-#
-# 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
-#
-# DART $Id$
-
-../../../../build_templates/mkmf -p seaice_thickness_to_obs_netcdf -t ../../../../build_templates/mkmf.template \
- -a "../../../.." path_names_seaice_thickness_to_obs_netcdf
-
-exit $status
-
-#
-# $URL$
-# $Revision$
-# $Date$
-
diff --git a/observations/obs_converters/cice/work/path_names_seaice_syn_to_obs_netcdf b/observations/obs_converters/cice/work/path_names_seaice_aggre_to_obs_netcdf
similarity index 95%
rename from observations/obs_converters/cice/work/path_names_seaice_syn_to_obs_netcdf
rename to observations/obs_converters/cice/work/path_names_seaice_aggre_to_obs_netcdf
index 892fb9b456..b686b2437f 100644
--- a/observations/obs_converters/cice/work/path_names_seaice_syn_to_obs_netcdf
+++ b/observations/obs_converters/cice/work/path_names_seaice_aggre_to_obs_netcdf
@@ -23,5 +23,5 @@ models/template/model_mod.f90
models/utilities/default_model_mod.f90
observations/forward_operators/obs_def_mod.f90
observations/forward_operators/obs_def_utilities_mod.f90
-observations/obs_converters/cice/seaice_syn_to_obs_netcdf.f90
+observations/obs_converters/cice/seaice_aggre_to_obs_netcdf.f90
observations/obs_converters/utilities/obs_utilities_mod.f90
diff --git a/observations/obs_converters/cice/work/quickbuild.csh b/observations/obs_converters/cice/work/quickbuild.csh
index 009278ec2a..6026ce9050 100755
--- a/observations/obs_converters/cice/work/quickbuild.csh
+++ b/observations/obs_converters/cice/work/quickbuild.csh
@@ -15,7 +15,8 @@
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -56,7 +57,7 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
echo "Success: All ${MODEL} programs compiled."
diff --git a/observations/obs_converters/gnd_gps_vtec/work/quickbuild.csh b/observations/obs_converters/gnd_gps_vtec/work/quickbuild.csh
index 110404588a..1981e87abe 100755
--- a/observations/obs_converters/gnd_gps_vtec/work/quickbuild.csh
+++ b/observations/obs_converters/gnd_gps_vtec/work/quickbuild.csh
@@ -10,12 +10,13 @@
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
\rm -f ../../../obs_def/obs_def_mod.f90
\rm -f ../../../obs_kind/obs_kind_mod.f90
@@ -48,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -56,9 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-\rm -f *.o *.mod input.nml*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All ${MODEL} programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/gps/convert_cosmic_gps_cdf.f90 b/observations/obs_converters/gps/convert_cosmic_gps_cdf.f90
index d0cfede054..e736328298 100644
--- a/observations/obs_converters/gps/convert_cosmic_gps_cdf.f90
+++ b/observations/obs_converters/gps/convert_cosmic_gps_cdf.f90
@@ -29,8 +29,8 @@ program convert_cosmic_gps_cdf
use utilities_mod, only : initialize_utilities, find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_nml_file, &
get_next_filename, error_handler, E_ERR, E_MSG, &
- nc_check, find_textfile_dims, do_nml_term, &
- finalize_utilities
+ find_textfile_dims, do_nml_term, finalize_utilities
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : VERTISHEIGHT, set_location
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
static_init_obs_sequence, init_obs, destroy_obs, &
@@ -1021,7 +1021,6 @@ function gsi_refractivity_error(H, lat, is_it_global, factor)
real(r8) :: gsi_refractivity_error
real(r8) :: zkm, rerr
- integer :: kk
zkm = H * 0.001 ! height in km
rerr = 1.0_r8
diff --git a/observations/obs_converters/gps/convert_gpsro_bufr.f90 b/observations/obs_converters/gps/convert_gpsro_bufr.f90
index 4358ad02cb..ec50d162c6 100644
--- a/observations/obs_converters/gps/convert_gpsro_bufr.f90
+++ b/observations/obs_converters/gps/convert_gpsro_bufr.f90
@@ -32,7 +32,8 @@ program convert_gpsro_bufr
use utilities_mod, only : initialize_utilities, find_namelist_in_file, &
check_namelist_read, nmlfileunit, do_nml_file, &
get_next_filename, error_handler, E_ERR, E_MSG, &
- nc_check, find_textfile_dims, do_nml_term
+ find_textfile_dims, do_nml_term
+use netcdf_utilities_mod, only : nc_check
use location_mod, only : VERTISHEIGHT, set_location
use obs_sequence_mod, only : obs_sequence_type, obs_type, read_obs_seq, &
static_init_obs_sequence, init_obs, destroy_obs, &
@@ -68,10 +69,9 @@ program convert_gpsro_bufr
character (len=512) :: msgstring
character (len=256) :: next_infile
-character (len=80) :: name
character (len=6) :: subset
integer :: nlevels, nfiles, num_new_obs, oday, osec, &
- iyear, imonth, iday, ihour, imin, isec, obs_count, gps_obs_num, obs_num_byfile, &
+ iyear, imonth, iday, ihour, imin, obs_count, gps_obs_num, obs_num_byfile, &
io, iunit, filenum, dummy
logical :: file_exist, first_obs, from_list = .false.
real(r8) :: oerr, qc, nx, ny, nz, &
@@ -115,7 +115,7 @@ program convert_gpsro_bufr
integer :: idate,iret,num_message,num_subset
integer :: ikx, nlevs, nreps_ROSEQ1
integer :: i,k,m,said,ptid
-integer :: nread,ndata,nprof_gps,nprof_bytime,nprof_bad
+integer :: nprof_gps,nprof_bytime,nprof_bad
integer :: nprof_nosat,nprof_cdaac_bad,nprof_gras_bad,nprof_levs_bad
integer :: ibit(mxib),nib
integer :: nsatid,nlines,istat
@@ -786,7 +786,6 @@ function gsi_refractivity_error(H, lat, is_it_global, factor)
real(r8) :: gsi_refractivity_error
real(r8) :: zkm, rerr
- integer :: kk
zkm = H * 0.001 ! height in km
rerr = 1.0_r8
diff --git a/observations/obs_converters/gps/ionPrf/ionPrf_C001.2013.213.00.08.G29_2013.3520_nc b/observations/obs_converters/gps/ionPrf/ionPrf_C001.2013.213.00.08.G29_2013.3520_nc
new file mode 100644
index 0000000000..20b2a6573e
Binary files /dev/null and b/observations/obs_converters/gps/ionPrf/ionPrf_C001.2013.213.00.08.G29_2013.3520_nc differ
diff --git a/observations/obs_converters/gps/work/input.nml b/observations/obs_converters/gps/work/input.nml
index 5c0d673c79..03016cd4f1 100644
--- a/observations/obs_converters/gps/work/input.nml
+++ b/observations/obs_converters/gps/work/input.nml
@@ -72,8 +72,8 @@
! 13.0, 14.0, 15.0, 16.0, 17.0
&convert_cosmic_ionosphere_nml
- input_file = ''
- input_file_list = 'file_list.txt'
+ input_file = '../ionPrf/ionPrf_C001.2013.213.00.08.G29_2013.3520_nc'
+ input_file_list = ''
output_file = 'obs_seq.iondens'
observation_error_file = '../f3coerr.nc'
observation_error_method = 'scaled'
@@ -107,7 +107,8 @@
output_obs_kind_mod_file = '../../../../assimilation_code/modules/observations/obs_kind_mod.f90'
input_obs_def_mod_file = '../../../../observations/forward_operators/DEFAULT_obs_def_mod.F90'
output_obs_def_mod_file = '../../../../observations/forward_operators/obs_def_mod.f90'
- input_files = '../../../../observations/forward_operators/obs_def_gps_mod.f90'
+ input_files = '../../../../observations/forward_operators/obs_def_gps_mod.f90',
+ '../../../../observations/forward_operators/obs_def_upper_atm_mod.f90'
/
&obs_kind_nml
diff --git a/observations/obs_converters/gps/work/quickbuild.csh b/observations/obs_converters/gps/work/quickbuild.csh
index 68445ae5ea..9a5be91d8e 100755
--- a/observations/obs_converters/gps/work/quickbuild.csh
+++ b/observations/obs_converters/gps/work/quickbuild.csh
@@ -6,16 +6,19 @@
#
# DART $Id$
#
-# This script compiles all executables in this directory.
+# compile all converter programs
#----------------------------------------------------------------------
# 'preprocess' is a program that culls the appropriate sections of the
-# observation module for the observations types in 'input.nml'; the
-# resulting source file is used by all the remaining programs,
+# observation module for the observations types in 'input.nml'; the
+# resulting source file is used by all the remaining programs,
# so this MUST be run first.
#----------------------------------------------------------------------
-\rm -f preprocess *.o *.mod
+set nonomatch
+\rm -f preprocess *.o *.mod Makefile
+\rm -f ../../../obs_def/obs_def_mod.f90
+\rm -f ../../../obs_kind/obs_kind_mod.f90
set MODEL = "GPS"
@@ -46,7 +49,7 @@ foreach TARGET ( mkmf_* )
@ n = $n + 1
echo
echo "---------------------------------------------------"
- echo "${MODEL} build number ${n} is ${PROG}"
+ echo "${MODEL} build number ${n} is ${PROG}"
\rm -f ${PROG}
csh $TARGET || exit $n
make || exit $n
@@ -54,10 +57,9 @@ foreach TARGET ( mkmf_* )
endsw
end
-# clean up. comment this out if you want to keep the .o and .mod files around
-\rm -f *.o *.mod input.nml.*_default
+\rm -f *.o *.mod input.nml*_default Makefile .cppdefs
-echo "Success: All DART programs compiled."
+echo "Success: All ${MODEL} programs compiled."
exit 0
diff --git a/observations/obs_converters/observations.html b/observations/obs_converters/observations.html
index 4594871c3a..ea076945d4 100644
--- a/observations/obs_converters/observations.html
+++ b/observations/obs_converters/observations.html
@@ -134,7 +134,8 @@
DATA SOURCES AND FORMATS
netCDF
Start with the MADIS converters,
and in particular try the convert_madis_profiler.f90
-file because it is the most straightforward.
+file because it is the most straightforward. Another good option is
+SST/oi_sst_to_obs.f90.