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:

+

@@ -298,7 +303,7 @@

REFERENCES

[top]

ERROR CODES and CONDITIONS

- +
diff --git a/assimilation_code/programs/obs_impact_tool/obs_impact_tool.nml b/assimilation_code/programs/obs_impact_tool/obs_impact_tool.nml index 008e9f6c07..8ee77e8671 100644 --- a/assimilation_code/programs/obs_impact_tool/obs_impact_tool.nml +++ b/assimilation_code/programs/obs_impact_tool/obs_impact_tool.nml @@ -1,6 +1,5 @@ &obs_impact_tool_nml input_filename = 'cross_correlations.txt' output_filename = 'control_impact_runtime.txt' - allow_any_impact_values = .false. debug = .false. / diff --git a/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.f90 b/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.f90 new file mode 100644 index 0000000000..391628ef17 --- /dev/null +++ b/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.f90 @@ -0,0 +1,588 @@ +! 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 obs_keep_a_few + +!> open an obs_seq file and copy over the first N of each obs type to +!> the output file. the value of N is namelist-settable. intended +!> to subset a large obs_seq file for testing or other purposes but +!> still keep examples of each type of obs from the input. + +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_keep_a_few_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_keep_a_few_nml", iunit) +read(iunit, nml = obs_keep_a_few_nml, iostat = io) +call check_namelist_read(iunit, io, "obs_keep_a_few_nml") + +! Record the namelist values used for the run ... +if (do_nml_file()) write(nmlfileunit, nml=obs_keep_a_few_nml) +if (do_nml_term()) write( * , nml=obs_keep_a_few_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_keep_a_few',msgstring) +endif + +write(msgstring, *) 'Starting to process input sequence file: ' +write(msgstring1,*) trim(filename_in) +call error_handler(E_MSG,'obs_keep_a_few',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_keep_a_few', 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_keep_a_few',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_keep_a_few') +call register_module(source,revision,revdate) +call static_init_obs_sequence() + +end subroutine setup + + +!--------------------------------------------------------------------- +subroutine shutdown() + +call finalize_utilities('obs_keep_a_few') + +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_keep_a_few',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_keep_a_few', 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_keep_a_few: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_keep_a_few: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_keep_a_few: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_keep_a_few: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_keep_a_few: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_keep_a_few: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_keep_a_few', 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_keep_a_few + +! +! $URL$ +! $Id$ +! $Revision$ +! $Date$ diff --git a/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.html b/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.html new file mode 100644 index 0000000000..22d677e739 --- /dev/null +++ b/assimilation_code/programs/obs_keep_a_few/obs_keep_a_few.html @@ -0,0 +1,269 @@ + + + +program obs_keep_a_few + + + + + + +

program obs_keep_a_few

+ +
RoutineMessageComment
obs_impact_tool
+ + + + +
+ DART project logo + +

Jump to DART Documentation Main Index
+ version information for this file:
+ + $Id$
+

+ +NAMELIST / +FILES / +REFERENCES / +ERRORS / +PLANS / +TERMS OF USE + +

Overview

+ +

+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. +

+ + + + +
[top]

+

OTHER MODULES USED

+
+types_mod
+utilities_mod
+location_mod
+obs_def_mod
+obs_kind_mod
+time_manager_mod
+obs_sequence_mod
+
+ + + + + + +
[top]

+

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. +

+ +
+
+&obs_keep_a_few_nml
+   filename_in        = ''
+   filename_out       = '' 
+   max_count_per_type = 10
+   max_total_count    = -1
+   print_only         = .false.
+   calendar           = 'Gregorian'
+   /
+
+
+ +
+
+ + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Item Type Description
filename_incharacter(len=256)Name of the observation sequence file to read. +
filename_outcharacter(len=256)Name of the observation sequence file to create. +An existing file will be overwritten. +
max_count_per_typeintegerThe 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_countintegerIf 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_onlylogicalIf 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. +
calendarcharacter(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. +
+
+ +
+
+ + + + + + +
[top]

+

FILES

+ + + + + + + +
[top]

+

REFERENCES

+ + + + + + + +
[top]

+

ERROR CODES and CONDITIONS

+
+ + + + + + + +
RoutineMessageComment
 none 
+
+ +

KNOWN BUGS

+

+none +

+ + + + + + +
[top]

+

FUTURE PLANS

+

+none +

+ + + + + + +
[top]

+

Terms of Use

+ +

+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 +

+ + + + + + + +
Contact: DART core group
Revision: $Revision$
Source: $URL$
Change Date: $Date$
Change history:  try "svn log" or "svn diff"
+ + + + + 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

+ + + + + + +
+ DART project logo + +

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 $
+

+ +NAMELIST / +MODULES / +FILES / +REFERENCES / +ERRORS / +PLANS / +TERMS OF USE + +

Overview

+ +

+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. +

+ + + + + +

+ +
[top]

+

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. +

+ +
+
+&perturb_single_instance
+   ens_size               = ''
+   input_files            = ''      
+   output_files           = ''
+   output_file_list       = ''
+   perturbation_amplitude = 0.0     
+   single_restart_file_in = .false.      
+  /
+
+
+ +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Item Type Description
ens_sizeintegerTotal number of ensemble members. +
input_filescharacter(len=256),dimension(num_domains) The restart file you would like to perturb from. +
output_file_listcharacter(len=256) A file containing a list of the desired output names. +
output_filescharacter(len=256) An array of filenames +
perturbation_amplitudereal(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_inlogical 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. +

+ +
+
+&perturb_single_instance_nml
+   ens_size         = 3
+   input_files      = 'caminput.nc'
+   output_files     = 'cam_pert1.nc','cam_pert2.nc','cam_pert3.nc'
+/
+
+
+ +
+
+ +
+
+ + + + + + + + +
[top]

+

FILES

+
  • inputfile.nc (description file that will be perturbed) +
  • output_file_list.txt (a file containing a list of restart files) and, +
  • perturb_single_instance.nml +
+ + + + + + +
[top]

+

REFERENCES

+
    +
  • none
  • +
+ + + + + + +
[top]

+

ERROR CODES and CONDITIONS

+
+ + + + + + + +
RoutineMessageComment
perturb_single_instanceInvalid method numberValues 1-4 are supported
+
+ +

KNOWN BUGS

+

+none +

+ + + + + + +
[top]

+

FUTURE PLANS

+

+none +

+ + + + + + +
[top]

+

Terms of Use

+ +

+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 +

+ + + + + + + +
Contact: DART core group
Revision: $Revision: 12663 $
Source: $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/pertirb_tool/assimilation_code/programs/perturb_single_instance/perturb_single_instance.html $
Change Date: $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.

    @@ -118,7 +119,7 @@

    NAMELIST

    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/null + input_files = 'null' /
  • @@ -139,7 +140,8 @@

    NAMELIST

    input_obs_def_mod_file character(len=129)
    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 @@

    NAMELIST

     &model_nml
    -   output_state_vector = .false.,
    -   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_0d      = '',
    -   state_names_1d      = '',
    -   state_names_2d      = 'PS'
    -   state_names_3d      = 'T', 'U', 'V', 'Q', 'CLDLIQ','CLDICE',
    -   which_vert_1d       = -2 ,
    -   which_vert_2d       = -1 , 
    -   which_vert_3d       = 6*1  ,
    -   pert_names          = '',
    -   pert_sd             = -888888.0,
    -   pert_base_vals      = -888888.0,
    -   vert_coord          = 'pressure'
    -   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.
    -   model_version       = '4.0',
    -   impact_only_same_kind = '',
    -   /
    +   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
    +/  
     
    @@ -297,27 +288,8 @@

    NAMELIST


    -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 @@

    NAMELIST

     &model_nml
    -   model_analysis_filename      = 'mpas_init.nc',
    -   grid_definition_filename     = 'mpas_init.nc',
    -   output_state_vector          = .false.,
    +   init_template_filename       = 'mpas_init.nc',
        vert_localization_coord      = 3,
        assimilation_period_days     = 0,
        assimilation_period_seconds  = 21600,
    @@ -150,25 +147,13 @@ 

    NAMELIST

    -model_analysis_filename +init_template_filename character(len=256)
    [default: 'mpas_init.nc'] 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 @@

      NAMELIST



      - - +
      [top]

      Grid information

      As the forward operators use the unstructured grid meshes in MPAS-ATM, the DART/MPAS interface needs to read static @@ -440,7 +413,7 @@

      Grid information

      point in the cartesian coordinate (to avoid the polar issues).

      - +
      @@ -765,7 +738,7 @@

      PUBLIC INTERFACES

      Required Interface Routines

      -
      integer :: nCells the number of cell centers
      integer :: nEdges the number of cell edges
      integer :: nVertices the number of cell vertices
      +
      @@ -777,7 +750,6 @@

      Required Interface Routines

      - @@ -786,7 +758,7 @@

      Required Interface Routines

      use model_mod, only : get_model_size
       adv_1step
       init_time
       init_conditions
       nc_write_model_atts
       nc_write_model_vars
       pert_model_state
       get_close_maxdist_init
       get_close_obs_init

      Unique Interface Routines

      - +
      @@ -1159,10 +1131,10 @@

      Required Interface Routines


      -ierr = nc_write_model_atts(ncFileID) +call nc_write_model_atts(ncFileID, domainID)
      -integer             :: nc_write_model_atts
       integer, intent(in) :: ncFileID
      +integer, intent(in) :: domainID
       
      @@ -1171,7 +1143,7 @@

      Required Interface Routines

      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

      - - + +
      use model_mod, only : get_model_analysis_filename
       get_grid_definition_filename
      ncFileID    Integer file descriptor to previously-opened netCDF file.
      ierrReturns a 0 for successful completion.
      domainIDInteger descriptor specifying the domain whose metadata should be written.
      @@ -1205,59 +1177,6 @@

      Required Interface Routines

      - -
      -
      -ierr = nc_write_model_vars(ncFileID, statevec, copyindex, timeindex) -
      -integer,                intent(in) :: ncFileID
      -real(r8), dimension(:), intent(in) :: statevec
      -integer,                intent(in) :: copyindex
      -integer,                intent(in) :: timeindex
      -integer                            :: ierr
      -
      -
      - -
      - - -

      -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. -

      - - - - - - - - - - - - - - - - - - -
      ncFileIDfile descriptor to previously-opened netCDF file.
      statevecA model state vector.
      copyindex   Integer index of copy to be written.
      timeindexThe timestep counter for the given state.
      ierrReturns 0 for normal completion.
      - -
      -
      - - -
      @@ -1465,7 +1384,7 @@

      Required Interface Routines

      [top]

      FILES

      - +
      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 @@

      FILES

      [top]

      REFERENCES

        -
      1. none
      2. +
      3. 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 + + + + + + +

      PROGRAM sst_to_obs, oi_sst_to_obs

      + +
      filename purpose
      input.nml
      + + + + +
      + DART project logo + +

      Jump to DART Documentation Main Index
      + version information for this file:
      + + $Id$
      +

      + +NAMELIST / +DECISIONS / +ERRORS / +PLANS / +TERMS OF USE + +

      Overview

      + +

      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

      + +

      These routines are designed to convert the + GHRSST Level 4 AVHRR_OI Global Blended Sea Surface Temperature Analysis (GDS version 2) from NCEI data + distributed by the +Physical Oceanography Distributed Active Archive Center. +Please remember to cite the data in your publications, +specific instructions from PODAAC are available here. This is an example: +

      + +
      +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: +

      +
        +
      1. compile the converters by running work/quickbuild.csh + in the usual way. +

      2. + +
      3. customize the shell_scripts/parameters_SST + resource file to specify variables used by the rest of the scripting. +

      4. + +
      5. run shell_scripts/get_sst_ftp.sh + to download the data from PODAAC. +

      6. + +
      7. provide a mask for the desired study area. +

      8. + +
      9. 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. +

      10. + +
      11. combine all output files for the region and timeframe of interest + into one file using the + obs_sequence_tool +
      12. + +
      + +

      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: +

      + +
      +0[1234] cheyenne6:/<6>obs_converters/SST
      +.
      +|-- ObsData
      +|   `-- SST
      +|       |-- ncfile
      +|       |   `-- 2010
      +|       |       |-- 20101230120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0.nc
      +|       |       `-- 20101231120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0.nc
      +|       `-- nwaSST
      +|           `-- 2010
      +|               |-- 20101230120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0_NWA.nc
      +|               `-- 20101231120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0_NWA.nc
      +|-- oi_sst_to_obs.f90
      +|-- oi_sst_to_obs.nml
      +|-- sst_to_obs.f90
      +|-- sst_to_obs.nml
      +|-- shell_scripts
      +|   |-- Prepare_SST.sh
      +|   |-- functions.sh
      +|   |-- get_sst_ftp.sh
      +|   |-- input.nml
      +|   |-- input.nml.template
      +|   |-- my_log.txt
      +|   |-- parameters_SST
      +|   `-- prepare_SST_file_NWA.sh
      +|-- masks
      +|   |-- Mask_NWA-NCDC-L4LRblend-GLOB-v01-fv02_0-AVHRR_OI.nc
      +|   `-- Mask_NWA120000-NCEI-L4_GHRSST-SSTblend-AVHRR_OI-GLOB-v02.0-fv02.0.nc
      +`-- work
      +    |-- Makefile
      +    |-- advance_time
      +    |-- input.nml
      +    |-- mkmf_advance_time
      +    |-- mkmf_obs_sequence_tool
      +    |-- mkmf_oi_sst_to_obs
      +    |-- mkmf_preprocess
      +    |-- mkmf_sst_to_obs
      +    |-- obs_sequence_tool
      +    |-- oi_sst_to_obs
      +    |-- path_names_advance_time
      +    |-- path_names_obs_sequence_tool
      +    |-- path_names_oi_sst_to_obs
      +    |-- path_names_preprocess
      +    |-- path_names_sst_to_obs
      +    |-- preprocess
      +    |-- quickbuild.csh
      +    `-- sst_to_obs
      +
      + +

      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

      + +

      oi_sst_to_obs is designed to convert the +NOAA High-resolution Blended Analysis: Daily Values using AVHRR only data. +The global metadata of a typical file is shown here: +

      +
      +:Conventions = "CF-1.5" ;
      +: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." ;
      +:history = "Thu Aug 24 13:46:51 2017: ncatted -O -a References,global,d,, sst.day.mean.2004.v2.nc\n",
      +	"Version 1.0" ;
      +:references = "https://www.esrl.noaa.gov/psd/data/gridded/data.noaa.oisst.v2.highres.html" ;
      +:dataset_title = "NOAA Daily Optimum Interpolation Sea Surface Temperature" ;
      +
      + +

      +The workflow is usually: +

      +
        +
      1. compile the converters by running work/quickbuild.csh + in the usual way. +

      2. + +
      3. download the desired data. +

      4. + +
      5. customize the work/input.nml file. +

      6. + +
      7. run work/oi_sst_to_obs + to create a single DART observation sequence file. +

      8. + +
      9. combine all output files for the region and timeframe of interest + into one file using the + obs_sequence_tool +
      10. + +
      + + + + + + +
      +

      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. +

      + +
      +
      +&sst_to_obs_nml
      +   sst_netcdf_file     = '1234567.nc'
      +   sst_netcdf_filelist = 'sst_to_obs_filelist'
      +   sst_out_file        = 'obs_seq.sst'
      +   subsample_intv      = 1
      +   sst_rep_error       = 0.3
      +   debug               = .false.
      +   /
      +
      +
      + +
      + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
      Contents Type Description
      sst_netcdf_file character(len=256) 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. +

      + +
      +
      +&oi_sst_to_obs_nml
      +   input_file       = '1234567.nc'
      +   output_file_base = 'obs_seq.sst'
      +   subsample_intv   = 1
      +   sst_error_std    = 0.3
      +   debug            = .false.
      +   /
      +
      +
      + +
      + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
      Contents Type Description
      input_file character(len=256) 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. +

      + + + + + + +
      +

      FUTURE PLANS

      + +

      +none +

      + + + + + + +
      +

      Terms of Use

      + +

      +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 +

      + + + + + + + +
      Contact: Tim Hoar
      Revision: $Revision$
      Source: $URL$
      Change Date: $Date$
      Change history:  try "svn log" or "svn diff"
      + + + + + 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.
      Comma separated text
      Start with the Ameriflux converter.
      @@ -330,21 +331,50 @@

      PROGRAMS

      The current list of converters include:

      + +

      +There are also a couple utilities of note: +

      +
        +
      • even_sphere - a utility for generating evenly-spaced observation locations that can then be used in a perfect model experiment.
      • +
      • obs_error - modules that specify observation errors based on what is used by ECMWF and NCEP
      • +
      +

      In addition the following external program produces DART observation sequence files: diff --git a/observations/obs_converters/ok_mesonet/work/quickbuild.csh b/observations/obs_converters/ok_mesonet/work/quickbuild.csh index e006a79780..68c15aafc6 100755 --- a/observations/obs_converters/ok_mesonet/work/quickbuild.csh +++ b/observations/obs_converters/ok_mesonet/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/quikscat/work/mkmf_convert_L2b b/observations/obs_converters/quikscat/work/mkmf_convert_L2b index b659bff5a7..03373e4fdb 100755 --- a/observations/obs_converters/quikscat/work/mkmf_convert_L2b +++ b/observations/obs_converters/quikscat/work/mkmf_convert_L2b @@ -6,23 +6,23 @@ # # DART $Id$ -# This is the right set for coral. +# Your locations may differ #---------------------------------------------------------------------- #set JPGDIR = /contrib/jpeg-6b_intel-10.1-64 #set HDFDIR = /contrib/HDF4.2r4_intel-10.1-64 +#set HDFDIR = /contrib/HDF4.2r4/intel-10-64 #set MYLIBS = "-lmfhdf -ldf -ljpeg -lz -lm" #set MYINCDIR = "-I${HDFDIR}/include -I${JPGDIR}/include" #set MYLIBDIR = "-L${HDFDIR}/lib -L${JPGDIR}/lib" - -# This is the right set for the DASG cluster. #---------------------------------------------------------------------- - set HDFDIR = /contrib/HDF4.2r4/intel-10-64 - set MYLIBS = "-lmfhdf -ldf -ljpeg -lz -lm" - set MYINCDIR = "-I${HDFDIR}/include" - set MYLIBDIR = "-L${HDFDIR}/lib" + +set HDFDIR = /opt/local +set MYLIBS = "-lmfhdf -ldf -ljpeg -lz -lm" +set MYINCDIR = "-I${HDFDIR}/include" +set MYLIBDIR = "-L${HDFDIR}/lib" ../../../../build_templates/mkmf -p convert_L2b -t ../../../../build_templates/mkmf.template \ - -l "${MYINCDIR} -L/usr/lib64 ${MYLIBDIR} ${MYLIBS}" \ + -l "${MYINCDIR} ${MYLIBDIR} ${MYLIBS}" \ -a "../../../.." path_names_convert_L2b exit $status diff --git a/observations/obs_converters/quikscat/work/quickbuild.csh b/observations/obs_converters/quikscat/work/quickbuild.csh index caab245b79..47c333cb40 100755 --- a/observations/obs_converters/quikscat/work/quickbuild.csh +++ b/observations/obs_converters/quikscat/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/radar/work/quickbuild.csh b/observations/obs_converters/radar/work/quickbuild.csh index ba38b4cbdb..c49f5179e1 100755 --- a/observations/obs_converters/radar/work/quickbuild.csh +++ b/observations/obs_converters/radar/work/quickbuild.csh @@ -5,15 +5,18 @@ # 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, +# 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 @@ -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 - echo "" - echo "Success: All DART programs compiled." - echo "" -endif +\rm -f *.o *.mod input.nml*_default Makefile .cppdefs + +echo "Success: All ${MODEL} programs compiled." exit 0 diff --git a/observations/obs_converters/buildall.csh b/observations/obs_converters/run_tests.csh similarity index 62% rename from observations/obs_converters/buildall.csh rename to observations/obs_converters/run_tests.csh index 1ef2d3b0dd..e38e42f73e 100755 --- a/observations/obs_converters/buildall.csh +++ b/observations/obs_converters/run_tests.csh @@ -6,18 +6,29 @@ # # DART $Id$ -set SNAME = $0 -set clobber + +echo +echo +echo "==================================================================" +echo "Start of observation converter tests at "`date` +echo "==================================================================" +echo +echo set startdir=`pwd` +set LOGDIR=${startdir}/testing_logs +echo putting build and run logs in: +echo $LOGDIR + +mkdir -p ${LOGDIR} +\rm -f ${LOGDIR}/* + echo echo echo "==================================================================" -echo "==================================================================" echo "Compiling NCEP BUFR libs starting at "`date` echo "==================================================================" -echo "==================================================================" echo echo @@ -46,6 +57,11 @@ if ( -f ../../build_templates/mkmf.template ) then setenv FCOMP pgi setenv UNDERSCORE add echo setting the BUFR lib to build using the pgi compilers + else if ( "$fcomp" == "nagfor" ) then + setenv CCOMP nag + setenv FCOMP nag + setenv UNDERSCORE add + echo setting the BUFR lib to build using the nag compilers else echo unrecognized compiler in ../../build_templates/mkmf.template echo set NCEP BUFR library compiler choice in NCEP/prep_bufr/install.sh @@ -55,69 +71,73 @@ endif cd NCEP/prep_bufr -./install.sh +set FAILURE = 0 + +( ./install.sh > ${LOGDIR}/buildlog.NCEP.out ) || set FAILURE = 1 echo echo echo "==================================================================" -echo "==================================================================" echo "Build of NCEP BUFR libs ended at "`date` -echo "==================================================================" +if ( $FAILURE ) then + echo + echo "ERROR - build was unsuccessful" + echo +endif echo "==================================================================" echo echo cd $startdir -foreach project ( `find . -name quickbuild.csh -print` ) +foreach quickb ( `find . -name quickbuild.csh -print` ) cd $startdir - set dir = $project:h - set FAILURE = 0 + # get the working dir name. also, make a project name by stripping off + # the leading ./ and the /work parts of the dirname, and turning slashes + # into underscores so we can use the string as part of a log filename. + set wdir = $quickb:h + set project = `echo $wdir | sed -e 's;^./;;' -e 's;/[^/]*$;;' -e 's;/;_;g'` echo echo echo "==================================================================" - echo "==================================================================" - echo "Compiling obs converter $dir starting at "`date` - echo "==================================================================" + echo "Compiling obs converter $project starting at "`date` echo "==================================================================" echo echo - cd $dir + cd $wdir echo - echo building in $dir + echo building in $wdir - ./quickbuild.csh || set FAILURE = 1 + set FAILURE = 0 + ( ./quickbuild.csh > ${LOGDIR}/buildlog.${project}.out ) || set FAILURE = 1 echo - echo - echo "==================================================================" - echo "==================================================================" if ( $FAILURE ) then - echo "ERROR - unsuccessful build in $dir at "`date` + echo "ERROR - unsuccessful build of $project at "`date` echo - switch ( $dir ) + switch ( $project ) - case *GSI2DART* + case GSI2DART echo " This build expected to fail on case-insensitive filesystems." breaksw - case */var/* + case var echo " This build expected to fail unless you have the WRF code in-situ." breaksw - case *AIRS* + case AIRS echo " AIRS build is expected to fail due to dependency on hdfeos libs," echo " which are not required to be part of the standard DART environment." breaksw - case *quikscat* + case quikscat echo " quikscat build is expected to fail due to dependency on mfhdf libs," echo " which are not required to be part of the standard DART environment." breaksw @@ -127,16 +147,48 @@ foreach project ( `find . -name quickbuild.csh -print` ) breaksw endsw else - echo "Successful build of obs converter $dir ended at "`date` + echo "Successful build of obs converter $project ended at "`date` + echo + echo "Executing converters in directory $wdir" + + \rm -f *.o *.mod + \rm -f Makefile input.nml.*_default .cppdefs + + foreach TARGET ( mkmf_* ) + set FAILURE = 0 + set PROG = `echo $TARGET | sed -e 's#mkmf_##'` + echo "Running $PROG" + if ( -f ${PROG}.in ) then + ( ./$PROG < ${PROG}.in > ${LOGDIR}/runlog.${project}.out ) || set FAILURE = 1 + else + ( ./$PROG > ${LOGDIR}/runlog.${project}.out ) || set FAILURE = 1 + endif + if ( $FAILURE ) then + echo "ERROR - unsuccessful run of $PROG at "`date` + else + echo "Successful run of $PROG at "`date` + \rm -f $PROG + endif + end + + echo + endif - echo "==================================================================" echo "==================================================================" echo echo end +echo +echo +echo "==================================================================" +echo "End of observation converter tests at "`date` +echo "==================================================================" +echo +echo + exit 0 # diff --git a/observations/obs_converters/snow/snow_to_obs_netcdf.f90 b/observations/obs_converters/snow/snow_to_obs_netcdf.f90 index 436e7b1f63..1581ba1973 100644 --- a/observations/obs_converters/snow/snow_to_obs_netcdf.f90 +++ b/observations/obs_converters/snow/snow_to_obs_netcdf.f90 @@ -22,7 +22,8 @@ program snow_to_obs_netcdf 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 + do_nml_term +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_time, & operator(-), GREGORIAN, operator(+), print_date diff --git a/observations/obs_converters/snow/work/quickbuild.csh b/observations/obs_converters/snow/work/quickbuild.csh index 16642cfac0..329691220b 100755 --- a/observations/obs_converters/snow/work/quickbuild.csh +++ b/observations/obs_converters/snow/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/text/work/quickbuild.csh b/observations/obs_converters/text/work/quickbuild.csh index 16642cfac0..329691220b 100755 --- a/observations/obs_converters/text/work/quickbuild.csh +++ b/observations/obs_converters/text/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/text_GITM/work/quickbuild.csh b/observations/obs_converters/text_GITM/work/quickbuild.csh index 60d17a7544..c26194a789 100755 --- a/observations/obs_converters/text_GITM/work/quickbuild.csh +++ b/observations/obs_converters/text_GITM/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/tpw/convert_gpspw.f90 b/observations/obs_converters/tpw/convert_gpspw.f90 index 122ea48155..d6841968eb 100644 --- a/observations/obs_converters/tpw/convert_gpspw.f90 +++ b/observations/obs_converters/tpw/convert_gpspw.f90 @@ -40,7 +40,7 @@ program convert_gpspw 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, & is_longitude_between, finalize_utilities, & open_file, close_file, register_module use location_mod, only : VERTISSURFACE, set_location diff --git a/observations/obs_converters/tpw/convert_tpw.f90 b/observations/obs_converters/tpw/convert_tpw.f90 index 2f30f5ef68..80b1f63994 100644 --- a/observations/obs_converters/tpw/convert_tpw.f90 +++ b/observations/obs_converters/tpw/convert_tpw.f90 @@ -35,7 +35,6 @@ program convert_tpw ! has a full bin of all available observations. the current code starts ! at 0Z and ends at 0Z and so you should construct your time bins carefully ! around the day boundaries. -! use types_mod, only : r8, metadatalength, missing_r8 @@ -45,7 +44,7 @@ program convert_tpw 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, & is_longitude_between, finalize_utilities, & open_file, close_file, register_module use location_mod, only : VERTISSURFACE, set_location @@ -65,16 +64,13 @@ program convert_tpw get_index_for_type_of_obs use obs_utilities_mod, only : create_3d_obs, add_obs_to_seq - -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$" !-------------------------------------- diff --git a/observations/obs_converters/tpw/work/quickbuild.csh b/observations/obs_converters/tpw/work/quickbuild.csh index b629953dab..dbbe3f9278 100755 --- a/observations/obs_converters/tpw/work/quickbuild.csh +++ b/observations/obs_converters/tpw/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/tropical_cyclone/work/quickbuild.csh b/observations/obs_converters/tropical_cyclone/work/quickbuild.csh index e3465ca47f..d831300230 100755 --- a/observations/obs_converters/tropical_cyclone/work/quickbuild.csh +++ b/observations/obs_converters/tropical_cyclone/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/utilities/create_sphere_obs.f90 b/observations/obs_converters/utilities/create_sphere_obs.f90 index 72e1c18833..c5d71c4eef 100644 --- a/observations/obs_converters/utilities/create_sphere_obs.f90 +++ b/observations/obs_converters/utilities/create_sphere_obs.f90 @@ -16,7 +16,7 @@ program create_sphere_obs use types_mod, only : r8, missing_r8, pi, rad2deg use location_mod, only : VERTISPRESSURE, set_location -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 time_manager_mod, only : time_type, set_calendar_type, set_date, GREGORIAN, & diff --git a/observations/obs_converters/utilities/obs_utilities_mod.f90 b/observations/obs_converters/utilities/obs_utilities_mod.f90 index cfcb7a5643..92d25d54d6 100644 --- a/observations/obs_converters/utilities/obs_utilities_mod.f90 +++ b/observations/obs_converters/utilities/obs_utilities_mod.f90 @@ -8,7 +8,8 @@ module obs_utilities_mod use types_mod, only : i2, i4, r8, MISSING_R8, MISSING_I -use utilities_mod, only : nc_check, E_MSG, E_ERR, error_handler +use utilities_mod, only : E_MSG, E_ERR, error_handler +use netcdf_utilities_mod, only : nc_check use obs_def_mod, only : obs_def_type, set_obs_def_time, set_obs_def_type_of_obs, & set_obs_def_error_variance, set_obs_def_location, & get_obs_def_time, get_obs_def_location, & diff --git a/observations/obs_converters/utilities/threed_sphere/quickbuild.csh b/observations/obs_converters/utilities/threed_sphere/quickbuild.csh index c0137d8fdf..b309a82545 100755 --- a/observations/obs_converters/utilities/threed_sphere/quickbuild.csh +++ b/observations/obs_converters/utilities/threed_sphere/quickbuild.csh @@ -6,16 +6,17 @@ # # DART $Id$ # -# Script to manage the compilation of all components. +# 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,11 +57,9 @@ foreach TARGET ( mkmf_* ) endsw end -\rm -f *.o *.mod input.nml*_default +\rm -f *.o *.mod input.nml*_default Makefile .cppdefs -echo "" -echo "Success: All single task DART programs compiled." -echo "" +echo "Success: All ${MODEL} programs compiled." exit 0 diff --git a/observations/obs_converters/var/work/quickbuild.csh b/observations/obs_converters/var/work/quickbuild.csh index 85c3236fe2..39dbf9ac54 100755 --- a/observations/obs_converters/var/work/quickbuild.csh +++ b/observations/obs_converters/var/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/utilities/oned/mkmf_obs_assim_count b/observations/utilities/oned/mkmf_obs_assim_count new file mode 100755 index 0000000000..d435960e5d --- /dev/null +++ b/observations/utilities/oned/mkmf_obs_assim_count @@ -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_assim_count -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_assim_count + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/oned/mkmf_obs_data_denial b/observations/utilities/oned/mkmf_obs_data_denial new file mode 100755 index 0000000000..17a675d8f3 --- /dev/null +++ b/observations/utilities/oned/mkmf_obs_data_denial @@ -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_data_denial -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_data_denial + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/models/ROMS/work/mkmf_test_grid b/observations/utilities/oned/mkmf_obs_info similarity index 72% rename from models/ROMS/work/mkmf_test_grid rename to observations/utilities/oned/mkmf_obs_info index 2477356628..721ad65543 100755 --- a/models/ROMS/work/mkmf_test_grid +++ b/observations/utilities/oned/mkmf_obs_info @@ -6,8 +6,8 @@ # # DART $Id$ -../../../build_templates/mkmf -p test_grid -t ../../../build_templates/mkmf.template \ - -a "../../.." path_names_test_grid +../../../build_templates/mkmf -p obs_info -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_info exit $status diff --git a/observations/utilities/oned/mkmf_obs_keep_a_few b/observations/utilities/oned/mkmf_obs_keep_a_few new file mode 100755 index 0000000000..f32bebe5cc --- /dev/null +++ b/observations/utilities/oned/mkmf_obs_keep_a_few @@ -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_keep_a_few -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_keep_a_few + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/oned/mkmf_obs_remove_dups b/observations/utilities/oned/mkmf_obs_remove_dups new file mode 100755 index 0000000000..c7b3921f86 --- /dev/null +++ b/observations/utilities/oned/mkmf_obs_remove_dups @@ -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_remove_dups -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_remove_dups + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/models/cam-fv/work/broken_mkmf_closest_member_tool b/observations/utilities/oned/mkmf_obs_sort similarity index 72% rename from models/cam-fv/work/broken_mkmf_closest_member_tool rename to observations/utilities/oned/mkmf_obs_sort index 52cd72fe71..cc58b8677c 100755 --- a/models/cam-fv/work/broken_mkmf_closest_member_tool +++ b/observations/utilities/oned/mkmf_obs_sort @@ -6,8 +6,8 @@ # # DART $Id$ -../../../mkmf/mkmf -p closest_member_tool -t ../../../mkmf/mkmf.template \ - -a "../../.." path_names_closest_member_tool +../../../build_templates/mkmf -p obs_sort -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_sort exit $status diff --git a/observations/utilities/oned/mkmf_obs_timejitter b/observations/utilities/oned/mkmf_obs_timejitter new file mode 100755 index 0000000000..2109c4781f --- /dev/null +++ b/observations/utilities/oned/mkmf_obs_timejitter @@ -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_timejitter -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_timejitter + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/oned/path_names_obs_assim_count b/observations/utilities/oned/path_names_obs_assim_count new file mode 100644 index 0000000000..4ff6b11b8f --- /dev/null +++ b/observations/utilities/oned/path_names_obs_assim_count @@ -0,0 +1,29 @@ +assimilation_code/location/oned/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/cov_cutoff_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_utils/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/observations/utilities/oned/path_names_obs_data_denial b/observations/utilities/oned/path_names_obs_data_denial new file mode 100644 index 0000000000..7aece2d4e3 --- /dev/null +++ b/observations/utilities/oned/path_names_obs_data_denial @@ -0,0 +1,29 @@ +assimilation_code/location/oned/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/cov_cutoff_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_utils/obs_data_denial.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/observations/utilities/oned/path_names_obs_info b/observations/utilities/oned/path_names_obs_info new file mode 100644 index 0000000000..1dcf75fb11 --- /dev/null +++ b/observations/utilities/oned/path_names_obs_info @@ -0,0 +1,30 @@ +assimilation_code/location/oned/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/cov_cutoff_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/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/obs_utils/obs_info.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/observations/utilities/oned/path_names_obs_keep_a_few b/observations/utilities/oned/path_names_obs_keep_a_few new file mode 100644 index 0000000000..611702a89b --- /dev/null +++ b/observations/utilities/oned/path_names_obs_keep_a_few @@ -0,0 +1,29 @@ +assimilation_code/location/oned/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/cov_cutoff_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_keep_a_few/obs_keep_a_few.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/observations/utilities/oned/path_names_obs_remove_dups b/observations/utilities/oned/path_names_obs_remove_dups new file mode 100644 index 0000000000..cfd625e1c1 --- /dev/null +++ b/observations/utilities/oned/path_names_obs_remove_dups @@ -0,0 +1,29 @@ +assimilation_code/location/oned/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/cov_cutoff_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_utils/obs_remove_dups.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/observations/utilities/oned/path_names_obs_sort b/observations/utilities/oned/path_names_obs_sort new file mode 100644 index 0000000000..f3f636ec5a --- /dev/null +++ b/observations/utilities/oned/path_names_obs_sort @@ -0,0 +1,29 @@ +assimilation_code/location/oned/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/cov_cutoff_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_utils/obs_sort.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/observations/utilities/oned/path_names_obs_timejitter b/observations/utilities/oned/path_names_obs_timejitter new file mode 100644 index 0000000000..681d8e9e4a --- /dev/null +++ b/observations/utilities/oned/path_names_obs_timejitter @@ -0,0 +1,29 @@ +assimilation_code/location/oned/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/cov_cutoff_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_utils/obs_timejitter.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/observations/utilities/oned/quickbuild.csh b/observations/utilities/oned/quickbuild.csh index c0137d8fdf..d171e599dc 100755 --- a/observations/utilities/oned/quickbuild.csh +++ b/observations/utilities/oned/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,10 +56,10 @@ foreach TARGET ( mkmf_* ) endsw end -\rm -f *.o *.mod input.nml*_default +\rm -f *.o *.mod input.nml*_default Makefile .cppdefs echo "" -echo "Success: All single task DART programs compiled." +echo "Success: All single task DART programs compiled." echo "" exit 0 diff --git a/observations/utilities/threed_sphere/input.nml b/observations/utilities/threed_sphere/input.nml index 1e14e3cff1..cb1b431e5b 100644 --- a/observations/utilities/threed_sphere/input.nml +++ b/observations/utilities/threed_sphere/input.nml @@ -136,10 +136,10 @@ &obs_sequence_tool_nml filename_seq = 'obs_seq.out', filename_out = 'obs_seq.processed', - first_obs_days = -1, + first_obs_days = -1, first_obs_seconds = -1, - last_obs_days = -1, - last_obs_seconds = -1, + last_obs_days = -1, + last_obs_seconds = -1, obs_types = '', keep_types = .false., print_only = .false., @@ -156,5 +156,35 @@ calendar = 'Gregorian' / +&obs_keep_a_few_nml + filename_in = 'obs_seq.out' + filename_out = 'obs_seq.subset' + max_count_per_type = 10 + max_total_count = -1 + print_only = .false. + calendar = 'Gregorian' + / +! 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 = 'obs_seq.out' + filename_out = 'obs_seq.no_dups' + ignore_values = .false. + print_only = .false. + calendar = 'Gregorian' + debug = .false. +/ + +&obs_sort_nml + filename_in = 'obs_seq.out' + filename_out = 'obs_seq.sorted' + print_only = .false. + calendar = 'Gregorian' + debug = .false. +/ diff --git a/observations/utilities/threed_sphere/mkmf_create_obs_grid b/observations/utilities/threed_sphere/mkmf_create_obs_grid new file mode 100755 index 0000000000..57fd2c20a2 --- /dev/null +++ b/observations/utilities/threed_sphere/mkmf_create_obs_grid @@ -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 create_obs_grid -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_create_obs_grid + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/threed_sphere/mkmf_obs_assim_count b/observations/utilities/threed_sphere/mkmf_obs_assim_count new file mode 100755 index 0000000000..d435960e5d --- /dev/null +++ b/observations/utilities/threed_sphere/mkmf_obs_assim_count @@ -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_assim_count -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_assim_count + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/threed_sphere/mkmf_obs_data_denial b/observations/utilities/threed_sphere/mkmf_obs_data_denial new file mode 100755 index 0000000000..17a675d8f3 --- /dev/null +++ b/observations/utilities/threed_sphere/mkmf_obs_data_denial @@ -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_data_denial -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_data_denial + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/threed_sphere/mkmf_obs_info b/observations/utilities/threed_sphere/mkmf_obs_info new file mode 100755 index 0000000000..721ad65543 --- /dev/null +++ b/observations/utilities/threed_sphere/mkmf_obs_info @@ -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_info -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_info + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/threed_sphere/mkmf_obs_keep_a_few b/observations/utilities/threed_sphere/mkmf_obs_keep_a_few new file mode 100755 index 0000000000..f32bebe5cc --- /dev/null +++ b/observations/utilities/threed_sphere/mkmf_obs_keep_a_few @@ -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_keep_a_few -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_keep_a_few + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/threed_sphere/mkmf_obs_remove_dups b/observations/utilities/threed_sphere/mkmf_obs_remove_dups new file mode 100755 index 0000000000..5faa8fd976 --- /dev/null +++ b/observations/utilities/threed_sphere/mkmf_obs_remove_dups @@ -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_obs_remove_dups 12310 2018-01-11 16:43:13Z nancy@ucar.edu $ + +../../../build_templates/mkmf -p obs_remove_dups -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_remove_dups + +exit $status + +# +# $URL: https://svn-dares-dart.cgd.ucar.edu/DART/branches/recam/observations/utilities/threed_sphere/mkmf_obs_remove_dups $ +# $Revision: 12310 $ +# $Date: 2018-01-11 09:43:13 -0700 (Thu, 11 Jan 2018) $ + diff --git a/observations/utilities/threed_sphere/mkmf_obs_sort b/observations/utilities/threed_sphere/mkmf_obs_sort new file mode 100755 index 0000000000..cc58b8677c --- /dev/null +++ b/observations/utilities/threed_sphere/mkmf_obs_sort @@ -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_sort -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_sort + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/threed_sphere/mkmf_obs_timejitter b/observations/utilities/threed_sphere/mkmf_obs_timejitter new file mode 100755 index 0000000000..2109c4781f --- /dev/null +++ b/observations/utilities/threed_sphere/mkmf_obs_timejitter @@ -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_timejitter -t ../../../build_templates/mkmf.template \ + -a "../../.." path_names_obs_timejitter + +exit $status + +# +# $URL$ +# $Revision$ +# $Date$ + diff --git a/observations/utilities/threed_sphere/path_names_create_obs_grid b/observations/utilities/threed_sphere/path_names_create_obs_grid new file mode 100644 index 0000000000..5cae1add38 --- /dev/null +++ b/observations/utilities/threed_sphere/path_names_create_obs_grid @@ -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_utils/create_obs_grid.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/observations/utilities/threed_sphere/path_names_obs_assim_count b/observations/utilities/threed_sphere/path_names_obs_assim_count new file mode 100644 index 0000000000..752753eede --- /dev/null +++ b/observations/utilities/threed_sphere/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_utils/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/observations/utilities/threed_sphere/path_names_obs_data_denial b/observations/utilities/threed_sphere/path_names_obs_data_denial new file mode 100644 index 0000000000..272fab6c73 --- /dev/null +++ b/observations/utilities/threed_sphere/path_names_obs_data_denial @@ -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_utils/obs_data_denial.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/observations/utilities/threed_sphere/path_names_obs_info b/observations/utilities/threed_sphere/path_names_obs_info new file mode 100644 index 0000000000..8a6f76a424 --- /dev/null +++ b/observations/utilities/threed_sphere/path_names_obs_info @@ -0,0 +1,29 @@ +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/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/obs_utils/obs_info.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/observations/utilities/threed_sphere/path_names_obs_keep_a_few b/observations/utilities/threed_sphere/path_names_obs_keep_a_few new file mode 100644 index 0000000000..6db0a12712 --- /dev/null +++ b/observations/utilities/threed_sphere/path_names_obs_keep_a_few @@ -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_keep_a_few/obs_keep_a_few.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/observations/utilities/threed_sphere/path_names_obs_remove_dups b/observations/utilities/threed_sphere/path_names_obs_remove_dups new file mode 100644 index 0000000000..8229417805 --- /dev/null +++ b/observations/utilities/threed_sphere/path_names_obs_remove_dups @@ -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_utils/obs_remove_dups.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/observations/obs_converters/cice/work/path_names_seaice_temperature_to_obs_netcdf b/observations/utilities/threed_sphere/path_names_obs_sort similarity index 88% rename from observations/obs_converters/cice/work/path_names_seaice_temperature_to_obs_netcdf rename to observations/utilities/threed_sphere/path_names_obs_sort index 863adcfa07..bbe19589b2 100644 --- a/observations/obs_converters/cice/work/path_names_seaice_temperature_to_obs_netcdf +++ b/observations/utilities/threed_sphere/path_names_obs_sort @@ -1,4 +1,6 @@ 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 @@ -19,9 +21,8 @@ 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_utils/obs_sort.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_temperature_to_obs_netcdf.f90 -observations/obs_converters/utilities/obs_utilities_mod.f90 diff --git a/observations/utilities/threed_sphere/path_names_obs_timejitter b/observations/utilities/threed_sphere/path_names_obs_timejitter new file mode 100644 index 0000000000..6ff4cecead --- /dev/null +++ b/observations/utilities/threed_sphere/path_names_obs_timejitter @@ -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_utils/obs_timejitter.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/observations/utilities/threed_sphere/quickbuild.csh b/observations/utilities/threed_sphere/quickbuild.csh index c0137d8fdf..d171e599dc 100755 --- a/observations/utilities/threed_sphere/quickbuild.csh +++ b/observations/utilities/threed_sphere/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,10 +56,10 @@ foreach TARGET ( mkmf_* ) endsw end -\rm -f *.o *.mod input.nml*_default +\rm -f *.o *.mod input.nml*_default Makefile .cppdefs echo "" -echo "Success: All single task DART programs compiled." +echo "Success: All single task DART programs compiled." echo "" exit 0